Fix issue with attributes on single-field optional record declaration.

Fixes #627

Author: cristianoc

src/res_core.ml

@@ -4286,6 +4286,7 @@ and parseFieldDeclaration p =
     match p.token with
     | _ -> parseLident p
   in
+  let optional = parseOptionalLabel p in
   let name = Location.mkloc lident loc in
   let typ =
     match p.Parser.token with
@@ -4296,7 +4297,7 @@ and parseFieldDeclaration p =
       Ast_helper.Typ.constr ~loc:name.loc {name with txt = Lident name.txt} []
   in
   let loc = mkLoc startPos typ.ptyp_loc.loc_end in
-  Ast_helper.Type.field ~attrs ~loc ~mut name typ
+  (optional, Ast_helper.Type.field ~attrs ~loc ~mut name typ)
 
 and parseFieldDeclarationRegion p =
   let startPos = p.Parser.startPos in
@@ -4309,6 +4310,7 @@ and parseFieldDeclarationRegion p =
   | Lident _ ->
     let lident, loc = parseLident p in
     let name = Location.mkloc lident loc in
+    (* XXX *)
     let optional = parseOptionalLabel p in
     let typ =
       match p.Parser.token with
@@ -4488,7 +4490,10 @@ and parseConstrDeclArgs p =
                   ~closing:Rbrace ~f:parseFieldDeclarationRegion p
               | attrs ->
                 let first =
-                  let field = parseFieldDeclaration p in
+                  let optional, field = parseFieldDeclaration p in
+                  let attrs =
+                    if optional then optionalAttr :: attrs else attrs
+                  in
                   Parser.expect Comma p;
                   {field with Parsetree.pld_attributes = attrs}
                 in
@@ -4885,13 +4890,15 @@ and parseRecordOrObjectDecl p =
     | _ ->
       Parser.leaveBreadcrumb p Grammar.RecordDecl;
       let fields =
+        (* XXX *)
         match attrs with
         | [] ->
           parseCommaDelimitedRegion ~grammar:Grammar.FieldDeclarations
             ~closing:Rbrace ~f:parseFieldDeclarationRegion p
         | attr :: _ as attrs ->
           let first =
-            let field = parseFieldDeclaration p in
+            let optional, field = parseFieldDeclaration p in
+            let attrs = if optional then optionalAttr :: attrs else attrs in
             Parser.optional p Comma |> ignore;
             {
               field with

tests/parsing/grammar/expressions/expected/record.res.txt

@@ -1,10 +1,45 @@
-
-  Syntax error!
-  tests/parsing/grammar/expressions/record.res:52:32
-
-  50 │ type multipleWithAttrs = {x:int, @attr y?: string}
-  51 │ 
-  52 │ type singleWithAttrs = {@attr y?: string}
-
-  I'm not sure what to parse here when looking at "?".
-
+let r = { a = expr }
+let r = { a = expr }
+let r = { Parsetree.pexp_attributes = [||]; Parsetree.loc = loc }
+let r = { a; b; c }
+let r = { A.a = a; b }
+let r = { A.a = a; b; C.c = c }
+let r = { Parsetree.pexp_attributes = pexp_attributes; Parsetree.loc = loc }
+let r = { Parsetree.pexp_attributes = pexp_attributes; Parsetree.loc = loc }
+let r = { a = (expr : int); b = (x : string) }
+let r = { expr with pexp_attributes = [||] }
+let r = { expr with pexp_attributes = [||]; pexp_loc = loc }
+let r = { expr with pexp_attributes = [||] }
+let r = { (make () : myRecord) with foo = bar }
+let r = { (make () : myRecord) with foo = bar }
+let r =
+  {
+    x = ((None)[@ns.optional ]);
+    y = ((None)[@ns.optional ]);
+    z = (((None : tt))[@ns.optional ])
+  }
+let z name = { name = ((name)[@ns.optional ]); x = 3 }
+let z name = { name = ((name)[@ns.optional ]); x = 3 }
+let z name = { name; x = ((x)[@ns.optional ]) }
+let zz name = { name; x = ((x)[@ns.optional ]) }
+let _ =
+  match z with
+  | { x = ((None)[@ns.optional ]); y = ((None)[@ns.optional ]);
+      z = (((None : tt))[@ns.optional ]) } -> 11
+  | { name = ((name)[@ns.optional ]); x = 3 } -> 42
+  | { name = ((name)[@ns.optional ]); x = 3 } -> 4242
+  | { x = ((None)[@ns.optional ]); y = ((None)[@ns.optional ]);
+      z = (((None : tt))[@ns.optional ]) } -> 11
+  | { name = ((name)[@ns.optional ]); x = 3 } -> 42
+  | { name = ((name)[@ns.optional ]); x = 3 } -> 4242
+type nonrec tt = {
+  x: int ;
+  y: string [@ns.opttinal ]}
+type nonrec ttt = {
+  x: int ;
+  y: string [@ns.optional ]}
+type nonrec multipleWithAttrs = {
+  x: int ;
+  y: string [@ns.optional ][@attr ]}
+type nonrec singleWithAttrs = {
+  y: string [@ns.optional ][@attr ]}

tests/printer/typeDef/expected/record.res.txt

@@ -66,3 +66,7 @@ type user = {
   @attrSuperLongNaaaaaaaaaaaaaaameSooooooooLong
   hairStyle: Hair.t,
 }
+
+type multipleWithAttrs = {x: int, @attr y?: string}
+
+type singleWithAttrs = {@attr y?: string}

tests/printer/typeDef/record.res

@@ -51,3 +51,7 @@ type user = {
   hairStyle: Hair.t,
   @attrAbove @attrSuperLongNaaaaaaaaaaaaaaameSooooooooLong @attrSuperLongNaaaaaaaaaaaaaaameSooooooooLong hairStyle: Hair.t
 }
+
+type multipleWithAttrs = {x:int, @attr y?: string}
+
+type singleWithAttrs = {@attr y?: string}