parser.mly: mark punned label as ghost in object clone expr and give …

…correct loc
ocaml · Aug 5, 2021 · 34c662c · 34c662c
1 parent e0cb3ab
commit 34c662c
Show file tree

Hide file tree

Showing 3 changed files with 51 additions and 2 deletions.
diff --git a/parsing/parser.mly b/parsing/parser.mly
@@ -394,7 +394,7 @@ let exp_of_longident ~loc lid =
   ghexp ~loc (Pexp_ident lid)
 
 let exp_of_label ~loc lbl =
-  mkexp ~loc (Pexp_ident (loc_lident lbl))
+  ghexp ~loc (Pexp_ident (loc_lident lbl))
 
 let pat_of_label lbl =
   Pat.mk ~loc:lbl.loc  (Ppat_var (loc_last lbl))
@@ -2653,7 +2653,7 @@ record_expr_content:
           match oe with
           | None ->
               (* No expression; this is a pun. Desugar it. *)
-              exp_of_label ~loc:$sloc label
+              exp_of_label ~loc:$loc(label) label
           | Some e ->
               e
         in

diff --git a/testsuite/tests/parsetree/locations_test.compilers.reference b/testsuite/tests/parsetree/locations_test.compilers.reference
@@ -512,6 +512,51 @@ Ptop_def
   ]
 
 val x : int ref -> int = <fun>
+Ptop_def
+  [
+    structure_item (//toplevel//[2,1+0]..[3,9+50])
+      Pstr_value Nonrec
+      [
+        <def>
+          pattern (//toplevel//[2,1+4]..[2,1+5])
+            Ppat_any
+          expression (//toplevel//[3,9+2]..[3,9+50])
+            Pexp_object
+            class_structure
+              pattern (//toplevel//[3,9+8]..[3,9+8]) ghost
+                Ppat_any
+              [
+                class_field (//toplevel//[3,9+9]..[3,9+21])
+                  Pcf_val Immutable
+                    "foo" (//toplevel//[3,9+13]..[3,9+16])
+                    Concrete Fresh
+                    expression (//toplevel//[3,9+19]..[3,9+21])
+                      Pexp_constant PConst_int (12,None)
+                class_field (//toplevel//[3,9+22]..[3,9+46])
+                  Pcf_method Public
+                    "x" (//toplevel//[3,9+29]..[3,9+30])
+                    Concrete Fresh
+                    expression (//toplevel//[3,9+31]..[3,9+46]) ghost
+                      Pexp_poly
+                      expression (//toplevel//[3,9+31]..[3,9+46]) ghost
+                        Pexp_fun
+                        Nolabel
+                        None
+                        pattern (//toplevel//[3,9+31]..[3,9+34])
+                          Ppat_var "foo" (//toplevel//[3,9+31]..[3,9+34])
+                        expression (//toplevel//[3,9+37]..[3,9+46])
+                          Pexp_override
+                          [
+                            <override> "foo" (//toplevel//[3,9+40]..[3,9+43])
+                              expression (//toplevel//[3,9+40]..[3,9+43]) ghost
+                                Pexp_ident "foo" (//toplevel//[3,9+40]..[3,9+43])
+                          ]
+                      None
+              ]
+      ]
+  ]
+
+- : < x : int -> 'a > as 'a = <obj>
 Ptop_def
   [
     structure_item (//toplevel//[4,19+0]..[4,19+26])

diff --git a/testsuite/tests/parsetree/locations_test.ml b/testsuite/tests/parsetree/locations_test.ml
@@ -57,6 +57,10 @@ let x = function { contents : int } -> contents;;
 
 let x = function { contents : int = i } -> i;;
 
+let _ =
+  object val foo = 12 method x foo = {< foo >} end
+;;
+
 (* Local open *)
 
 let x = M.{ contents = 3 };;