Fix parsing punned record fields with module name (#479)

* Fix parsing punned record fields with module name

* Add more tests

* Move helper function to top and add comment.

* Invoke removeModuleNameFromPunnedFieldValue for Uident only

* Fix

Author: cknitt

src/res_core.ml

@@ -493,6 +493,12 @@ let hexValue ch =
   | 'A'..'F' -> (Char.code ch) + 32 - (Char.code 'a') + 10
   | _ -> 16 (* larger than any legal value *)
 
+(* Transform A.a into a. For use with punned record fields as in {A.a, b}. *)
+let removeModuleNameFromPunnedFieldValue exp =
+  match exp.Parsetree.pexp_desc with
+  | Pexp_ident pathIdent -> {exp with pexp_desc = Pexp_ident { pathIdent with txt = Lident (Longident.last pathIdent.txt) }} 
+  | _ -> exp
+
 let parseStringLiteral s =
   let len = String.length s in
   let b = Buffer.create (String.length s) in
@@ -2771,13 +2777,18 @@ and parseBracedOrRecordExpr  p =
       end
     end
   | Uident _ | Lident _ ->
+    let startToken = p.token in
     let valueOrConstructor = parseValueOrConstructor p in
     begin match valueOrConstructor.pexp_desc with
     | Pexp_ident pathIdent ->
       let identEndPos = p.prevEndPos in
       begin match p.Parser.token with
       | Comma ->
         Parser.next p;
+        let valueOrConstructor = match startToken with
+        | Uident _ -> removeModuleNameFromPunnedFieldValue(valueOrConstructor)
+        | _ -> valueOrConstructor
+        in
         let expr = parseRecordExpr ~startPos [(pathIdent, valueOrConstructor)] p in
         Parser.expect Rbrace p;
         expr
@@ -2939,14 +2950,20 @@ and parseRecordRow p =
   in
   match p.Parser.token with
   | Lident _ | Uident _ ->
+    let startToken = p.token in
     let field = parseValuePath p in
     begin match p.Parser.token with
     | Colon ->
       Parser.next p;
       let fieldExpr = parseExpr p in
       Some (field, fieldExpr)
     | _ ->
-      Some (field, Ast_helper.Exp.ident ~loc:field.loc  field)
+      let value = Ast_helper.Exp.ident ~loc:field.loc field in
+      let value = match startToken with
+      | Uident _ -> removeModuleNameFromPunnedFieldValue(value)
+      | _ -> value
+      in
+      Some (field, value)
     end
   | _ -> None
 

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

@@ -2,8 +2,10 @@ let r = { a = expr }
 let r = { a = expr }
 let r = { Parsetree.pexp_attributes = [||]; Parsetree.loc = loc }
 let r = { a; b; c }
-let r = { Parsetree.pexp_attributes; Parsetree.loc }
-let r = { Parsetree.pexp_attributes; Parsetree.loc }
+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 }

tests/parsing/grammar/expressions/record.res

@@ -5,6 +5,8 @@ let r = {Parsetree.pexp_attributes: [], Parsetree.loc: loc}
 
 // punning
 let r = {a, b, c} 
+let r = {A.a, b}
+let r = {A.a, b, C.c}
 
 let r = {Parsetree.pexp_attributes, Parsetree.loc}
 // trailing comma