keep longident in Typecore.Wrong_name

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/record-disambiguation@13056 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

5 files changed, 33 insertions, 27 deletions

diff --git a/testsuite/tests/typing-warnings/records.ml b/testsuite/tests/typing-warnings/records.ml
index 4732dff160..6c4f64ef99 100644
--- a/testsuite/tests/typing-warnings/records.ml
+++ b/testsuite/tests/typing-warnings/records.ml
@@ -115,3 +115,7 @@ module F7 = struct
   let r = {x=1; y=2}
   let r: other = {x=1; y=2}
 end;;
+
+module A = struct type t = {x: int} end
+module B = struct type t = {x: int} end;;
+let f (r : B.t) = r.A.x;; (* fail *)
diff --git a/testsuite/tests/typing-warnings/records.ml.principal.reference b/testsuite/tests/typing-warnings/records.ml.principal.reference
index d4f8df5ae4..2de111bb1c 100644
--- a/testsuite/tests/typing-warnings/records.ml.principal.reference
+++ b/testsuite/tests/typing-warnings/records.ml.principal.reference
@@ -58,9 +58,7 @@ module OK : sig val f : M.t -> int end
     module N : sig type s = t = { x : int; } end
     type u = { x : bool; }
   end
-#       Characters 63-78:
-  Warning 34: unused type s.
-module OK : sig val f : M.t -> int end
+#       module OK : sig val f : M.t -> int end
 #           module M :
   sig
     type u = { x : bool; y : int; z : char; }
@@ -72,9 +70,6 @@ module OK : sig val f : M.t -> int end
 Warning 9: the following labels are not bound in this record pattern:
 y
 Either bind these labels explicitly or add '; _' to the pattern.
-Characters 54-79:
-  ......(* ok *)
-  Warning 34: unused type u.
 Characters 87-105:
   Warning 34: unused type t.
 module OK : sig val f : M.u -> bool * char end
@@ -91,7 +86,7 @@ Error: Some record fields are undefined: y
 #               Characters 111-112:
     let b : bar = {x=3; y=4}
                         ^
-Error: The record type bar has no field y
+Error: The record type bar has no label y
 #   module M : sig type foo = { x : int; y : int; } end
 # module N : sig type bar = { x : int; y : int; } end
 # Characters 19-22:
@@ -126,7 +121,7 @@ Error: The record field label NM.y belongs to the type NM.foo = M.foo
 #       Characters 72-73:
     let f r = ignore (r: foo); {r with x = 2; z = 3}
                                               ^
-Error: The record type M.foo has no field z
+Error: The record type M.foo has no label z
 #       module M :
   sig
     type foo = M.foo = { x : int; y : int; }
@@ -136,9 +131,15 @@ Error: The record type M.foo has no field z
 #       Characters 73-74:
     let f r = ignore (r: foo); { r with x = 3; a = 4 }
                                                ^
-Error: The record type M.foo has no field a
+Error: The record type M.foo has no label a
 #         Characters 67-68:
     let r: other = {x=1; y=2}
                     ^
-Error: The record type M.other has no field x
+Error: The record type M.other has no label x
+#     module A : sig type t = { x : int; } end
+module B : sig type t = { x : int; } end
+# Characters 20-23:
+  let f (r : B.t) = r.A.x;; (* fail *)
+                      ^^^
+Error: The record type B.t has no label A.x
 # 
diff --git a/testsuite/tests/typing-warnings/records.ml.reference b/testsuite/tests/typing-warnings/records.ml.reference
index 1ea43e3f61..b3b3fb8939 100644
--- a/testsuite/tests/typing-warnings/records.ml.reference
+++ b/testsuite/tests/typing-warnings/records.ml.reference
@@ -54,9 +54,7 @@ module OK : sig val f : M.t -> int end
     module N : sig type s = t = { x : int; } end
     type u = { x : bool; }
   end
-#       Characters 63-78:
-  Warning 34: unused type s.
-module OK : sig val f : M.t -> int end
+#       module OK : sig val f : M.t -> int end
 #           module M :
   sig
     type u = { x : bool; y : int; z : char; }
@@ -68,9 +66,6 @@ module OK : sig val f : M.t -> int end
 Warning 9: the following labels are not bound in this record pattern:
 y
 Either bind these labels explicitly or add '; _' to the pattern.
-Characters 54-79:
-  ......(* ok *)
-  Warning 34: unused type u.
 Characters 87-105:
   Warning 34: unused type t.
 module OK : sig val f : M.u -> bool * char end
@@ -87,7 +82,7 @@ Error: Some record fields are undefined: y
 #               Characters 111-112:
     let b : bar = {x=3; y=4}
                         ^
-Error: The record type bar has no field y
+Error: The record type bar has no label y
 #   module M : sig type foo = { x : int; y : int; } end
 # module N : sig type bar = { x : int; y : int; } end
 # Characters 19-22:
@@ -122,7 +117,7 @@ Error: The record field label NM.y belongs to the type NM.foo = M.foo
 #       Characters 72-73:
     let f r = ignore (r: foo); {r with x = 2; z = 3}
                                               ^
-Error: The record type M.foo has no field z
+Error: The record type M.foo has no label z
 #       module M :
   sig
     type foo = M.foo = { x : int; y : int; }
@@ -132,9 +127,15 @@ Error: The record type M.foo has no field z
 #       Characters 73-74:
     let f r = ignore (r: foo); { r with x = 3; a = 4 }
                                                ^
-Error: The record type M.foo has no field a
+Error: The record type M.foo has no label a
 #         Characters 67-68:
     let r: other = {x=1; y=2}
                     ^
-Error: The record type M.other has no field x
+Error: The record type M.other has no label x
+#     module A : sig type t = { x : int; } end
+module B : sig type t = { x : int; } end
+# Characters 20-23:
+  let f (r : B.t) = r.A.x;; (* fail *)
+                      ^^^
+Error: The record type B.t has no label A.x
 # 
diff --git a/typing/typecore.ml b/typing/typecore.ml
index 5156889727..016c421fb0 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -33,7 +33,7 @@ type error =
   | Label_multiply_defined of Longident.t
   | Label_missing of Ident.t list
   | Label_not_mutable of Longident.t
-  | Wrong_name of string * Path.t * string
+  | Wrong_name of string * Path.t * Longident.t
   | Incomplete_format of string
   | Bad_conversion of string * int * char
   | Undefined_method of type_expr * string
@@ -621,8 +621,7 @@ end) = struct
           if not pr then warn_pr ();
           lbl
 	with Not_found ->
-	  raise (Error (lid.loc, Wrong_name
-			  (type_kind, tpath, Longident.last lid.txt)))
+	  raise (Error (lid.loc, Wrong_name (type_kind, tpath, lid.txt)))
 end
 
 module Label = NameChoice (struct
@@ -3388,9 +3387,10 @@ let report_error ppf = function
         print_labels labels
   | Label_not_mutable lid ->
       fprintf ppf "The record field %a is not mutable" longident lid
-  | Wrong_name (kind, p, s) ->
-      fprintf ppf "The %s type %a has no %s %s" kind path p
-	(if kind = "record" then "field" else "constructor") s
+  | Wrong_name (kind, p, lid) ->
+      fprintf ppf "The %s type %a has no %s %a" kind path p
+	(if kind = "record" then "label" else "constructor")
+	longident lid
   | Incomplete_format s ->
       fprintf ppf "Premature end of format string ``%S''" s
   | Bad_conversion (fmt, i, c) ->
diff --git a/typing/typecore.mli b/typing/typecore.mli
index ef33a60b00..df40cff6d9 100644
--- a/typing/typecore.mli
+++ b/typing/typecore.mli
@@ -75,7 +75,7 @@ type error =
   | Label_multiply_defined of Longident.t
   | Label_missing of Ident.t list
   | Label_not_mutable of Longident.t
-  | Wrong_name of string * Path.t * string
+  | Wrong_name of string * Path.t * Longident.t
   | Incomplete_format of string
   | Bad_conversion of string * int * char
   | Undefined_method of type_expr * string