Commits

Anonymous committed 6d62602

PR#5722: toplevel: print full module path only for first record field

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@12861f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

Comments (0)

Files changed (3)

testsuite/tests/typing-misc/records.ml

 type u = private {mutable u:int};;
 {u=3};;
 fun x -> x.u <- 3;;
+
+(* Punning and abbreviations *)
+module M = struct
+  type t = {x: int; y: int}
+end;;
+
+let f {M.x; y} = x+y;;
+let r = {M.x=1; y=2};;
+let z = f r;;
+
+module M = struct
+  type t = {x: int; y: int}
+  type u = {y: bool}
+end;;
+(* path abbreviation is syntactic *)
+let f {M.x; y} = x+y;; (* fails *)
+let r = {M.x=1; y=2};; (* fails *)

testsuite/tests/typing-misc/records.ml.reference

   fun x -> x.u <- 3;;
              ^
 Error: Cannot assign field u of the private type u
+#         module M : sig type t = { x : int; y : int; } end
+#   val f : M.t -> int = <fun>
+# val r : M.t = {M.x = 1; y = 2}
+# val z : int = 3
+#         module M : sig type t = { x : int; y : int; } type u = { y : bool; } end
+#   Characters 43-51:
+  let f {M.x; y} = x+y;; (* fails *)
+        ^^^^^^^^
+Error: This pattern matches values of type M.u
+       but a pattern was expected which matches values of type M.t
+# Characters 16-17:
+  let r = {M.x=1; y=2};; (* fails *)
+                  ^
+Error: The record field label M.y belongs to the type M.u
+       but is mixed here with labels of type M.t
 # 

toplevel/genprintval.ml

                                     ty_list
                                 with
                                   Ctype.Cannot_apply -> abstract_type in
-                              let lid = tree_of_label env path (Ident.name lbl_name) in
-                              let v =
+			      let name = Ident.name lbl_name in
+			      (* PR#5722: print full module path only
+				 for first record field *)
+                              let lid =
+				if pos = 0 then tree_of_label env path name
+				else Oide_ident name
+                              and v =
                                 tree_of_val (depth - 1) (O.field obj pos)
                                   ty_arg
                               in