merge changes from branch 4.02 from branching (rev 14852) to 4.02.0+rc1 (rev 15121)

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

52 files changed, 512 insertions, 108 deletions

diff --git a/testsuite/interactive/lib-gc/alloc.ml b/testsuite/interactive/lib-gc/alloc.ml
index 2db8034690..aadecab28e 100644
--- a/testsuite/interactive/lib-gc/alloc.ml
+++ b/testsuite/interactive/lib-gc/alloc.ml
@@ -21,7 +21,7 @@
 let l = 32768;;
 let m = 1000;;
 
-let ar = Array.create l "";;
+let ar = Array.make l "";;
 
 Random.init 1234;;
 
diff --git a/testsuite/interactive/lib-graph-3/sorts.ml b/testsuite/interactive/lib-graph-3/sorts.ml
index 126463d2cb..6e00d25663 100644
--- a/testsuite/interactive/lib-graph-3/sorts.ml
+++ b/testsuite/interactive/lib-graph-3/sorts.ml
@@ -75,7 +75,7 @@ let initialize name array maxval x y w h =
 (* Main animation function *)
 
 let display functs nelts maxval =
-  let a = Array.create nelts 0 in
+  let a = Array.make nelts 0 in
   for i = 0 to nelts - 1 do
     a.(i) <- Random.int maxval
   done;
diff --git a/testsuite/tests/asmcomp/mainarith.c b/testsuite/tests/asmcomp/mainarith.c
index f935391b58..d102c16dc3 100644
--- a/testsuite/tests/asmcomp/mainarith.c
+++ b/testsuite/tests/asmcomp/mainarith.c
@@ -33,25 +33,29 @@ double F, G;
 #define INTTEST(arg,res) \
   { intnat result = (res); \
     if (arg != result) \
-      printf("Failed test \"%s == %s\" for X=%"FMT"d and Y=%"FMT"d: result %"FMT"d, expected %"FMT"d\n", \
+      printf("Failed test \"%s == %s\" for X=%"FMT"d and Y=%"FMT"d: " \
+             "result %"FMT"d, expected %"FMT"d\n",                    \
              #arg, #res, X, Y, arg, result); \
   }
 #define INTFLOATTEST(arg,res) \
   { intnat result = (res); \
     if (arg != result) \
-      printf("Failed test \"%s == %s\" for F=%.15g and G=%.15g: result %"FMT"d, expected %"FMT"d\n", \
+      printf("Failed test \"%s == %s\" for F=%.15g and G=%.15g: "\
+             "result %"FMT"d, expected %"FMT"d\n",               \
              #arg, #res, F, G, arg, result); \
   }
 #define FLOATTEST(arg,res) \
   { double result = (res); \
     if (arg < result || arg > result) \
-      printf("Failed test \"%s == %s\" for F=%.15g and G=%.15g: result %.15g, expected %.15g\n", \
+      printf("Failed test \"%s == %s\" for F=%.15g and G=%.15g: "\
+             "result %.15g, expected %.15g\n",                   \
              #arg, #res, F, G, arg, result); \
   }
 #define FLOATINTTEST(arg,res) \
   { double result = (res); \
     if (arg < result || arg > result) \
-      printf("Failed test \"%s == %s\" for X=%"FMT"d and Y=%"FMT"d: result %.15g, expected %.15g\n", \
+      printf("Failed test \"%s == %s\" for X=%"FMT"d and Y=%"FMT"d: "\
+             "result %.15g, expected %.15g\n",                       \
              #arg, #res, X, Y, arg, result); \
   }
 
diff --git a/testsuite/tests/asmcomp/optargs.ml b/testsuite/tests/asmcomp/optargs.ml
index a4f4040703..92705bd25e 100644
--- a/testsuite/tests/asmcomp/optargs.ml
+++ b/testsuite/tests/asmcomp/optargs.ml
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                        Alain Frisch, LexiFi                         *)
+(*                                                                     *)
+(*  Copyright 2014 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.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 (* Check the effectiveness of inlining the wrapper which fills in
    default values for optional arguments.
 
diff --git a/testsuite/tests/asmcomp/parsecmm.mly b/testsuite/tests/asmcomp/parsecmm.mly
index c81ca619b6..e936c25879 100644
--- a/testsuite/tests/asmcomp/parsecmm.mly
+++ b/testsuite/tests/asmcomp/parsecmm.mly
@@ -24,9 +24,9 @@ let rec make_letdef def body =
       Clet(id, def, make_letdef rem body)
 
 let make_switch n selector caselist =
-  let index = Array.create n 0 in
+  let index = Array.make n 0 in
   let casev = Array.of_list caselist in
-  let actv = Array.create (Array.length casev) (Cexit(0,[])) in
+  let actv = Array.make (Array.length casev) (Cexit(0,[])) in
   for i = 0 to Array.length casev - 1 do
     let (posl, e) = casev.(i) in
     List.iter (fun pos -> index.(pos) <- i) posl;
diff --git a/testsuite/tests/asmcomp/staticalloc.ml b/testsuite/tests/asmcomp/staticalloc.ml
index e21fdee633..3186686c7b 100644
--- a/testsuite/tests/asmcomp/staticalloc.ml
+++ b/testsuite/tests/asmcomp/staticalloc.ml
@@ -1,3 +1,15 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*                        Alain Frisch, LexiFi                         *)
+(*                                                                     *)
+(*  Copyright 2014 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.               *)
+(*                                                                     *)
+(***********************************************************************)
+
 (* Check the effectiveness of structured constant propagation and
    static allocation.
 
diff --git a/testsuite/tests/basic-modules/Makefile b/testsuite/tests/basic-modules/Makefile
new file mode 100644
index 0000000000..62dbc2a690
--- /dev/null
+++ b/testsuite/tests/basic-modules/Makefile
@@ -0,0 +1,19 @@
+#########################################################################
+#                                                                       #
+#                                 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.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
+
+MODULES=offset
+MAIN_MODULE=main
+
+include $(BASEDIR)/makefiles/Makefile.one
+include $(BASEDIR)/makefiles/Makefile.common
diff --git a/testsuite/tests/basic-modules/main.ml b/testsuite/tests/basic-modules/main.ml
new file mode 100644
index 0000000000..54f8cbd61d
--- /dev/null
+++ b/testsuite/tests/basic-modules/main.ml
@@ -0,0 +1,13 @@
+(* PR#6435 *)
+
+module F (M : sig
+           type t
+           module Set : Set.S with type elt = t
+         end) =
+struct
+ let test set = Printf.printf "%d\n" (M.Set.cardinal set)
+end
+
+module M = F (Offset)
+
+let () = M.test (Offset.M.Set.singleton "42")
diff --git a/testsuite/tests/basic-modules/main.reference b/testsuite/tests/basic-modules/main.reference
new file mode 100644
index 0000000000..d00491fd7e
--- /dev/null
+++ b/testsuite/tests/basic-modules/main.reference
@@ -0,0 +1 @@
+1
diff --git a/testsuite/tests/basic-modules/offset.ml b/testsuite/tests/basic-modules/offset.ml
new file mode 100644
index 0000000000..457947dcd5
--- /dev/null
+++ b/testsuite/tests/basic-modules/offset.ml
@@ -0,0 +1,10 @@
+module M = struct
+ type t = string
+
+ let x = 0
+ let x = 1
+
+ module Set = Set.Make(String)
+end
+
+include M
diff --git a/testsuite/tests/basic/arrays.ml b/testsuite/tests/basic/arrays.ml
index e123edff61..b56893f5e0 100644
--- a/testsuite/tests/basic/arrays.ml
+++ b/testsuite/tests/basic/arrays.ml
@@ -79,7 +79,7 @@ let test3 () =
   and t2 = AbstractFloat.from_float 2.0
   and t3 = AbstractFloat.from_float 3.0 in
   let v = [|t1;t2;t3|] in
-  let w = Array.create 2 t1 in
+  let w = Array.make 2 t1 in
   let u = Array.copy v in
   if not (AbstractFloat.to_float v.(0) = 1.0 &&
           AbstractFloat.to_float v.(1) = 2.0 &&
diff --git a/testsuite/tests/lib-threads/test1.ml b/testsuite/tests/lib-threads/test1.ml
index 8961b6f857..c551fbc5dd 100644
--- a/testsuite/tests/lib-threads/test1.ml
+++ b/testsuite/tests/lib-threads/test1.ml
@@ -21,7 +21,7 @@ type 'a prodcons =
     notfull: Condition.t }
 
 let create size init =
-  { buffer = Array.create size init;
+  { buffer = Array.make size init;
     lock = Mutex.create();
     readpos = 0;
     writepos = 0;
diff --git a/testsuite/tests/lib-threads/testsocket.ml b/testsuite/tests/lib-threads/testsocket.ml
index 4b41e0b937..6b2b0b0495 100644
--- a/testsuite/tests/lib-threads/testsocket.ml
+++ b/testsuite/tests/lib-threads/testsocket.ml
@@ -33,11 +33,11 @@ let main() =
     match Sys.argv with
     |  [| _ |] -> false, [| Sys.argv.(0); "caml.inria.fr" |]
     | _ -> true, Sys.argv in
-  let addresses = Array.create (Array.length argv - 1) inet_addr_any in
+  let addresses = Array.make (Array.length argv - 1) inet_addr_any in
   for i = 1 to Array.length argv - 1 do
     addresses.(i - 1) <- (gethostbyname argv.(i)).h_addr_list.(0)
   done;
-  let processes = Array.create (Array.length addresses) (Thread.self()) in
+  let processes = Array.make (Array.length addresses) (Thread.self()) in
   for i = 0 to Array.length addresses - 1 do
     processes.(i) <- Thread.create (engine verbose i) addresses.(i)
   done;
diff --git a/testsuite/tests/lib-threads/token1.ml b/testsuite/tests/lib-threads/token1.ml
index d6e7a1b7ab..d0a7528b08 100644
--- a/testsuite/tests/lib-threads/token1.ml
+++ b/testsuite/tests/lib-threads/token1.ml
@@ -39,7 +39,7 @@ let process (n, conds, nprocs) =
 let main() =
   let nprocs = try int_of_string Sys.argv.(1) with _ -> 100 in
   let iter = try int_of_string Sys.argv.(2) with _ -> 1000 in
-  let conds = Array.create nprocs (Condition.create()) in
+  let conds = Array.make nprocs (Condition.create()) in
   for i = 1 to nprocs - 1 do conds.(i) <- Condition.create() done;
   niter := iter;
   for i = 0 to nprocs - 1 do Thread.create process (i, conds, nprocs) done;
diff --git a/testsuite/tests/lib-threads/token2.ml b/testsuite/tests/lib-threads/token2.ml
index 9ef05806ef..c3548fb0f2 100644
--- a/testsuite/tests/lib-threads/token2.ml
+++ b/testsuite/tests/lib-threads/token2.ml
@@ -35,9 +35,9 @@ let process (n, ins, outs, nprocs) =
 let main() =
   let nprocs = try int_of_string Sys.argv.(1) with _ -> 100 in
   let iter = try int_of_string Sys.argv.(2) with _ -> 1000 in
-  let ins = Array.create nprocs Unix.stdin in
-  let outs = Array.create nprocs Unix.stdout in
-  let threads = Array.create nprocs (Thread.self ()) in
+  let ins = Array.make nprocs Unix.stdin in
+  let outs = Array.make nprocs Unix.stdout in
+  let threads = Array.make nprocs (Thread.self ()) in
   for n = 0 to nprocs - 1 do
     let (i, o) = Unix.pipe() in ins.(n) <- i; outs.(n) <- o
   done;
diff --git a/testsuite/tests/misc-unsafe/fft.ml b/testsuite/tests/misc-unsafe/fft.ml
index 2c1cf38b0f..7e2442b0b0 100644
--- a/testsuite/tests/misc-unsafe/fft.ml
+++ b/testsuite/tests/misc-unsafe/fft.ml
@@ -135,8 +135,8 @@ let test np =
   print_int np; print_string "... "; flush stdout;
   let enp = float np in
   let npm = np / 2 - 1 in
-  let pxr = Array.create (np+2) 0.0
-  and pxi = Array.create (np+2) 0.0 in
+  let pxr = Array.make (np+2) 0.0
+  and pxi = Array.make (np+2) 0.0 in
   let t = pi /. enp in
   pxr.(1) <- (enp -. 1.0) *. 0.5;
   pxi.(1) <- 0.0;
diff --git a/testsuite/tests/misc-unsafe/quicksort.ml b/testsuite/tests/misc-unsafe/quicksort.ml
index 4f872fd24a..8879d95291 100644
--- a/testsuite/tests/misc-unsafe/quicksort.ml
+++ b/testsuite/tests/misc-unsafe/quicksort.ml
@@ -63,8 +63,8 @@ let random() =
 exception Failed
 
 let test_sort sort_fun size =
-  let a = Array.create size 0 in
-  let check = Array.create 4096 0 in
+  let a = Array.make size 0 in
+  let check = Array.make 4096 0 in
   for i = 0 to size-1 do
     let n = random() in a.(i) <- n; check.(n) <- check.(n)+1
   done;
diff --git a/testsuite/tests/misc/bdd.ml b/testsuite/tests/misc/bdd.ml
index 954edc1648..297eb68e45 100644
--- a/testsuite/tests/misc/bdd.ml
+++ b/testsuite/tests/misc/bdd.ml
@@ -31,14 +31,14 @@ let getId bdd =
 let initSize_1 = 8*1024 - 1
 let nodeC      = ref 1
 let sz_1       = ref initSize_1
-let htab       = ref(Array.create (!sz_1+1) [])
+let htab       = ref(Array.make (!sz_1+1) [])
 let n_items    = ref 0
 let hashVal x y v = x lsl 1 + y + v lsl 2
 
 let resize newSize =
       let arr     = !htab in
       let newSz_1 = newSize-1 in
-      let newArr  = Array.create newSize [] in
+      let newArr  = Array.make newSize [] in
       let rec copyBucket bucket =
                 match bucket with
                   []     -> ()
@@ -71,7 +71,7 @@ let rec insert idl idh v ind bucket newNode =
 
 let resetUnique () = (
       sz_1    := initSize_1;
-      htab    := Array.create (!sz_1+1) [];
+      htab    := Array.make (!sz_1+1) [];
       n_items := 0;
       nodeC   := 1
       )
@@ -111,14 +111,14 @@ let mkVar x   = mkNode zero x one
 
 
 let cacheSize = 1999
-let andslot1  = Array.create cacheSize 0
-let andslot2  = Array.create cacheSize 0
-let andslot3  = Array.create cacheSize zero
-let xorslot1  = Array.create cacheSize 0
-let xorslot2  = Array.create cacheSize 0
-let xorslot3  = Array.create cacheSize zero
-let notslot1  = Array.create cacheSize 0
-let notslot2  = Array.create cacheSize one
+let andslot1  = Array.make cacheSize 0
+let andslot2  = Array.make cacheSize 0
+let andslot3  = Array.make cacheSize zero
+let xorslot1  = Array.make cacheSize 0
+let xorslot2  = Array.make cacheSize 0
+let xorslot3  = Array.make cacheSize zero
+let notslot1  = Array.make cacheSize 0
+let notslot2  = Array.make cacheSize one
 let hash x y  = ((x lsl 1)+y) mod cacheSize
 
 let rec not n =
@@ -196,7 +196,7 @@ let random() =
   seed := !seed * 25173 + 17431; !seed land 1 > 0
 
 let random_vars n =
-  let vars = Array.create n false in
+  let vars = Array.make n false in
   for i = 0 to n - 1 do vars.(i) <- random() done;
   vars
 
diff --git a/testsuite/tests/tool-debugger/.ignore b/testsuite/tests/tool-debugger/basic/.ignore
index e09cf9eb6e..e09cf9eb6e 100644
--- a/testsuite/tests/tool-debugger/.ignore
+++ b/testsuite/tests/tool-debugger/basic/.ignore
diff --git a/testsuite/tests/tool-debugger/Makefile b/testsuite/tests/tool-debugger/basic/Makefile
index f95b4803b6..f95b4803b6 100644
--- a/testsuite/tests/tool-debugger/Makefile
+++ b/testsuite/tests/tool-debugger/basic/Makefile
diff --git a/testsuite/tests/tool-debugger/debuggee.ml b/testsuite/tests/tool-debugger/basic/debuggee.ml
index 341d0b369f..341d0b369f 100644
--- a/testsuite/tests/tool-debugger/debuggee.ml
+++ b/testsuite/tests/tool-debugger/basic/debuggee.ml
diff --git a/testsuite/tests/tool-debugger/debuggee.reference b/testsuite/tests/tool-debugger/basic/debuggee.reference
index e998926c3d..e998926c3d 100644
--- a/testsuite/tests/tool-debugger/debuggee.reference
+++ b/testsuite/tests/tool-debugger/basic/debuggee.reference
diff --git a/testsuite/tests/tool-debugger/input_script b/testsuite/tests/tool-debugger/basic/input_script
index 2caf06dd4d..2caf06dd4d 100755
--- a/testsuite/tests/tool-debugger/input_script
+++ b/testsuite/tests/tool-debugger/basic/input_script
diff --git a/testsuite/tests/tool-debugger/find-artifacts/.ignore b/testsuite/tests/tool-debugger/find-artifacts/.ignore
new file mode 100644
index 0000000000..0a2c0c40cf
--- /dev/null
+++ b/testsuite/tests/tool-debugger/find-artifacts/.ignore
@@ -0,0 +1,2 @@
+compiler-libs
+out
diff --git a/testsuite/tests/tool-debugger/find-artifacts/Makefile b/testsuite/tests/tool-debugger/find-artifacts/Makefile
new file mode 100644
index 0000000000..f313d86424
--- /dev/null
+++ b/testsuite/tests/tool-debugger/find-artifacts/Makefile
@@ -0,0 +1,67 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#            Damien Doligez, EPI Gallium, INRIA Rocquencourt            #
+#                                                                       #
+#   Copyright 2013 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.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../../..
+MAIN_MODULE=debuggee
+ADD_COMPFLAGS=-g -custom
+LD_PATH=$(TOPDIR)/otherlibs/$(UNIXLIBVAR)unix
+
+.PHONY: default
+default:
+	@if ! $(SUPPORTS_SHARED_LIBRARIES); then \
+	  echo 'skipped (shared libraries not available)'; \
+	else \
+	  $(MAKE) compile; \
+	  $(SET_LD_PATH) OCAMLLIB=. $(MAKE) run; \
+	fi
+
+.PHONY: compile
+compile: $(ML_FILES) $(CMO_FILES)
+	@rm -rf out
+	@rm -f program.byte program.byte.exe
+	@mkdir out
+	@$(OCAMLC) $(ADD_COMPFLAGS) $(ADD_CFLAGS) -o out/blah.cmo -c \
+	           $(O_FILES) $(CMA_FILES) $(CMO_FILES) $(ADD_CMO_FILES) \
+	           in/blah.ml
+	@$(OCAMLC) $(ADD_COMPFLAGS) $(ADD_CFLAGS) -o out/foo.cmo -c \
+	           $(O_FILES) $(CMA_FILES) $(CMO_FILES) $(ADD_CMO_FILES) \
+	           -I out in/foo.ml
+	@$(OCAMLC) $(ADD_COMPFLAGS) $(ADD_CFLAGS) -o program.byte$(EXE) \
+	           $(O_FILES) $(CMA_FILES) $(CMO_FILES) $(ADD_CMO_FILES) \
+						 out/blah.cmo out/foo.cmo
+	@mkdir -p compiler-libs
+	@cp $(TOPDIR)/toplevel/topdirs.cmi compiler-libs/
+
+.PHONY: run
+run:
+	@printf " ... testing with ocamlc"
+	@rm -f $(MAIN_MODULE).result
+	@echo 'source input_script' | \
+	 $(OCAMLRUN) `$(CYGPATH) $(TOPDIR)/debugger/ocamldebug$(EXE)` \
+	             program.byte$(EXE) >$(MAIN_MODULE).raw.result 2>&1 \
+	 && sed -e '/Debugger version/d' -e '/^Time:/d' \
+	        -e '/Breakpoint [0-9]* at [0-9]*:/d' -e '$$d' \
+	        $(MAIN_MODULE).raw.result >$(MAIN_MODULE).result \
+	 && $(DIFF) $(MAIN_MODULE).reference $(MAIN_MODULE).result >/dev/null \
+	 && echo " => passed" || echo " => failed"
+
+.PHONY: promote
+promote: defaultpromote
+
+.PHONY: clean
+clean: defaultclean
+	@rm -f *.result program.byte program.byte.exe \
+	       program.native program.native.exe \
+	       $(GENERATED_SOURCES) $(O_FILES) $(TEST_TEMP_FILES)
+	@rm -rf compiler-libs out
+
+include $(BASEDIR)/makefiles/Makefile.common
diff --git a/testsuite/tests/tool-debugger/find-artifacts/debuggee.reference b/testsuite/tests/tool-debugger/find-artifacts/debuggee.reference
new file mode 100644
index 0000000000..06564f90bb
--- /dev/null
+++ b/testsuite/tests/tool-debugger/find-artifacts/debuggee.reference
@@ -0,0 +1,6 @@
+
+(ocd) Loading program... done.
+Breakpoint: 1
+10   <|b|>print x;
+x: Blah.blah = Foo
+y: Blah.blah = Bar "hi"
diff --git a/testsuite/tests/tool-debugger/find-artifacts/in/blah.ml b/testsuite/tests/tool-debugger/find-artifacts/in/blah.ml
new file mode 100644
index 0000000000..462c07b2e1
--- /dev/null
+++ b/testsuite/tests/tool-debugger/find-artifacts/in/blah.ml
@@ -0,0 +1,3 @@
+type blah =
+  | Foo
+  | Bar of string
diff --git a/testsuite/tests/tool-debugger/find-artifacts/in/foo.ml b/testsuite/tests/tool-debugger/find-artifacts/in/foo.ml
new file mode 100644
index 0000000000..8d992673be
--- /dev/null
+++ b/testsuite/tests/tool-debugger/find-artifacts/in/foo.ml
@@ -0,0 +1,13 @@
+open Blah
+
+let print = function
+  | Foo -> print_endline "Foo";
+  | Bar s -> print_endline ("Bar(" ^ s ^ ")")
+
+let main () =
+  let x = Foo in
+  let y = Bar "hi" in
+  print x;
+  print y
+
+let _ = main ()
diff --git a/testsuite/tests/tool-debugger/find-artifacts/input_script b/testsuite/tests/tool-debugger/find-artifacts/input_script
new file mode 100644
index 0000000000..4b907c5ae6
--- /dev/null
+++ b/testsuite/tests/tool-debugger/find-artifacts/input_script
@@ -0,0 +1,5 @@
+break @ Foo 10
+run
+print x
+print y
+quit
diff --git a/testsuite/tests/tool-lexyacc/lexgen.ml b/testsuite/tests/tool-lexyacc/lexgen.ml
index d5dd517a5b..005ea68d9b 100644
--- a/testsuite/tests/tool-lexyacc/lexgen.ml
+++ b/testsuite/tests/tool-lexyacc/lexgen.ml
@@ -166,7 +166,7 @@ let rec lastpos = function
 
 
 let followpos size name_regexp_list =
-  let v = Array.create size [] in
+  let v = Array.make size [] in
     let fill_pos first = function
         OnChars pos -> v.(pos) <- merge_trans first v.(pos); ()
       | ToAction _  -> () in
@@ -223,8 +223,8 @@ let goto_state = function
 
 
 let transition_from chars follow pos_set =
-  let tr = Array.create 256 []
-  and shift = Array.create 256 Backtrack in
+  let tr = Array.make 256 []
+  and shift = Array.make 256 Backtrack in
     List.iter
       (fun pos ->
         List.iter
@@ -263,6 +263,6 @@ let make_dfa lexdef =
   let states =
     map_on_states (translate_state chars follow) in
   let v =
-    Array.create (number_of_states()) (Perform 0) in
+    Array.make (number_of_states()) (Perform 0) in
   List.iter (fun (auto, i) -> v.(i) <- auto) states;
   (initial_states, v, actions)
diff --git a/testsuite/tests/tool-toplevel/Makefile b/testsuite/tests/tool-toplevel/Makefile
new file mode 100644
index 0000000000..c9433b2ecb
--- /dev/null
+++ b/testsuite/tests/tool-toplevel/Makefile
@@ -0,0 +1,15 @@
+#########################################################################
+#                                                                       #
+#                                 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.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
+include $(BASEDIR)/makefiles/Makefile.toplevel
+include $(BASEDIR)/makefiles/Makefile.common
diff --git a/testsuite/tests/tool-toplevel/tracing.ml b/testsuite/tests/tool-toplevel/tracing.ml
new file mode 100644
index 0000000000..5acaff238c
--- /dev/null
+++ b/testsuite/tests/tool-toplevel/tracing.ml
@@ -0,0 +1,4 @@
+List.fold_left;;
+#trace List.fold_left;;
+0;;
+List.fold_left (+) 0 [1;2;3];;
diff --git a/testsuite/tests/tool-toplevel/tracing.ml.reference b/testsuite/tests/tool-toplevel/tracing.ml.reference
new file mode 100644
index 0000000000..e6eda8d7f9
--- /dev/null
+++ b/testsuite/tests/tool-toplevel/tracing.ml.reference
@@ -0,0 +1,30 @@
+
+# - : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a = <fun>
+# List.fold_left is now traced.
+# - : int = 0
+# List.fold_left <-- <fun>
+List.fold_left --> <fun>
+List.fold_left* <-- <poly>
+List.fold_left* --> <fun>
+List.fold_left** <-- [<poly>; <poly>; <poly>]
+List.fold_left <-- <fun>
+List.fold_left --> <fun>
+List.fold_left* <-- <poly>
+List.fold_left* --> <fun>
+List.fold_left** <-- [<poly>; <poly>]
+List.fold_left <-- <fun>
+List.fold_left --> <fun>
+List.fold_left* <-- <poly>
+List.fold_left* --> <fun>
+List.fold_left** <-- [<poly>]
+List.fold_left <-- <fun>
+List.fold_left --> <fun>
+List.fold_left* <-- <poly>
+List.fold_left* --> <fun>
+List.fold_left** <-- []
+List.fold_left** --> <poly>
+List.fold_left** --> <poly>
+List.fold_left** --> <poly>
+List.fold_left** --> <poly>
+- : int = 6
+# 
diff --git a/testsuite/tests/typing-gadts/didier.ml b/testsuite/tests/typing-gadts/didier.ml
new file mode 100644
index 0000000000..8091375c0a
--- /dev/null
+++ b/testsuite/tests/typing-gadts/didier.ml
@@ -0,0 +1,48 @@
+type 'a ty = 
+  | Int : int ty
+  | Bool : bool ty
+
+let fbool (type t) (x : t) (tag : t ty) = 
+  match tag with 
+  | Bool -> x
+;;
+(* val fbool : 'a -> 'a ty -> 'a = <fun> *)
+(** OK: the return value is x of type t **)
+
+let fint (type t) (x : t) (tag : t ty) = 
+  match tag with 
+  | Int -> x > 0
+;;
+(* val fint : 'a -> 'a ty -> bool = <fun> *)
+(** OK: the return value is x > 0 of type bool;
+This has used the equation t = bool, not visible in the return type **)
+
+let f (type t) (x : t) (tag : t ty) = 
+  match tag with 
+  | Int -> x > 0
+  | Bool -> x
+(* val f : 'a -> 'a ty -> bool = <fun> *)
+
+
+let g (type t) (x : t) (tag : t ty) = 
+  match tag with 
+  | Bool -> x
+  | Int -> x > 0
+(* Error: This expression has type bool but an expression was expected of type
+t = int *)
+
+let id x = x;;
+let idb1 = (fun id -> let _ = id true in id) id;;
+let idb2 : bool -> bool = id;;
+let idb3 ( _ : bool ) = false;;
+
+let g (type t) (x : t) (tag : t ty) =
+  match tag with
+  | Bool -> idb3 x
+  | Int -> x > 0
+
+let g (type t) (x : t) (tag : t ty) =
+  match tag with
+  | Bool -> idb2 x
+  | Int -> x > 0
+
diff --git a/testsuite/tests/typing-misc/constraints.ml b/testsuite/tests/typing-misc/constraints.ml
index 5408ca2c1b..a006363254 100644
--- a/testsuite/tests/typing-misc/constraints.ml
+++ b/testsuite/tests/typing-misc/constraints.ml
@@ -14,3 +14,11 @@ type 'a t = 'a;;
 let f (x : 'a t as 'a) = ();; (* fails *)
 
 let f (x : 'a t) (y : 'a) = x = y;;
+
+(* PR#6505 *)
+module type PR6505 = sig
+  type 'o is_an_object = < .. > as 'o
+  and 'o abs constraint 'o = 'o is_an_object
+  val abs : 'o is_an_object -> 'o abs
+  val unabs : 'o abs -> 'o
+end;; (* fails *)
diff --git a/testsuite/tests/typing-misc/constraints.ml.reference b/testsuite/tests/typing-misc/constraints.ml.reference
index fe52044002..83a3dc1f99 100644
--- a/testsuite/tests/typing-misc/constraints.ml.reference
+++ b/testsuite/tests/typing-misc/constraints.ml.reference
@@ -26,4 +26,9 @@ Error: This alias is bound to type 'a t = 'a
        but is used as an instance of type 'a
        The type variable 'a occurs inside 'a
 #   val f : 'a t -> 'a -> bool = <fun>
+#               Characters 83-122:
+    and 'o abs constraint 'o = 'o is_an_object
+       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of abs contains a cycle:
+       'a is_an_object as 'a
 # 
diff --git a/testsuite/tests/typing-misc/labels.ml.principal.reference b/testsuite/tests/typing-misc/labels.ml.principal.reference
index 2f21fd3f0b..f8be126bb8 100644
--- a/testsuite/tests/typing-misc/labels.ml.principal.reference
+++ b/testsuite/tests/typing-misc/labels.ml.principal.reference
@@ -12,5 +12,5 @@ Warning 43: the label x is not optional.
   foo (fun ?opt () -> ()) ;; (* fails *)
       ^^^^^^^^^^^^^^^^^^^
 Error: This function should have type unit -> unit
-       but its first argument is labelled ~?opt
+       but its first argument is labelled ?opt
 # 
diff --git a/testsuite/tests/typing-misc/labels.ml.reference b/testsuite/tests/typing-misc/labels.ml.reference
index 2f21fd3f0b..f8be126bb8 100644
--- a/testsuite/tests/typing-misc/labels.ml.reference
+++ b/testsuite/tests/typing-misc/labels.ml.reference
@@ -12,5 +12,5 @@ Warning 43: the label x is not optional.
   foo (fun ?opt () -> ()) ;; (* fails *)
       ^^^^^^^^^^^^^^^^^^^
 Error: This function should have type unit -> unit
-       but its first argument is labelled ~?opt
+       but its first argument is labelled ?opt
 # 
diff --git a/testsuite/tests/typing-misc/variant.ml b/testsuite/tests/typing-misc/variant.ml
new file mode 100644
index 0000000000..b0bd522277
--- /dev/null
+++ b/testsuite/tests/typing-misc/variant.ml
@@ -0,0 +1,8 @@
+(* PR#6394 *)
+
+module rec X : sig
+ type t = int * bool
+end = struct
+ type t = A | B
+ let f = function A | B -> 0
+end;;
diff --git a/testsuite/tests/typing-misc/variant.ml.reference b/testsuite/tests/typing-misc/variant.ml.reference
new file mode 100644
index 0000000000..4de6b611e6
--- /dev/null
+++ b/testsuite/tests/typing-misc/variant.ml.reference
@@ -0,0 +1,16 @@
+
+#               Characters 61-116:
+  ......struct
+   type t = A | B
+   let f = function A | B -> 0
+  end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = X.t = A | B val f : t -> int end
+       is not included in
+         sig type t = int * bool end
+       Type declarations do not match:
+         type t = X.t = A | B
+       is not included in
+         type t = int * bool
+# 
diff --git a/testsuite/tests/typing-modules-bugs/pr6427_bad.ml b/testsuite/tests/typing-modules-bugs/pr6427_bad.ml
new file mode 100644
index 0000000000..286dafb88a
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr6427_bad.ml
@@ -0,0 +1,20 @@
+let flag = ref false
+module F(S : sig module type T end) (A : S.T) (B : S.T) =
+struct
+  module X = (val if !flag then (module A) else (module B) : S.T)
+end
+
+(* If the above were accepted, one could break soundness *)
+module type S = sig type t val x : t end
+module Float = struct type t = float let x = 0.0 end
+module Int = struct type t = int let x = 0 end
+
+module M = F(struct module type T = S end)
+
+let () = flag := false
+module M1 = M(Float)(Int)
+
+let () = flag := true
+module M2 = M(Float)(Int)
+
+let _ = [| M2.X.x; M1.X.x |]
diff --git a/testsuite/tests/typing-modules-bugs/pr6513_ok.ml b/testsuite/tests/typing-modules-bugs/pr6513_ok.ml
new file mode 100644
index 0000000000..f23fc599af
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/pr6513_ok.ml
@@ -0,0 +1,25 @@
+module type PR6513 = sig
+module type S = sig type u end
+
+module type T = sig
+  type 'a wrap
+  type uri
+end
+
+module Make: functor (Html5 : T with type 'a wrap = 'a) ->
+  S with type u = < foo : Html5.uri >
+end
+
+(* Requires -package tyxml
+module type PR6513_orig = sig
+module type S =
+sig
+        type t
+        type u
+end
+
+module Make: functor (Html5: Html5_sigs.T with type 'a Xml.wrap = 'a and type 'a wrap = 'a and type 'a list_wrap = 'a list) -> S with
+        type t = Html5_types.div Html5.elt and
+        type u = < foo: Html5.uri >
+end
+*)
diff --git a/testsuite/tests/typing-modules/aliases.ml b/testsuite/tests/typing-modules/aliases.ml
index b77b0c47db..3eca527145 100644
--- a/testsuite/tests/typing-modules/aliases.ml
+++ b/testsuite/tests/typing-modules/aliases.ml
@@ -4,11 +4,6 @@ C.chr 66;;
 module C' : module type of Char = C;;
 C'.chr 66;;
 
-module C'' : (module C) = C';; (* fails *)
-
-module C'' : (module Char) = C;;
-C''.chr 66;;
-
 module C3 = struct include Char end;;
 C3.chr 66;;
 
@@ -220,3 +215,23 @@ module K = struct
 end;;
 
 let x : K.N.t = "foo";;
+
+(* PR#6465 *)
+
+module M = struct type t = A module B = struct type u = B end end;;
+module P : sig type t = M.t = A module B = M.B end = M;; (* should be ok *)
+module P : sig type t = M.t = A module B = M.B end = struct include M end;;
+
+module type S = sig
+  module M : sig module P : sig end end
+  module Q = M
+end;;
+module type S = sig
+  module M : sig module N : sig end module P : sig end end
+  module Q : sig module N = M.N module P = M.P end
+end;;
+module R = struct
+  module M = struct module N = struct end module P = struct end end
+  module Q = M
+end;;
+module R' : S = R;; (* should be ok *)
diff --git a/testsuite/tests/typing-modules/aliases.ml.reference b/testsuite/tests/typing-modules/aliases.ml.reference
index e820b78e28..2bb3231de4 100644
--- a/testsuite/tests/typing-modules/aliases.ml.reference
+++ b/testsuite/tests/typing-modules/aliases.ml.reference
@@ -13,13 +13,6 @@
     external unsafe_chr : int -> char = "%identity"
   end
 # - : char = 'B'
-#   Characters 27-29:
-  module C'' : (module C) = C';; (* fails *)
-                            ^^
-Error: Signature mismatch:
-       Modules do not match: (module C') is not included in (module C)
-#   module C'' = Char
-# - : char = 'B'
 #   module C3 :
   sig
     external code : char -> int = "%identity"
@@ -374,4 +367,48 @@ Error: Unbound module type A
 #                           module B : sig module R : sig type t = string end module O = R end
 module K : sig module E = B module N = E.O end
 #   val x : K.N.t = "foo"
+#       module M : sig type t = A module B : sig type u = B end end
+# Characters 53-54:
+  module P : sig type t = M.t = A module B = M.B end = M;; (* should be ok *)
+                                                       ^
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = M.t = A module B : sig type u = M.B.u = B end end
+       is not included in
+         sig type t = M.t = A module B = M.B end
+       In module B:
+       Modules do not match:
+         sig type u = M.B.u = B end
+       is not included in
+         (module M.B)
+# module P : sig type t = M.t = A module B = M.B end
+#         module type S = sig module M : sig module P : sig  end end module Q = M end
+#       module type S =
+  sig
+    module M : sig module N : sig  end module P : sig  end end
+    module Q : sig module N = M.N module P = M.P end
+  end
+#       module R :
+  sig
+    module M : sig module N : sig  end module P : sig  end end
+    module Q = M
+  end
+# Characters 16-17:
+  module R' : S = R;; (* should be ok *)
+                  ^
+Error: Signature mismatch:
+       Modules do not match:
+         sig
+           module M : sig module N : sig  end module P : sig  end end
+           module Q = M
+         end
+       is not included in
+         S
+       In module Q:
+       Modules do not match:
+         sig module N : sig  end module P : sig  end end
+       is not included in
+         sig module N = M.N module P = M.P end
+       In module Q.N:
+       Modules do not match: sig  end is not included in (module M.N)
 # 
diff --git a/testsuite/tests/typing-objects/Exemples.ml b/testsuite/tests/typing-objects/Exemples.ml
index ba3e64f011..5ffc6498f9 100644
--- a/testsuite/tests/typing-objects/Exemples.ml
+++ b/testsuite/tests/typing-objects/Exemples.ml
@@ -170,14 +170,14 @@ p1#print (fun x -> x#print);;
 (*******************************************************************)
 
 class virtual comparable () = object (self : 'a)
-  method virtual leq : 'a -> bool
+  method virtual cmp : 'a -> int
   end;;
 
 class int_comparable (x : int) = object
   inherit comparable ()
   val x = x
   method x = x
-  method leq p = x <= p#x
+  method cmp p = compare x p#x
 end;;
 
 class int_comparable2 xi = object
@@ -193,7 +193,7 @@ class ['a] sorted_list () = object
     let rec insert =
       function
             []     ->  [x]
-      | a::l as l' -> if a#leq x then a::(insert l) else x::l'
+      | a::l as l' -> if a#cmp x <= 0 then a::(insert l) else x::l'
     in
       l <- insert l
   method hd = List.hd l
@@ -209,7 +209,7 @@ l#add (c2 :> int_comparable);;      (* Echec : 'a comp2 n'est un sous-type *)
 
 class int_comparable3 (x : int) = object
   val mutable x = x
-  method leq (y : int_comparable) = x < y#x
+  method cmp (y : int_comparable) = compare x y#x
   method x = x
   method setx y = x <- y
 end;;
@@ -218,7 +218,7 @@ let c3 = new int_comparable3 15;;
 l#add (c3 :> int_comparable);;
 (new sorted_list ())#add c3;;   (* Error; strange message with -principal *)
 
-let sort (l : #comparable list) = Sort.list (fun x -> x#leq) l;;
+let sort (l : #comparable list) = List.sort (fun x -> x#cmp) l;;
 let pr l =
   List.map (fun c -> print_int c#x; print_string " ") l;
   print_newline ();;
@@ -231,7 +231,7 @@ pr l;;
 pr (sort l);;
 
 let min (x : #comparable) y =
-  if x#leq y then x else y;;
+  if x#cmp y <= 0 then x else y;;
 
 (min (new int_comparable  7) (new int_comparable 11))#x;;
 (min (new int_comparable2 5) (new int_comparable2 3))#x;;
diff --git a/testsuite/tests/typing-objects/Exemples.ml.principal.reference b/testsuite/tests/typing-objects/Exemples.ml.principal.reference
index 0b04607a21..2b12a7d9b7 100644
--- a/testsuite/tests/typing-objects/Exemples.ml.principal.reference
+++ b/testsuite/tests/typing-objects/Exemples.ml.principal.reference
@@ -183,15 +183,15 @@ and ['a] cons :
 #   val p1 : printable_color_point lst = <obj>
 # ((3, red)::(10, red)::[])- : unit = ()
 #           class virtual comparable :
-  unit -> object ('a) method virtual leq : 'a -> bool end
+  unit -> object ('a) method virtual cmp : 'a -> int end
 #             class int_comparable :
-  int -> object ('a) val x : int method leq : 'a -> bool method x : int end
+  int -> object ('a) val x : int method cmp : 'a -> int method x : int end
 #           class int_comparable2 :
   int ->
   object ('a)
     val x : int
     val mutable x' : int
-    method leq : 'a -> bool
+    method cmp : 'a -> int
     method set_x : int -> unit
     method x : int
   end
@@ -212,19 +212,19 @@ and ['a] cons :
         ^^^^^^^^^^^^^^^^^^^^^^
 Error: Type
          int_comparable2 =
-           < leq : int_comparable2 -> bool; set_x : int -> unit; x : int >
+           < cmp : int_comparable2 -> int; set_x : int -> unit; x : int >
        is not a subtype of
-         int_comparable = < leq : int_comparable -> bool; x : int > 
-       Type int_comparable = < leq : int_comparable -> bool; x : int >
+         int_comparable = < cmp : int_comparable -> int; x : int > 
+       Type int_comparable = < cmp : int_comparable -> int; x : int >
        is not a subtype of
          int_comparable2 =
-           < leq : int_comparable2 -> bool; set_x : int -> unit; x : int > 
+           < cmp : int_comparable2 -> int; set_x : int -> unit; x : int > 
 # - : unit = ()
 #             class int_comparable3 :
   int ->
   object
     val mutable x : int
-    method leq : int_comparable -> bool
+    method cmp : int_comparable -> int
     method setx : int -> unit
     method x : int
   end
@@ -235,11 +235,11 @@ Error: Type
                            ^^
 Error: This expression has type
          int_comparable3 =
-           < leq : int_comparable -> bool; setx : int -> unit; x : int >
+           < cmp : int_comparable -> int; setx : int -> unit; x : int >
        but an expression was expected of type
-         #comparable as 'a = < leq : 'a -> bool; .. >
-       Type int_comparable = < leq : int_comparable -> bool; x : int >
-       is not compatible with type 'a = < leq : 'a -> bool; .. > 
+         #comparable as 'a = < cmp : 'a -> int; .. >
+       Type int_comparable = < cmp : int_comparable -> int; x : int >
+       is not compatible with type 'a = < cmp : 'a -> int; .. > 
        The first object type has no method setx
 #   val sort : (#comparable as 'a) list -> 'a list = <fun>
 #     Characters 13-66:
diff --git a/testsuite/tests/typing-objects/Exemples.ml.reference b/testsuite/tests/typing-objects/Exemples.ml.reference
index 353f607cb5..7cbd68ec29 100644
--- a/testsuite/tests/typing-objects/Exemples.ml.reference
+++ b/testsuite/tests/typing-objects/Exemples.ml.reference
@@ -183,15 +183,15 @@ and ['a] cons :
 #   val p1 : printable_color_point lst = <obj>
 # ((3, red)::(10, red)::[])- : unit = ()
 #           class virtual comparable :
-  unit -> object ('a) method virtual leq : 'a -> bool end
+  unit -> object ('a) method virtual cmp : 'a -> int end
 #             class int_comparable :
-  int -> object ('a) val x : int method leq : 'a -> bool method x : int end
+  int -> object ('a) val x : int method cmp : 'a -> int method x : int end
 #           class int_comparable2 :
   int ->
   object ('a)
     val x : int
     val mutable x' : int
-    method leq : 'a -> bool
+    method cmp : 'a -> int
     method set_x : int -> unit
     method x : int
   end
@@ -212,19 +212,19 @@ and ['a] cons :
         ^^^^^^^^^^^^^^^^^^^^^^
 Error: Type
          int_comparable2 =
-           < leq : int_comparable2 -> bool; set_x : int -> unit; x : int >
+           < cmp : int_comparable2 -> int; set_x : int -> unit; x : int >
        is not a subtype of
-         int_comparable = < leq : int_comparable -> bool; x : int > 
-       Type int_comparable = < leq : int_comparable -> bool; x : int >
+         int_comparable = < cmp : int_comparable -> int; x : int > 
+       Type int_comparable = < cmp : int_comparable -> int; x : int >
        is not a subtype of
          int_comparable2 =
-           < leq : int_comparable2 -> bool; set_x : int -> unit; x : int > 
+           < cmp : int_comparable2 -> int; set_x : int -> unit; x : int > 
 # - : unit = ()
 #             class int_comparable3 :
   int ->
   object
     val mutable x : int
-    method leq : int_comparable -> bool
+    method cmp : int_comparable -> int
     method setx : int -> unit
     method x : int
   end
@@ -235,13 +235,13 @@ Error: Type
                            ^^
 Error: This expression has type
          int_comparable3 =
-           < leq : int_comparable -> bool; setx : int -> unit; x : int >
+           < cmp : int_comparable -> int; setx : int -> unit; x : int >
        but an expression was expected of type
-         #comparable as 'a = < leq : 'a -> bool; .. >
-       Type int_comparable = < leq : int_comparable -> bool; x : int >
+         #comparable as 'a = < cmp : 'a -> int; .. >
+       Type int_comparable = < cmp : int_comparable -> int; x : int >
        is not compatible with type
          int_comparable3 =
-           < leq : int_comparable -> bool; setx : int -> unit; x : int > 
+           < cmp : int_comparable -> int; setx : int -> unit; x : int > 
        The first object type has no method setx
 #   val sort : (#comparable as 'a) list -> 'a list = <fun>
 #     Characters 13-66:
diff --git a/testsuite/tests/typing-objects/Tests.ml b/testsuite/tests/typing-objects/Tests.ml
index befd70d948..917474f961 100644
--- a/testsuite/tests/typing-objects/Tests.ml
+++ b/testsuite/tests/typing-objects/Tests.ml
@@ -236,7 +236,7 @@ end;;
 let d = new d () in d#xc, d#xd;;
 
 class virtual ['a] matrix (sz, init : int * 'a) = object
-  val m = Array.create_matrix sz sz init
+  val m = Array.make_matrix sz sz init
   method add (mtx : 'a matrix) = (mtx#m.(0).(0) : 'a)
 end;;
 
@@ -305,26 +305,28 @@ class c () = object method virtual m : int method private m = 1 end;;
 
 (* Marshaling (cf. PR#5436) *)
 
-Oo.id (object end);;
-Oo.id (object end);;
-Oo.id (object end);;
+let r = ref 0;;
+let id o = Oo.id o - !r;;
+r := Oo.id (object end);;
+id (object end);;
+id (object end);;
 let o = object end in
   let s = Marshal.to_string o [] in
   let o' : < > = Marshal.from_string s 0 in
   let o'' : < > = Marshal.from_string s 0 in
-  (Oo.id o, Oo.id o', Oo.id o'');;
+  (id o, id o', id o'');;
 
 let o = object val x = 33 method m = x end in
   let s = Marshal.to_string o [Marshal.Closures] in
   let o' : <m:int> = Marshal.from_string s 0 in
   let o'' : <m:int> = Marshal.from_string s 0 in
-  (Oo.id o, Oo.id o', Oo.id o'', o#m, o'#m);;
+  (id o, id o', id o'', o#m, o'#m);;
 
 let o = object val x = 33 val y = 44 method m = x end in
-  let s = Marshal.to_string o [Marshal.Closures] in
-  let o' : <m:int> = Marshal.from_string s 0 in
-  let o'' : <m:int> = Marshal.from_string s 0 in
-  (Oo.id o, Oo.id o', Oo.id o'', o#m, o'#m);;
+  let s = Marshal.to_string (o,o) [Marshal.Closures] in
+  let (o1, o2) : (<m:int> * <m:int>) = Marshal.from_string s 0 in
+  let (o3, o4) : (<m:int> * <m:int>) = Marshal.from_string s 0 in
+  (id o, id o1, id o2, id o3, id o4, o#m, o1#m);;
 
 (* Recursion (cf. PR#5291) *)
 
diff --git a/testsuite/tests/typing-objects/Tests.ml.principal.reference b/testsuite/tests/typing-objects/Tests.ml.principal.reference
index 4821b58781..e5d9bb8d59 100644
--- a/testsuite/tests/typing-objects/Tests.ml.principal.reference
+++ b/testsuite/tests/typing-objects/Tests.ml.principal.reference
@@ -217,9 +217,9 @@ class e :
 #     * * * * * * * * * * * * * * * * * * * * *                             module M : sig class c : unit -> object method xc : int end end
 #         class d : unit -> object val x : int method xc : int method xd : int end
 # - : int * int = (1, 2)
-#         Characters 7-156:
+#         Characters 7-154:
   ......virtual ['a] matrix (sz, init : int * 'a) = object
-    val m = Array.create_matrix sz sz init
+    val m = Array.make_matrix sz sz init
     method add (mtx : 'a matrix) = (mtx#m.(0).(0) : 'a)
   end..
 Error: The abbreviation 'a matrix expands to type < add : 'a matrix -> 'a >
@@ -295,12 +295,14 @@ Warning 10: this expression should have type unit.
   unit -> object method private m : int method n : int method o : int end
 #   - : int * int = (1, 1)
 #   class c : unit -> object method m : int end
-#       - : int = 100
-# - : int = 101
-# - : int = 102
-#         - : int * int * int = (103, 104, 105)
-#           - : int * int * int * int * int = (106, 107, 108, 33, 33)
-#           - : int * int * int * int * int = (109, 110, 111, 33, 33)
+#       val r : int ref = {contents = 0}
+# val id : < .. > -> int = <fun>
+# - : unit = ()
+# - : int = 1
+# - : int = 2
+#         - : int * int * int = (3, 4, 5)
+#           - : int * int * int * int * int = (6, 7, 8, 33, 33)
+#           - : int * int * int * int * int * int * int = (9, 10, 10, 11, 11, 33, 33)
 #         Characters 42-69:
   class a = let _ = new b in object end
             ^^^^^^^^^^^^^^^^^^^^^^^^^^^
diff --git a/testsuite/tests/typing-objects/Tests.ml.reference b/testsuite/tests/typing-objects/Tests.ml.reference
index 25ab6d86c6..ed4df922d4 100644
--- a/testsuite/tests/typing-objects/Tests.ml.reference
+++ b/testsuite/tests/typing-objects/Tests.ml.reference
@@ -217,9 +217,9 @@ class e :
 #     * * * * * * * * * * * * * * * * * * * * *                             module M : sig class c : unit -> object method xc : int end end
 #         class d : unit -> object val x : int method xc : int method xd : int end
 # - : int * int = (1, 2)
-#         Characters 7-156:
+#         Characters 7-154:
   ......virtual ['a] matrix (sz, init : int * 'a) = object
-    val m = Array.create_matrix sz sz init
+    val m = Array.make_matrix sz sz init
     method add (mtx : 'a matrix) = (mtx#m.(0).(0) : 'a)
   end..
 Error: The abbreviation 'a matrix expands to type < add : 'a matrix -> 'a >
@@ -294,12 +294,14 @@ Warning 10: this expression should have type unit.
   unit -> object method private m : int method n : int method o : int end
 #   - : int * int = (1, 1)
 #   class c : unit -> object method m : int end
-#       - : int = 100
-# - : int = 101
-# - : int = 102
-#         - : int * int * int = (103, 104, 105)
-#           - : int * int * int * int * int = (106, 107, 108, 33, 33)
-#           - : int * int * int * int * int = (109, 110, 111, 33, 33)
+#       val r : int ref = {contents = 0}
+# val id : < .. > -> int = <fun>
+# - : unit = ()
+# - : int = 1
+# - : int = 2
+#         - : int * int * int = (3, 4, 5)
+#           - : int * int * int * int * int = (6, 7, 8, 33, 33)
+#           - : int * int * int * int * int * int * int = (9, 10, 10, 11, 11, 33, 33)
 #         Characters 42-69:
   class a = let _ = new b in object end
             ^^^^^^^^^^^^^^^^^^^^^^^^^^^
diff --git a/testsuite/tests/typing-private/private.ml.principal.reference b/testsuite/tests/typing-private/private.ml.principal.reference
index 03e7957016..96b1d75955 100644
--- a/testsuite/tests/typing-private/private.ml.principal.reference
+++ b/testsuite/tests/typing-private/private.ml.principal.reference
@@ -107,7 +107,7 @@ Error: Cannot create values of the private type Test2.t
 # *   Characters 148-171:
   module Test2 : module type of Test with type t = private Test.t = Test;;
                                           ^^^^^^^^^^^^^^^^^^^^^^^
-Warning 3: deprecated feature: spurious use of private
+Warning 3: deprecated: spurious use of private
 module Test2 : sig type t = Test.t = private A end
 #     type t = private < x : int; .. >
 # type t = private < x : int; .. >
diff --git a/testsuite/tests/typing-private/private.ml.reference b/testsuite/tests/typing-private/private.ml.reference
index 360940c927..cb1573ed49 100644
--- a/testsuite/tests/typing-private/private.ml.reference
+++ b/testsuite/tests/typing-private/private.ml.reference
@@ -107,7 +107,7 @@ Error: Cannot create values of the private type Test2.t
 # *   Characters 148-171:
   module Test2 : module type of Test with type t = private Test.t = Test;;
                                           ^^^^^^^^^^^^^^^^^^^^^^^
-Warning 3: deprecated feature: spurious use of private
+Warning 3: deprecated: spurious use of private
 module Test2 : sig type t = Test.t = private A end
 #     type t = private < x : int; .. >
 # type t = private < x : int; .. >