summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJacques Garrigue <garrigue at math.nagoya-u.ac.jp>2012-08-14 05:23:40 +0000
committerJacques Garrigue <garrigue at math.nagoya-u.ac.jp>2012-08-14 05:23:40 +0000
commitd165ca651e5c5446598613d7f55b698d24aaeeab (patch)
treefa112c4cd05c26b1a22e148f17d4440bf78aea73
parent873c35f98de1ff5fedab9afd826b7c3d8bbdc1f7 (diff)
downloadocaml-d165ca651e5c5446598613d7f55b698d24aaeeab.tar.gz
PR#5722: toplevel: print full module path only for first record field
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@12861 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
-rw-r--r--testsuite/tests/typing-misc/records.ml17
-rw-r--r--testsuite/tests/typing-misc/records.ml.reference15
-rw-r--r--toplevel/genprintval.ml9
3 files changed, 39 insertions, 2 deletions
diff --git a/testsuite/tests/typing-misc/records.ml b/testsuite/tests/typing-misc/records.ml
index 36fa5ec782..36cf5e031a 100644
--- a/testsuite/tests/typing-misc/records.ml
+++ b/testsuite/tests/typing-misc/records.ml
@@ -10,3 +10,20 @@ fun {x=3;z=2} -> ();;
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 *)
diff --git a/testsuite/tests/typing-misc/records.ml.reference b/testsuite/tests/typing-misc/records.ml.reference
index d69991a245..e5974627f2 100644
--- a/testsuite/tests/typing-misc/records.ml.reference
+++ b/testsuite/tests/typing-misc/records.ml.reference
@@ -22,4 +22,19 @@ Error: Cannot create values of the private type u
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
#
diff --git a/toplevel/genprintval.ml b/toplevel/genprintval.ml
index 3f8cdda450..82448b6fbf 100644
--- a/toplevel/genprintval.ml
+++ b/toplevel/genprintval.ml
@@ -279,8 +279,13 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
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