Handle attributes on lambdas with locally abstract types (#120)

lambda/translcore.ml

@@ -1195,7 +1195,19 @@ and transl_function ~scopes e alloc_mode param cases partial warnings region cur
   let loc = of_location ~scopes e.exp_loc in
   let body = if region then maybe_region body else body in
   let lam = lfunction ~kind ~params ~return ~body ~attr ~loc ~mode ~region in
-  Translattribute.add_function_attributes lam e.exp_loc e.exp_attributes
+  let attrs =
+    (* Collect attributes from the Pexp_newtype node for locally abstract types.
+       Otherwise we'd ignore the attribute in, e.g.;
+           fun [@inline] (type a) x -> ...
+    *)
+    List.fold_left
+      (fun attrs (extra_exp, _, extra_attrs) ->
+         match extra_exp with
+         | Texp_newtype _ -> extra_attrs @ attrs
+         | (Texp_constraint _ | Texp_coerce _ | Texp_poly _) -> attrs)
+      e.exp_attributes e.exp_extra
+  in
+  Translattribute.add_function_attributes lam e.exp_loc attrs
 
 (* Like transl_exp, but used when a new scope was just introduced. *)
 and transl_scoped_exp ~scopes expr =

testsuite/tests/warnings/w53.compilers.reference

@@ -638,3 +638,7 @@ File "w53.ml", line 376, characters 39-43:
 376 |   external z : int64 -> int64 = "x" [@@poll error] (* rejected *)
                                              ^^^^
 Warning 53 [misplaced-attribute]: the "poll" attribute cannot appear in this context
+File "w53.ml", line 385, characters 17-26:
+385 |   let f2 = fun [@immediate] (type a) (x : a) -> x (* rejected *)
+                       ^^^^^^^^^
+Warning 53 [misplaced-attribute]: the "immediate" attribute cannot appear in this context

testsuite/tests/warnings/w53.ml

@@ -378,3 +378,9 @@ end
 
 (* Attributes in attributes shouldn't be tracked for w53 *)
 [@@@foo [@@@deprecated]]
+
+module TestNewtypeAttr = struct
+  (* Check for handling of attributes on Pexp_newtype *)
+  let f1 = fun [@inline] (type a) (x : a) -> x (* accepted *)
+  let f2 = fun [@immediate] (type a) (x : a) -> x (* rejected *)
+end

testsuite/tests/warnings/w53_marshalled.compilers.reference

@@ -634,3 +634,7 @@ File "w53.ml", line 376, characters 39-43:
 376 |   external z : int64 -> int64 = "x" [@@poll error] (* rejected *)
                                              ^^^^
 Warning 53 [misplaced-attribute]: the "poll" attribute cannot appear in this context
+File "w53.ml", line 385, characters 17-26:
+385 |   let f2 = fun [@immediate] (type a) (x : a) -> x (* rejected *)
+                       ^^^^^^^^^
+Warning 53 [misplaced-attribute]: the "immediate" attribute cannot appear in this context