diff options
| -rw-r--r-- | testsuite/tests/typing-misc/records.ml | 17 | ||||
| -rw-r--r-- | testsuite/tests/typing-misc/records.ml.reference | 15 | ||||
| -rw-r--r-- | toplevel/genprintval.ml | 9 |
3 files changed, 39 insertions, 2 deletions
diff --git a/testsuite/tests/typing-misc/records.ml b/testsuite/tests/typing-misc/records.ml index 36fa5ec78..36cf5e031 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 d69991a24..e5974627f 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 3f8cdda45..82448b6fb 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 |