Fix case where parser drops attributes in packed module types. (#3262)

* Demonstrate dropped attributes in test.

Signed-off-by: Thomas Del Vecchio <tdelvecchio@janestreet.com>

* Syntax error on misplaced attribute in packed module types.

Signed-off-by: Thomas Del Vecchio <tdelvecchio@janestreet.com>

---------

Signed-off-by: Thomas Del Vecchio <tdelvecchio@janestreet.com>

parsing/parse.ml

@@ -160,6 +160,8 @@ let prepare_error err =
             Format.fprintf ppf
               "only module type identifier and %a constraints are supported"
               Style.inline_code "with type"
+        | Misplaced_attribute ->
+            Format.fprintf ppf "an attribute cannot go here"
       in
       Location.errorf ~loc "invalid package type: %a" invalid ipt
   | Removed_string_set loc ->

parsing/parser.mly

@@ -808,7 +808,12 @@ let package_type_of_module_type pmty =
   in
   match pmty with
   | {pmty_desc = Pmty_ident lid} -> (lid, [], pmty.pmty_attributes)
-  | {pmty_desc = Pmty_with({pmty_desc = Pmty_ident lid}, cstrs)} ->
+  | {pmty_desc = Pmty_with({pmty_desc = Pmty_ident lid; pmty_attributes = inner_attributes}, cstrs)} ->
+      begin match inner_attributes with
+      | [] -> ()
+      | attr :: _ ->
+        err attr.attr_loc Syntaxerr.Misplaced_attribute
+      end;
       (lid, List.map map_cstr cstrs, pmty.pmty_attributes)
   | _ ->
       err pmty.pmty_loc Neither_identifier_nor_with_type

parsing/syntaxerr.ml

@@ -21,6 +21,7 @@ type invalid_package_type =
   | Private_types
   | Not_with_type
   | Neither_identifier_nor_with_type
+  | Misplaced_attribute
 
 type error =
     Unclosed of Location.t * string * Location.t * string

parsing/syntaxerr.mli

@@ -26,6 +26,7 @@ type invalid_package_type =
   | Private_types
   | Not_with_type
   | Neither_identifier_nor_with_type
+  | Misplaced_attribute
 
 type error =
     Unclosed of Location.t * string * Location.t * string

testsuite/tests/parsing/dropped_attribute_ptyp_package.compilers.reference

@@ -0,0 +1,10 @@
+module type T = sig type t end
+Line 3, characters 22-29:
+3 |   val foo : (module T [@attr] with type t = 'a) -> unit
+                          ^^^^^^^
+Error: invalid package type: an attribute cannot go here
+Line 3, characters 33-40:
+3 |   let foo (type a) (module M : T [@attr] with type t = a) = ()
+                                     ^^^^^^^
+Error: invalid package type: an attribute cannot go here
+

testsuite/tests/parsing/dropped_attribute_ptyp_package.ml

@@ -0,0 +1,18 @@
+(* TEST
+   toplevel;
+*)
+
+(* There is no place for the following attributes to attach to; the compiler should error
+   rather than silently dropping them (as it used to do). *)
+
+module type T = sig
+  type t
+end;;
+
+module type U = sig
+  val foo : (module T [@attr] with type t = 'a) -> unit
+end;;
+
+module U : U = struct
+  let foo (type a) (module M : T [@attr] with type t = a) = ()
+end;;