diff options
| author | Jacques Garrigue <garrigue at math.nagoya-u.ac.jp> | 2012-08-14 05:23:40 +0000 |
|---|---|---|
| committer | Jacques Garrigue <garrigue at math.nagoya-u.ac.jp> | 2012-08-14 05:23:40 +0000 |
| commit | d165ca651e5c5446598613d7f55b698d24aaeeab (patch) | |
| tree | fa112c4cd05c26b1a22e148f17d4440bf78aea73 | |
| parent | 873c35f98de1ff5fedab9afd826b7c3d8bbdc1f7 (diff) | |
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.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 |