Reintegrate-merge constructors_with_record5 branch.

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

6 files changed, 175 insertions, 2 deletions

diff --git a/testsuite/tests/typing-modules/Test.ml b/testsuite/tests/typing-modules/Test.ml
index 97ef3f168..640655eb1 100644
--- a/testsuite/tests/typing-modules/Test.ml
+++ b/testsuite/tests/typing-modules/Test.ml
@@ -52,6 +52,7 @@ type u = X of bool;;
 module type B = A with type t = u;; (* fail *)
 
 (* PR#5815 *)
+(* ---> duplicated exception name is now an error *)
 
 module type S = sig exception Foo of int  exception Foo of bool end;;
 
diff --git a/testsuite/tests/typing-modules/Test.ml.principal.reference b/testsuite/tests/typing-modules/Test.ml.principal.reference
index d99e9a3cd..9646d3d0a 100644
--- a/testsuite/tests/typing-modules/Test.ml.principal.reference
+++ b/testsuite/tests/typing-modules/Test.ml.principal.reference
@@ -28,7 +28,11 @@ Error: Signature mismatch:
                          ^^^^^^^^^^
 Error: This variant or record definition does not match that of type u
        The types for field X are not equal.
-#       module type S = sig exception Foo of bool end
+#         Characters 121-124:
+  module type S = sig exception Foo of int  exception Foo of bool end;;
+                                                      ^^^
+Error: Multiple definition of the extension constructor name Foo.
+       Names must be unique in a given structure or signature.
 #       module F : functor (X : sig  end) -> sig val x : int end
 # Characters 0-3:
   F.x;; (* fail *)
diff --git a/testsuite/tests/typing-modules/Test.ml.reference b/testsuite/tests/typing-modules/Test.ml.reference
index d99e9a3cd..9646d3d0a 100644
--- a/testsuite/tests/typing-modules/Test.ml.reference
+++ b/testsuite/tests/typing-modules/Test.ml.reference
@@ -28,7 +28,11 @@ Error: Signature mismatch:
                          ^^^^^^^^^^
 Error: This variant or record definition does not match that of type u
        The types for field X are not equal.
-#       module type S = sig exception Foo of bool end
+#         Characters 121-124:
+  module type S = sig exception Foo of int  exception Foo of bool end;;
+                                                      ^^^
+Error: Multiple definition of the extension constructor name Foo.
+       Names must be unique in a given structure or signature.
 #       module F : functor (X : sig  end) -> sig val x : int end
 # Characters 0-3:
   F.x;; (* fail *)
diff --git a/testsuite/tests/typing-recordarg/Makefile b/testsuite/tests/typing-recordarg/Makefile
new file mode 100644
index 000000000..1834e83ab
--- /dev/null
+++ b/testsuite/tests/typing-recordarg/Makefile
@@ -0,0 +1,14 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the Q Public License version 1.0.                #
+#                                                                       #
+#########################################################################
+
+include $(BASEDIR)/makefiles/Makefile.toplevel
+include $(BASEDIR)/makefiles/Makefile.common
diff --git a/testsuite/tests/typing-recordarg/recordarg.ml b/testsuite/tests/typing-recordarg/recordarg.ml
new file mode 100644
index 000000000..82fad0783
--- /dev/null
+++ b/testsuite/tests/typing-recordarg/recordarg.ml
@@ -0,0 +1,86 @@
+type t = A of {x:int; mutable y:int};;
+let f (A r) = r;;  (* -> escape *)
+let f (A r) = r.x;; (* ok *)
+let f x = A {x; y = x};; (* ok *)
+let f (A r) = A {r with y = r.x + 1};; (* ok *)
+let f () = A {a = 1};; (* customized error message *)
+let f () = A {x = 1; y = 3};; (* ok *)
+
+type _ t = A: {x : 'a; y : 'b} -> 'a t;;
+let f (A {x; y}) = A {x; y = ()};;  (* ok *)
+let f (A ({x; y} as r)) = A {x = r.x; y = r.y};; (* ok *)
+
+module M = struct
+  type 'a t =
+    | A of {x : 'a}
+    | B: {u : 'b} -> unit t;;
+
+  exception Foo of {x : int};;
+end;;
+
+module N : sig
+  type 'b t = 'b M.t =
+    | A of {x : 'b}
+    | B: {u : 'bla} -> unit t
+
+  exception Foo of {x : int}
+end = struct
+  type 'b t = 'b M.t =
+    | A of {x : 'b}
+    | B: {u : 'z} -> unit t
+
+  exception Foo = M.Foo
+end;;
+
+
+module type S = sig exception A of {x:int}  end;;
+
+module F (X : sig val x : (module S) end) = struct
+  module A = (val X.x)
+end;;  (* -> this expression creates fresh types (not really!) *)
+
+
+module type S = sig
+  exception A of {x : int}
+  exception A of {x : string}
+end;;
+
+module M = struct
+  exception A of {x : int}
+  exception A of {x : string}
+end;;
+
+
+module M1 = struct
+  exception A of {x : int}
+end;;
+
+module M = struct
+  include M1
+  include M1
+end;;
+
+
+module type S1 = sig
+  exception A of {x : int}
+end;;
+
+module type S = sig
+  include S1
+  include S1
+end;;
+
+module M = struct
+  exception A = M1.A
+end;;
+
+module X1 = struct
+  type t = ..
+end;;
+module X2 = struct
+  type t = ..
+end;;
+module Z = struct
+  type X1.t += A of {x: int}
+  type X2.t += A of {x: int}
+end;;
diff --git a/testsuite/tests/typing-recordarg/recordarg.ml.reference b/testsuite/tests/typing-recordarg/recordarg.ml.reference
new file mode 100644
index 000000000..12f609aca
--- /dev/null
+++ b/testsuite/tests/typing-recordarg/recordarg.ml.reference
@@ -0,0 +1,64 @@
+
+# type t = A of { x : int; mutable y : int; }
+# Characters 14-15:
+  let f (A r) = r;;  (* -> escape *)
+                ^
+Error: This form is not allowed as the type of the inlined record could escape.
+# val f : t -> int = <fun>
+# val f : int -> t = <fun>
+# val f : t -> t = <fun>
+# Characters 14-15:
+  let f () = A {a = 1};; (* customized error message *)
+                ^
+Error: The field a is not part of the record argument for the t.A constructor
+# val f : unit -> t = <fun>
+#   type _ t = A : { x : 'a; y : 'b; } -> 'a t
+# val f : 'a t -> 'a t = <fun>
+# val f : 'a t -> 'a t = <fun>
+#               module M :
+  sig
+    type 'a t = A of { x : 'a; } | B : { u : 'b; } -> unit t
+    exception Foo of { x : int; }
+  end
+#                           module N :
+  sig
+    type 'b t = 'b M.t = A of { x : 'b; } | B : { u : 'bla; } -> unit t
+    exception Foo of { x : int; }
+  end
+#     module type S = sig exception A of { x : int; } end
+#       Characters 65-74:
+    module A = (val X.x)
+               ^^^^^^^^^
+Error: This expression creates fresh types.
+       It is not allowed inside applicative functors.
+#           Characters 61-62:
+    exception A of {x : string}
+              ^
+Error: Multiple definition of the extension constructor name A.
+       Names must be unique in a given structure or signature.
+#         Characters 58-59:
+    exception A of {x : string}
+              ^
+Error: Multiple definition of the extension constructor name A.
+       Names must be unique in a given structure or signature.
+#         module M1 : sig exception A of { x : int; } end
+#         Characters 34-44:
+    include M1
+    ^^^^^^^^^^
+Error: Multiple definition of the extension constructor name A.
+       Names must be unique in a given structure or signature.
+#         module type S1 = sig exception A of { x : int; } end
+#         Characters 36-46:
+    include S1
+    ^^^^^^^^^^
+Error: Multiple definition of the extension constructor name A.
+       Names must be unique in a given structure or signature.
+#       module M : sig exception A of { x : int; } end
+#       module X1 : sig type t = .. end
+#     module X2 : sig type t = .. end
+#       Characters 62-63:
+    type X2.t += A of {x: int}
+                 ^
+Error: Multiple definition of the extension constructor name A.
+       Names must be unique in a given structure or signature.
+#