Synchronize with trunk.unused_declarations

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

50 files changed, 729 insertions, 264 deletions

diff --git a/testsuite/tests/backtrace/Makefile b/testsuite/tests/backtrace/Makefile
index c4965c22c8..0d368bfc1f 100644
--- a/testsuite/tests/backtrace/Makefile
+++ b/testsuite/tests/backtrace/Makefile
@@ -7,7 +7,7 @@ run-all:
 	  for arg in a b c d ''; do \
 	    printf " ... testing '$$file' (with argument '$$arg'):"; \
 	    OCAMLRUNPARAM=b=1 $(EXECNAME) $$arg > `basename $$file ml`$$arg.result 2>&1; \
-	    diff -q `basename $$file ml`$$arg.reference `basename $$file ml`$$arg.result > /dev/null && echo " => passed" || (echo " => failed" && exit 1); \
+	    $(DIFF) `basename $$file ml`$$arg.reference `basename $$file ml`$$arg.result > /dev/null && echo " => passed" || (echo " => failed" && exit 1); \
 	  done; \
 	done
 
diff --git a/testsuite/tests/basic/arrays.ml b/testsuite/tests/basic/arrays.ml
index bbe8be3279..8dcf116623 100644
--- a/testsuite/tests/basic/arrays.ml
+++ b/testsuite/tests/basic/arrays.ml
@@ -46,7 +46,9 @@ let test2 () =
   if not (testcopy [|1.2;2.3;3.4;4.5|]) then
     print_string "Test2: failed on float array\n";
   if not (testcopy [|"un"; "deux"; "trois"|]) then
-    print_string "Test2: failed on string array\n"
+    print_string "Test2: failed on string array\n";
+  if not (testcopy (bigarray 42)) then
+    print_string "Test2: failed on big array\n"
 
 module AbstractFloat =
   (struct
@@ -79,8 +81,41 @@ let test3 () =
           AbstractFloat.to_float u.(2) = 3.0) then
     print_string "Test3: failed on u\n"
 
+let test4 () =
+  let a = bigarray 0 in
+  let b = Array.sub a 50 10 in
+  if b <> [| 50;51;52;53;54;55;56;57;58;59 |] then
+    print_string "Test4: failed\n"
+
+let test5 () =
+  if Array.append [| 1;2;3 |] [| 4;5 |] <> [| 1;2;3;4;5 |] then
+    print_string "Test5: failed on int arrays\n";
+  if Array.append [| 1.0;2.0;3.0 |] [| 4.0;5.0 |] <> [| 1.0;2.0;3.0;4.0;5.0 |] then
+    print_string "Test5: failed on float arrays\n"
+
+let test6 () =
+  let a = [| 0;1;2;3;4;5;6;7;8;9 |] in
+  let b = Array.concat [a;a;a;a;a;a;a;a;a;a] in
+  if not (Array.length b = 100 && b.(6) = 6 && b.(42) = 2 && b.(99) = 9) then
+    print_string "Test6: failed\n"
+
+let test7 () =
+  let a = Array.make 10 "a" in
+  let b = [| "b1"; "b2"; "b3" |] in
+  Array.blit b 0 a 5 3;
+  if a <> [|"a"; "a"; "a"; "a"; "a"; "b1"; "b2"; "b3"; "a"; "a"|]
+  || b <> [|"b1"; "b2"; "b3"|]
+  then print_string "Test7: failed(1)\n";
+  Array.blit a 5 a 6 4;
+  if a <> [|"a"; "a"; "a"; "a"; "a"; "b1"; "b1"; "b2"; "b3"; "a"|]
+  then print_string "Test7: failed(2)\n"
+
 let _ =
   test1();
   test2();
   test3();
+  test4();
+  test5();
+  test6();
+  test7();
   exit 0
diff --git a/testsuite/tests/callback/Makefile b/testsuite/tests/callback/Makefile
index bc846fe657..06ad39c50c 100644
--- a/testsuite/tests/callback/Makefile
+++ b/testsuite/tests/callback/Makefile
@@ -12,7 +12,7 @@ run-byte: common
 	@$(OCAMLC) -c tcallback.ml
 	@$(OCAMLC) -o ./program -custom unix.cma callbackprim.$(O) tcallback.cmo
 	@./program > bytecode.result
-	@diff -q reference bytecode.result || (echo " => failed" && exit 1) 
+	@$(DIFF) reference bytecode.result || (echo " => failed" && exit 1) 
 	@echo " => passed"
 
 run-opt: common
@@ -20,7 +20,7 @@ run-opt: common
 	@$(OCAMLOPT) -c tcallback.ml
 	@$(OCAMLOPT) -o ./program unix.cmxa callbackprim.$(O) tcallback.cmx
 	@./program > native.result
-	@diff -q reference native.result || (echo " => failed" && exit 1) 
+	@$(DIFF) reference native.result || (echo " => failed" && exit 1) 
 	@echo " => passed"
 	
 promote: defaultpromote
diff --git a/testsuite/tests/embedded/Makefile b/testsuite/tests/embedded/Makefile
index da50369f90..ed33143461 100644
--- a/testsuite/tests/embedded/Makefile
+++ b/testsuite/tests/embedded/Makefile
@@ -11,7 +11,7 @@ compile:
 run:
 	@printf " ... testing 'cmmain':"
 	@./program > program.result
-	@diff -q program.reference program.result > /dev/null || (echo " => failed" && exit 1)
+	@$(DIFF) program.reference program.result > /dev/null || (echo " => failed" && exit 1)
 	@echo " => passed"
 	
 promote: defaultpromote
diff --git a/testsuite/tests/letrec/Makefile b/testsuite/tests/letrec/Makefile
new file mode 100644
index 0000000000..bcc2fdb011
--- /dev/null
+++ b/testsuite/tests/letrec/Makefile
@@ -0,0 +1,4 @@
+BASEDIR=../..
+
+include $(BASEDIR)/makefiles/Makefile.several
+include $(BASEDIR)/makefiles/Makefile.common
diff --git a/testsuite/tests/letrec/backreferences.ml b/testsuite/tests/letrec/backreferences.ml
new file mode 100644
index 0000000000..4a893225b1
--- /dev/null
+++ b/testsuite/tests/letrec/backreferences.ml
@@ -0,0 +1,18 @@
+(* testing backreferences; some compilation scheme may handle
+   differently recursive references to a mutually-recursive RHS
+   depending on whether it is before or after in the bindings list *)
+type t = { x : t; y : t; z : t }
+
+let test =
+  let rec x = { x; y; z }
+      and y = { x; y; z }
+      and z = { x; y; z }
+  in
+  List.iter (fun (f, t_ref) ->
+    List.iter (fun t -> assert (f t == t_ref)) [x; y; z]
+  )
+    [
+      (fun t -> t.x), x;
+      (fun t -> t.y), y;
+      (fun t -> t.z), z;
+    ]
diff --git a/testsuite/tests/letrec/class_1.ml b/testsuite/tests/letrec/class_1.ml
new file mode 100644
index 0000000000..a7d0338802
--- /dev/null
+++ b/testsuite/tests/letrec/class_1.ml
@@ -0,0 +1,5 @@
+(* class expression are compiled to recursive bindings *)
+class test =
+object
+  method x = 1
+end
diff --git a/testsuite/tests/letrec/class_2.ml b/testsuite/tests/letrec/class_2.ml
new file mode 100644
index 0000000000..71c7880d67
--- /dev/null
+++ b/testsuite/tests/letrec/class_2.ml
@@ -0,0 +1,8 @@
+(* class expressions may also contain local recursive bindings *)
+class test =
+  let rec f = print_endline "f"; fun x -> g x
+      and g = print_endline "g"; fun x -> f x in
+object
+  method f : 'a 'b. 'a -> 'b = f
+  method g : 'a 'b. 'a -> 'b = g
+end
diff --git a/testsuite/tests/letrec/class_2.reference b/testsuite/tests/letrec/class_2.reference
new file mode 100644
index 0000000000..ab713757f4
--- /dev/null
+++ b/testsuite/tests/letrec/class_2.reference
@@ -0,0 +1,2 @@
+f
+g
diff --git a/testsuite/tests/letrec/evaluation_order_1.ml b/testsuite/tests/letrec/evaluation_order_1.ml
new file mode 100644
index 0000000000..5b88844d7e
--- /dev/null
+++ b/testsuite/tests/letrec/evaluation_order_1.ml
@@ -0,0 +1,20 @@
+(* test evaluation order
+
+   'y' is translated into a constant, and is therefore considered
+   non-recursive. With the current letrec compilation method,
+   it should be evaluated before x and z.
+*)
+type tree = Tree of tree list
+
+let test =
+  let rec x = (print_endline "x"; Tree [y; z])
+  and y = (print_endline "y"; Tree [])
+  and z = (print_endline "z"; Tree [x])
+  in
+  match (x, y, z) with
+    | (Tree [y1; z1], Tree[], Tree[x1]) ->
+      assert (y1 == y);
+      assert (z1 == z);
+      assert (x1 == x)
+    | _ ->
+      assert false
diff --git a/testsuite/tests/letrec/evaluation_order_1.reference b/testsuite/tests/letrec/evaluation_order_1.reference
new file mode 100644
index 0000000000..f471662b7d
--- /dev/null
+++ b/testsuite/tests/letrec/evaluation_order_1.reference
@@ -0,0 +1,3 @@
+y
+x
+z
diff --git a/testsuite/tests/letrec/evaluation_order_2.ml b/testsuite/tests/letrec/evaluation_order_2.ml
new file mode 100644
index 0000000000..736f82ad32
--- /dev/null
+++ b/testsuite/tests/letrec/evaluation_order_2.ml
@@ -0,0 +1,18 @@
+(* A variant of evaluation_order_1.ml where the side-effects
+   are inside the blocks. Note that this changes the evaluation
+   order, as y is considered recursive.
+*)
+type tree = Tree of tree list
+
+let test =
+  let rec x = (Tree [(print_endline "x"; y); z])
+  and y = Tree (print_endline "y"; [])
+  and z = Tree (print_endline "z"; [x])
+  in
+  match (x, y, z) with
+    | (Tree [y1; z1], Tree[], Tree[x1]) ->
+      assert (y1 == y);
+      assert (z1 == z);
+      assert (x1 == x)
+    | _ ->
+      assert false
diff --git a/testsuite/tests/letrec/evaluation_order_2.reference b/testsuite/tests/letrec/evaluation_order_2.reference
new file mode 100644
index 0000000000..04ec35a6dc
--- /dev/null
+++ b/testsuite/tests/letrec/evaluation_order_2.reference
@@ -0,0 +1,3 @@
+x
+y
+z
diff --git a/testsuite/tests/letrec/evaluation_order_3.ml b/testsuite/tests/letrec/evaluation_order_3.ml
new file mode 100644
index 0000000000..8f76a8f858
--- /dev/null
+++ b/testsuite/tests/letrec/evaluation_order_3.ml
@@ -0,0 +1,11 @@
+type t = { x : t; y : t }
+
+let p = print_endline
+
+let test =
+  let rec x = p "x"; { x = (p "x_x"; x); y = (p "x_y"; y) }
+      and y = p "y"; { x = (p "y_x"; x); y = (p "y_y"; y) }
+   in
+   assert (x.x == x); assert (x.y == y);
+   assert (y.x == x); assert (y.y == y);
+   ()
diff --git a/testsuite/tests/letrec/evaluation_order_3.reference b/testsuite/tests/letrec/evaluation_order_3.reference
new file mode 100644
index 0000000000..5b8c549eca
--- /dev/null
+++ b/testsuite/tests/letrec/evaluation_order_3.reference
@@ -0,0 +1,6 @@
+x
+x_y
+x_x
+y
+y_y
+y_x
diff --git a/testsuite/tests/letrec/float_block_1.ml b/testsuite/tests/letrec/float_block_1.ml
new file mode 100644
index 0000000000..cdfa9d2f85
--- /dev/null
+++ b/testsuite/tests/letrec/float_block_1.ml
@@ -0,0 +1,10 @@
+(* a bug in cmmgen.ml provokes a change in compilation order between
+   ocamlc and ocamlopt in certain letrec-bindings involving float
+   arrays *)
+let test =
+  let rec x = print_endline "x"; [| 1; 2; 3 |]
+      and y = print_endline "y"; [| 1.; 2.; 3. |]
+  in
+  assert (x = [| 1; 2; 3 |]);
+  assert (y = [| 1.; 2.; 3. |]);
+  ()
diff --git a/testsuite/tests/letrec/float_block_1.reference b/testsuite/tests/letrec/float_block_1.reference
new file mode 100644
index 0000000000..b77b4eb1d9
--- /dev/null
+++ b/testsuite/tests/letrec/float_block_1.reference
@@ -0,0 +1,2 @@
+x
+y
diff --git a/testsuite/tests/letrec/float_block_2.ml b/testsuite/tests/letrec/float_block_2.ml
new file mode 100644
index 0000000000..968cba4eb1
--- /dev/null
+++ b/testsuite/tests/letrec/float_block_2.ml
@@ -0,0 +1,7 @@
+(* a bug in cmmgen.ml provokes a segfault in certain natively compiled
+   letrec-bindings involving float arrays *)
+let test =
+  let rec x = [| y; y |] and y = 1. in
+  assert (x = [| 1.; 1. |]);
+  assert (y = 1.);
+  ()
diff --git a/testsuite/tests/letrec/lists.ml b/testsuite/tests/letrec/lists.ml
new file mode 100644
index 0000000000..5686e49357
--- /dev/null
+++ b/testsuite/tests/letrec/lists.ml
@@ -0,0 +1,8 @@
+(* a test with lists, because cyclic lists are fun *)
+let test =
+  let rec li = 0::1::2::3::4::5::6::7::8::9::li in
+  match li with
+    | 0::1::2::3::4::5::6::7::8::9::
+        0::1::2::3::4::5::6::7::8::9::li' ->
+      assert (li == li')
+    | _ -> assert false
diff --git a/testsuite/tests/letrec/mixing_value_closures_1.ml b/testsuite/tests/letrec/mixing_value_closures_1.ml
new file mode 100644
index 0000000000..e79f79ecbe
--- /dev/null
+++ b/testsuite/tests/letrec/mixing_value_closures_1.ml
@@ -0,0 +1,8 @@
+(* mixing values and closures may exercise interesting code paths *)
+type t = A of (int -> int)
+let test =
+  let rec x = A f
+  and f = function
+    | 0 -> 2
+    | n -> match x with A g -> g 0
+  in assert (f 1 = 2)
diff --git a/testsuite/tests/letrec/mixing_value_closures_2.ml b/testsuite/tests/letrec/mixing_value_closures_2.ml
new file mode 100644
index 0000000000..eb5fcb7420
--- /dev/null
+++ b/testsuite/tests/letrec/mixing_value_closures_2.ml
@@ -0,0 +1,8 @@
+(* a polymorphic variant of test3.ml; found a real bug once *)
+let test =
+  let rec x = `A f
+  and f = function
+    | 0 -> 2
+    | n -> match x with `A g -> g 0
+  in
+  assert (f 1 = 2)
diff --git a/testsuite/tests/letrec/mutual_functions.ml b/testsuite/tests/letrec/mutual_functions.ml
new file mode 100644
index 0000000000..a5b6c51ffe
--- /dev/null
+++ b/testsuite/tests/letrec/mutual_functions.ml
@@ -0,0 +1,11 @@
+(* a simple test with mutually recursive functions *)
+let test =
+  let rec even = function
+    | 0 -> true
+    | n -> odd (n - 1)
+  and odd = function
+    | 0 -> false
+    | n -> even (n - 1)
+  in
+  List.iter (fun i -> assert (even i <> odd i && even i = (i mod 2 = 0)))
+    [0;1;2;3;4;5;6]
diff --git a/testsuite/tests/lib-dynlink-bytecode/Makefile b/testsuite/tests/lib-dynlink-bytecode/Makefile
index ea07959afb..a510325bce 100644
--- a/testsuite/tests/lib-dynlink-bytecode/Makefile
+++ b/testsuite/tests/lib-dynlink-bytecode/Makefile
@@ -19,17 +19,17 @@ compile:
 run:
 	@printf " ... testing 'main'"
 	@export LD_LIBRARY_PATH=`pwd` && ./main plug1.cma plug2.cma > main.result
-	@diff -q main.reference main.result > /dev/null || (echo " => failed" && exit 1)
+	@$(DIFF) main.reference main.result > /dev/null || (echo " => failed" && exit 1)
 	@echo " => passed"
 
 	@printf " ... testing 'static'"
 	@export LD_LIBRARY_PATH=`pwd` && ./static > static.result
-	@diff -q static.reference static.result > /dev/null || (echo " => failed" && exit 1)
+	@$(DIFF) static.reference static.result > /dev/null || (echo " => failed" && exit 1)
 	@echo " => passed"
 
 	@printf " ... testing 'custom'"
 	@export LD_LIBRARY_PATH=`pwd` && ./custom > custom.result
-	@diff -q custom.reference custom.result > /dev/null || (echo " => failed" && exit 1)
+	@$(DIFF) custom.reference custom.result > /dev/null || (echo " => failed" && exit 1)
 	@echo " => passed"
 	
 promote: defaultpromote
diff --git a/testsuite/tests/lib-dynlink-csharp/Makefile b/testsuite/tests/lib-dynlink-csharp/Makefile
index 377b7d8474..06f58b72da 100644
--- a/testsuite/tests/lib-dynlink-csharp/Makefile
+++ b/testsuite/tests/lib-dynlink-csharp/Makefile
@@ -15,7 +15,7 @@ bytecode:
 	  $(OCAMLC) -output-obj -o main.dll dynlink.cma main.ml entry.c; \
 	  $(CSC) /out:main.exe main.cs; \
 	  ./main.exe > bytecode.result; \
-	  diff -q bytecode.reference bytecode.result > /dev/null && echo " => passed" || echo " => failed"; \
+	  $(DIFF) bytecode.reference bytecode.result > /dev/null && echo " => passed" || echo " => failed"; \
 	fi
 
 bytecode-dll:
@@ -27,7 +27,7 @@ bytecode-dll:
 	  $(MKDLL) -maindll -o main.dll main_obj.$(O) entry.$(O) ../../byterun/libcamlrun.$(A)  $(BYTECCLIBS) -v; \
 	  $(CSC) /out:main.exe main.cs; \
 	  ./main.exe > bytecode.result; \
-	  diff -q bytecode.reference bytecode.result > /dev/null && echo " => passed" || echo " => failed"; \
+	  $(DIFF) bytecode.reference bytecode.result > /dev/null && echo " => passed" || echo " => failed"; \
 	fi
 
 native:
@@ -38,7 +38,7 @@ native:
 	  $(OCAMLOPT) -output-obj -o main.dll dynlink.cmxa entry.c main.ml; \
 	  $(CSC) /out:main.exe main.cs; \
 	  ./main.exe > native.result; \
-	  diff -q native.reference native.result > /dev/null && echo " => passed" || echo " => failed"; \
+	  $(DIFF) native.reference native.result > /dev/null && echo " => passed" || echo " => failed"; \
 	fi
 
 native-dll:
@@ -50,7 +50,7 @@ native-dll:
 	  $(MKDLL) -maindll -o main.dll main_obj.$(O) entry.$(O) ../../asmrun/libasmrun.lib -v; \
 	  $(CSC) /out:main.exe main.cs; \
 	  ./main.exe > native.result; \
-	  diff -q native.reference native.result > /dev/null && echo " => passed" || echo " => failed"; \
+	  $(DIFF) native.reference native.result > /dev/null && echo " => passed" || echo " => failed"; \
 	fi
 
 promote: defaultpromote
diff --git a/testsuite/tests/lib-dynlink-native/Makefile b/testsuite/tests/lib-dynlink-native/Makefile
index d090d80137..d7ac244671 100644
--- a/testsuite/tests/lib-dynlink-native/Makefile
+++ b/testsuite/tests/lib-dynlink-native/Makefile
@@ -12,7 +12,7 @@ compile: $(PLUGINS) main mylib.so
 run:
 	@printf " ... testing 'main'"
 	@./main plugin_thread.so > result
-	@diff -q reference result > /dev/null || (echo " => failed" && exit 1)
+	@$(DIFF) reference result > /dev/null || (echo " => failed" && exit 1)
 	@echo " => passed"
 
 main: api.cmx main.cmx
diff --git a/testsuite/tests/lib-scanf-2/Makefile b/testsuite/tests/lib-scanf-2/Makefile
index ecb87cba20..bf7cf08af7 100644
--- a/testsuite/tests/lib-scanf-2/Makefile
+++ b/testsuite/tests/lib-scanf-2/Makefile
@@ -11,10 +11,10 @@ compile: tscanf2_io.cmo tscanf2_io.cmx
 run:
 	@printf " ... testing with ocamlc"
 	@./master.byte ./slave.byte > result.byte 2>&1
-	@diff -q reference result.byte > /dev/null || (echo " => failed" && exit 1)
+	@$(DIFF) reference result.byte > /dev/null || (echo " => failed" && exit 1)
 	@printf " ocamlopt"
 	@./master.native ./slave.native > result.native 2>&1
-	@diff -q reference result.native > /dev/null || (echo " => failed" && exit 1)
+	@$(DIFF) reference result.native > /dev/null || (echo " => failed" && exit 1)
 	@echo " => passed"
 
 promote:
diff --git a/testsuite/tests/lib-set/Makefile b/testsuite/tests/lib-set/Makefile
new file mode 100644
index 0000000000..4ba0bffc51
--- /dev/null
+++ b/testsuite/tests/lib-set/Makefile
@@ -0,0 +1,3 @@
+BASEDIR=../..
+include $(BASEDIR)/makefiles/Makefile.several
+include $(BASEDIR)/makefiles/Makefile.common
diff --git a/testsuite/tests/lib-set/testmap.ml b/testsuite/tests/lib-set/testmap.ml
new file mode 100644
index 0000000000..1197fbf6d0
--- /dev/null
+++ b/testsuite/tests/lib-set/testmap.ml
@@ -0,0 +1,123 @@
+module M = Map.Make(struct type t = int let compare = compare end)
+
+let img x m = try Some(M.find x m) with Not_found -> None
+
+let testvals = [0;1;2;3;4;5;6;7;8;9]
+
+let check msg cond =
+  if not (List.for_all cond testvals) then
+    Printf.printf "Test %s FAILED\n%!" msg
+
+let checkbool msg b =
+  if not b then
+    Printf.printf "Test %s FAILED\n%!" msg
+
+let uncurry (f: 'a -> 'b -> 'c) (x, y: 'a * 'b) : 'c = f x y
+
+let test x v s1 s2 =
+
+  checkbool "is_empty"
+    (M.is_empty s1 = List.for_all (fun i -> img i s1 = None) testvals);
+
+  check "mem"
+    (fun i -> M.mem i s1 = (img i s1 <> None));
+
+  check "add"
+    (let s = M.add x v s1 in
+     fun i -> img i s = (if i = x then Some v else img i s1));
+
+  check "singleton"
+    (let s = M.singleton x v in
+     fun i -> img i s = (if i = x then Some v else None));
+
+  check "remove"
+    (let s = M.remove x s1 in
+     fun i -> img i s = (if i = x then None else img i s1));
+
+  check "merge-union"
+    (let f _ o1 o2 =
+       match o1, o2 with
+       | Some v1, Some v2 -> Some (v1 +. v2)
+       | None, _ -> o2
+       | _, None -> o1 in
+     let s = M.merge f s1 s2 in
+     fun i -> img i s = f i (img i s1) (img i s2));
+
+  check "merge-inter"
+    (let f _ o1 o2 =
+       match o1, o2 with
+       | Some v1, Some v2 -> Some (v1 -. v2)
+       | _, _ -> None in
+     let s = M.merge f s1 s2 in
+     fun i -> img i s = f i (img i s1) (img i s2));
+
+  checkbool "bindings"
+    (let rec extract = function
+       | [] -> []
+       | hd :: tl ->
+           match img hd s1 with
+           | None -> extract tl
+           | Some v ->(hd,  v) :: extract tl in
+     M.bindings s1 = extract testvals);
+
+  checkbool "for_all"
+    (let p x y = x mod 2 = 0 in
+     M.for_all p s1 = List.for_all (uncurry p) (M.bindings s1));
+
+  checkbool "exists"
+    (let p x y = x mod 3 = 0 in
+     M.exists p s1 = List.exists (uncurry p) (M.bindings s1));
+
+  checkbool "filter"
+    (let p x y = x >= 3 && x <= 6 in
+     M.bindings(M.filter p s1) = List.filter (uncurry p) (M.bindings s1));
+
+  checkbool "partition"
+    (let p x y = x >= 3 && x <= 6 in
+     let (st,sf) = M.partition p s1
+     and (lt,lf) = List.partition (uncurry p) (M.bindings s1) in
+     M.bindings st = lt && M.bindings sf = lf);
+
+  checkbool "cardinal"
+    (M.cardinal s1 = List.length (M.bindings s1));
+
+  checkbool "min_binding"
+    (try
+       let (k,v) = M.min_binding s1 in
+       img k s1 = Some v && M.for_all (fun i _ -> k <= i) s1
+     with Not_found ->
+       M.is_empty s1);
+
+  checkbool "max_binding"
+    (try
+       let (k,v) = M.max_binding s1 in
+       img k s1 = Some v && M.for_all (fun i _ -> k >= i) s1
+     with Not_found ->
+       M.is_empty s1);
+
+  checkbool "choose"
+    (try
+       let (x,v) = M.choose s1 in img x s1 = Some v
+     with Not_found ->
+       M.is_empty s1);
+
+  check "split"
+    (let (l, p, r) = M.split x s1 in
+     fun i -> 
+       if i < x then img i l = img i s1
+       else if i > x then img i r = img i s1
+       else p = img i s1)
+
+let rkey() = Random.int 10
+
+let rdata() = Random.float 1.0
+
+let rmap() =
+  let s = ref M.empty in
+  for i = 1 to Random.int 10 do s := M.add (rkey()) (rdata()) !s done;
+  !s
+
+let _ =
+  Random.init 42;
+  for i = 1 to 25000 do test (rkey()) (rdata()) (rmap()) (rmap()) done
+  
diff --git a/testsuite/tests/lib-set/testmap.reference b/testsuite/tests/lib-set/testmap.reference
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testsuite/tests/lib-set/testmap.reference
diff --git a/testsuite/tests/lib-set/testset.ml b/testsuite/tests/lib-set/testset.ml
new file mode 100644
index 0000000000..c4ab0441e0
--- /dev/null
+++ b/testsuite/tests/lib-set/testset.ml
@@ -0,0 +1,120 @@
+module S = Set.Make(struct type t = int let compare = compare end)
+
+let testvals = [0;1;2;3;4;5;6;7;8;9]
+
+let check msg cond =
+  if not (List.for_all cond testvals) then
+    Printf.printf "Test %s FAILED\n%!" msg
+
+let checkbool msg b =
+  if not b then
+    Printf.printf "Test %s FAILED\n%!" msg
+
+let normalize_cmp c =
+  if c = 0 then 0 else if c > 0 then 1 else -1
+
+let test x s1 s2 =
+
+  checkbool "is_empty"
+    (S.is_empty s1 = List.for_all (fun i -> not (S.mem i s1)) testvals);
+
+  check "add"
+    (let s = S.add x s1 in
+     fun i -> S.mem i s = (S.mem i s1 || i = x));
+
+  check "singleton"
+    (let s = S.singleton x in
+     fun i -> S.mem i s = (i = x));
+
+  check "remove"
+    (let s = S.remove x s1 in
+     fun i -> S.mem i s = (S.mem i s1 && i <> x));
+
+  check "union"
+    (let s = S.union s1 s2 in
+     fun i -> S.mem i s = (S.mem i s1 || S.mem i s2));
+
+  check "inter"
+    (let s = S.inter s1 s2 in
+     fun i -> S.mem i s = (S.mem i s1 && S.mem i s2));
+
+  check "diff"
+    (let s = S.diff s1 s2 in
+     fun i -> S.mem i s = (S.mem i s1 && not (S.mem i s2)));
+
+  checkbool "elements"
+    (S.elements s1 = List.filter (fun i -> S.mem i s1) testvals);
+
+  checkbool "compare"
+    (normalize_cmp (S.compare s1 s2) = normalize_cmp (compare (S.elements s1) (S.elements s2)));
+
+  checkbool "equal"
+    (S.equal s1 s2 = (S.elements s1 = S.elements s2));
+
+  check "subset"
+    (let b = S.subset s1 s2 in
+     fun i -> if b && S.mem i s1 then S.mem i s2 else true);
+
+  checkbool "subset2"
+    (let b = S.subset s1 s2 in
+     b || not (S.is_empty (S.diff s1 s2)));
+
+  checkbool "for_all"
+    (let p x = x mod 2 = 0 in
+     S.for_all p s1 = List.for_all p (S.elements s1));
+
+  checkbool "exists"
+    (let p x = x mod 3 = 0 in
+     S.exists p s1 = List.exists p (S.elements s1));
+
+  checkbool "filter"
+    (let p x = x >= 3 && x <= 6 in
+     S.elements(S.filter p s1) = List.filter p (S.elements s1));
+
+  checkbool "partition"
+    (let p x = x >= 3 && x <= 6 in
+     let (st,sf) = S.partition p s1
+     and (lt,lf) = List.partition p (S.elements s1) in
+     S.elements st = lt && S.elements sf = lf);
+
+  checkbool "cardinal"
+    (S.cardinal s1 = List.length (S.elements s1));
+
+  checkbool "min_elt"
+    (try
+       let m = S.min_elt s1 in
+       S.mem m s1 && S.for_all (fun i -> m <= i) s1
+     with Not_found ->
+       S.is_empty s1);
+
+  checkbool "max_elt"
+    (try
+       let m = S.max_elt s1 in
+       S.mem m s1 && S.for_all (fun i -> m >= i) s1
+     with Not_found ->
+       S.is_empty s1);
+
+  checkbool "choose"
+    (try
+       let x = S.choose s1 in S.mem x s1
+     with Not_found ->
+       S.is_empty s1);
+
+  check "split"
+    (let (l, p, r) = S.split x s1 in
+     fun i -> 
+       if i < x then S.mem i l = S.mem i s1
+       else if i > x then S.mem i r = S.mem i s1
+       else p = S.mem i s1)
+
+let relt() = Random.int 10
+
+let rset() =
+  let s = ref S.empty in
+  for i = 1 to Random.int 10 do s := S.add (relt()) !s done;
+  !s
+
+let _ =
+  Random.init 42;
+  for i = 1 to 25000 do test (relt()) (rset()) (rset()) done
+  
diff --git a/testsuite/tests/lib-set/testset.reference b/testsuite/tests/lib-set/testset.reference
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testsuite/tests/lib-set/testset.reference
diff --git a/testsuite/tests/runtime-errors/Makefile b/testsuite/tests/runtime-errors/Makefile
index 63f63c9e72..1e2feb9193 100644
--- a/testsuite/tests/runtime-errors/Makefile
+++ b/testsuite/tests/runtime-errors/Makefile
@@ -16,10 +16,10 @@ run:
          for f in *.bytecode; do \
 	  printf " ... testing '$$f':"; \
 	  (./$$f > $$f.result 2>&1; true); \
-	  diff -q $$f.reference $$f.result > /dev/null || (echo " => failed" && exit 1) && echo " => passed"; \
+	  $(DIFF) $$f.reference $$f.result > /dev/null || (echo " => failed" && exit 1) && echo " => passed"; \
 	  printf " ... testing '`basename $$f bytecode`native':"; \
 	  (./`basename $$f bytecode`native > `basename $$f bytecode`native.result 2>&1; true); \
-	  diff -q `basename $$f bytecode`native.reference `basename $$f bytecode`native.result > /dev/null || (echo " => failed" && exit 1) && echo " => passed"; \
+	  $(DIFF) `basename $$f bytecode`native.reference `basename $$f bytecode`native.result > /dev/null || (echo " => failed" && exit 1) && echo " => passed"; \
 	done
 	
 promote: defaultpromote
diff --git a/testsuite/tests/tool-ocamldoc/Makefile b/testsuite/tests/tool-ocamldoc/Makefile
index 6a6b5f8907..d112f568cd 100644
--- a/testsuite/tests/tool-ocamldoc/Makefile
+++ b/testsuite/tests/tool-ocamldoc/Makefile
@@ -6,7 +6,7 @@ run: $(CUSTOM_MODULE).cmo
 	@for file in t*.ml; do \
 	  printf " ... testing '$$file'"; \
 	  $(OCAMLDOC) -hide-warnings -g $(CUSTOM_MODULE).cmo -o `basename $$file ml`result $$file; \
-	  diff -q `basename $$file ml`reference `basename $$file ml`result > /dev/null && echo " => passed" || (echo " => failed" && exit 1); \
+	  $(DIFF) `basename $$file ml`reference `basename $$file ml`result > /dev/null && echo " => passed" || (echo " => failed" && exit 1); \
 	done;
 	@$(OCAMLDOC) -hide-warnings -html t*.ml 2>&1 | grep -v test_types_display || true
 	@$(OCAMLDOC) -hide-warnings -latex t*.ml 2>&1 | grep -v test_types_display || true
diff --git a/testsuite/tests/typing-gadts/dynamic_frisch.ml.principal.reference b/testsuite/tests/typing-gadts/dynamic_frisch.ml.principal.reference
index 39102239a9..72a301c4aa 100644
--- a/testsuite/tests/typing-gadts/dynamic_frisch.ml.principal.reference
+++ b/testsuite/tests/typing-gadts/dynamic_frisch.ml.principal.reference
@@ -9,9 +9,9 @@
   | VString of string
   | VList of variant list
   | VPair of variant * variant
-val variantize : 'a ty -> 'a -> variant = <fun>
+val variantize : 't ty -> 't -> variant = <fun>
 exception VariantMismatch
-val devariantize : 'a ty -> variant -> 'a = <fun>
+val devariantize : 't ty -> variant -> 't = <fun>
 #                                                   type 'a ty =
     Int : int ty
   | String : string ty
@@ -27,7 +27,7 @@ and ('a, 'b) field = { label : string; field_type : 'b ty; get : 'a -> 'b; }
   | VList of variant list
   | VPair of variant * variant
   | VRecord of (string * variant) list
-val variantize : 'a ty -> 'a -> variant = <fun>
+val variantize : 't ty -> 't -> variant = <fun>
 #                                                                                                   type 'a ty =
     Int : int ty
   | String : string ty
@@ -48,7 +48,7 @@ and ('a, 'builder, 'b) field_ = {
   get : 'a -> 'b;
   set : 'builder -> 'b -> unit;
 }
-val devariantize : 'a ty -> variant -> 'a = <fun>
+val devariantize : 't ty -> variant -> 't = <fun>
 #                                                   type my_record = { a : int; b : string list; }
 val my_record : my_record ty =
   Record
@@ -58,7 +58,7 @@ val my_record : my_record ty =
       Field {label = "b"; field_type = List String; get = <fun>; set = <fun>}];
     create_builder = <fun>; of_builder = <fun>}
 #                                                                         type noarg = Noarg
-type ('a, 'b) ty =
+type (_, _) ty =
     Int : (int, 'c) ty
   | String : (string, 'd) ty
   | List : ('a, 'e) ty -> ('a list, 'e) ty
@@ -75,20 +75,20 @@ and ('a, 'e, 'b) ty_sum = {
   sum_inj : 'c. ('b, 'c) ty_sel * 'c -> 'a;
 }
 and 'e ty_dyn = Tdyn : ('a, 'e) ty * 'a -> 'e ty_dyn
-and ('a, 'b) ty_sel =
+and (_, _) ty_sel =
     Thd : ('a -> 'b, 'a) ty_sel
   | Ttl : ('b -> 'c, 'd) ty_sel -> ('a -> 'b -> 'c, 'd) ty_sel
-and ('a, 'b) ty_case =
+and (_, _) ty_case =
     TCarg : ('b, 'a) ty_sel * ('a, 'e) ty -> ('e, 'b) ty_case
   | TCnoarg : ('b, noarg) ty_sel -> ('e, 'b) ty_case
-#         type 'a ty_env =
+#         type _ ty_env =
     Enil : unit ty_env
   | Econs : ('a, 'e) ty * 'e ty_env -> ('a -> 'e) ty_env
-#                                                         type ('a, 'b) eq = Eq : ('a, 'a) eq
+#                                                         type (_, _) eq = Eq : ('a, 'a) eq
 val eq_sel : ('a, 'b) ty_sel -> ('a, 'c) ty_sel -> ('b, 'c) eq option = <fun>
 val get_case :
-  ('a, 'b) ty_sel ->
-  (string * ('c, 'a) ty_case) list -> string * ('b, 'c) ty option = <fun>
+  ('b, 'a) ty_sel ->
+  (string * ('e, 'b) ty_case) list -> string * ('a, 'e) ty option = <fun>
 #                                                         type variant =
     VInt of int
   | VString of string
@@ -98,8 +98,8 @@ val get_case :
   | VConv of string * variant
   | VSum of string * variant option
 val may_map : ('a -> 'b) -> 'a option -> 'b option = <fun>
-val variantize : 'a ty_env -> ('b, 'a) ty -> 'b -> variant = <fun>
-#                                               val devariantize : 'a ty_env -> ('b, 'a) ty -> variant -> 'b = <fun>
+val variantize : 'e ty_env -> ('a, 'e) ty -> 'a -> variant = <fun>
+#                                               val devariantize : 'e ty_env -> ('t, 'e) ty -> variant -> 't = <fun>
 #     val wrap_A : ('a, 'b) ty -> ([ `A of 'a ], 'b) ty = <fun>
 #   val ty : ('a, ([ `A of ('a * 'b) option ] as 'b) -> 'c) ty -> ('b, 'c) ty =
   <fun>
@@ -124,12 +124,12 @@ val v : variant =
     sum_inj = <fun>}
 #                                             val a : [ `A of int | `B of string | `C ] = `A 3
 type 'a vlist = [ `Cons of 'a * 'a vlist | `Nil ]
-val ty_list : ('a, 'b) ty -> ('a vlist, 'b) ty = <fun>
+val ty_list : ('a, 'e) ty -> ('a vlist, 'e) ty = <fun>
 val v : variant =
   VSum ("Cons",
    Some
     (VPair (VInt 1, VSum ("Cons", Some (VPair (VInt 2, VSum ("Nil", None)))))))
-#                                                               type ('a, 'b) ty =
+#                                                               type (_, _) ty =
     Int : (int, 'c) ty
   | String : (string, 'd) ty
   | List : ('a, 'e) ty -> ('a list, 'e) ty
@@ -149,7 +149,7 @@ val ty_abc : ([ `A of int | `B of string | `C ], 'e) ty = Sum (<fun>, <fun>)
 Error: This pattern matches values of type a * a vlist
        but a pattern was expected which matches values of type
          ex#46 = ex#47 * ex#48
-#                                                         type ('a, 'b) ty =
+#                                                         type (_, _) ty =
     Int : (int, 'd) ty
   | String : (string, 'f) ty
   | List : ('a, 'e) ty -> ('a list, 'e) ty
@@ -164,13 +164,13 @@ Error: This pattern matches values of type a * a vlist
         inj : 'c. ('b, 'c) ty_sel * 'c -> 'a;
         proj : 'a -> string * 'e ty_dyn option > -> ('a, 'e) ty
 and 'e ty_dyn = Tdyn : ('a, 'e) ty * 'a -> 'e ty_dyn
-and ('a, 'b) ty_sel =
+and (_, _) ty_sel =
     Thd : ('a -> 'b, 'a) ty_sel
   | Ttl : ('b -> 'c, 'd) ty_sel -> ('a -> 'b -> 'c, 'd) ty_sel
-and ('a, 'b) ty_case =
+and (_, _) ty_case =
     TCarg : ('b, 'a) ty_sel * ('a, 'e) ty -> ('e, 'b) ty_case
   | TCnoarg : ('b, noarg) ty_sel -> ('e, 'b) ty_case
 #                                                                     val ty_abc : ([ `A of int | `B of string | `C ], 'e) ty = Sum <obj>
 type 'a vlist = [ `Cons of 'a * 'a vlist | `Nil ]
-val ty_list : ('a, 'b) ty -> ('a vlist, 'b) ty = <fun>
+val ty_list : ('a, 'e) ty -> ('a vlist, 'e) ty = <fun>
 #   * * * * * * * * *   
diff --git a/testsuite/tests/typing-gadts/dynamic_frisch.ml.reference b/testsuite/tests/typing-gadts/dynamic_frisch.ml.reference
index 39102239a9..72a301c4aa 100644
--- a/testsuite/tests/typing-gadts/dynamic_frisch.ml.reference
+++ b/testsuite/tests/typing-gadts/dynamic_frisch.ml.reference
@@ -9,9 +9,9 @@
   | VString of string
   | VList of variant list
   | VPair of variant * variant
-val variantize : 'a ty -> 'a -> variant = <fun>
+val variantize : 't ty -> 't -> variant = <fun>
 exception VariantMismatch
-val devariantize : 'a ty -> variant -> 'a = <fun>
+val devariantize : 't ty -> variant -> 't = <fun>
 #                                                   type 'a ty =
     Int : int ty
   | String : string ty
@@ -27,7 +27,7 @@ and ('a, 'b) field = { label : string; field_type : 'b ty; get : 'a -> 'b; }
   | VList of variant list
   | VPair of variant * variant
   | VRecord of (string * variant) list
-val variantize : 'a ty -> 'a -> variant = <fun>
+val variantize : 't ty -> 't -> variant = <fun>
 #                                                                                                   type 'a ty =
     Int : int ty
   | String : string ty
@@ -48,7 +48,7 @@ and ('a, 'builder, 'b) field_ = {
   get : 'a -> 'b;
   set : 'builder -> 'b -> unit;
 }
-val devariantize : 'a ty -> variant -> 'a = <fun>
+val devariantize : 't ty -> variant -> 't = <fun>
 #                                                   type my_record = { a : int; b : string list; }
 val my_record : my_record ty =
   Record
@@ -58,7 +58,7 @@ val my_record : my_record ty =
       Field {label = "b"; field_type = List String; get = <fun>; set = <fun>}];
     create_builder = <fun>; of_builder = <fun>}
 #                                                                         type noarg = Noarg
-type ('a, 'b) ty =
+type (_, _) ty =
     Int : (int, 'c) ty
   | String : (string, 'd) ty
   | List : ('a, 'e) ty -> ('a list, 'e) ty
@@ -75,20 +75,20 @@ and ('a, 'e, 'b) ty_sum = {
   sum_inj : 'c. ('b, 'c) ty_sel * 'c -> 'a;
 }
 and 'e ty_dyn = Tdyn : ('a, 'e) ty * 'a -> 'e ty_dyn
-and ('a, 'b) ty_sel =
+and (_, _) ty_sel =
     Thd : ('a -> 'b, 'a) ty_sel
   | Ttl : ('b -> 'c, 'd) ty_sel -> ('a -> 'b -> 'c, 'd) ty_sel
-and ('a, 'b) ty_case =
+and (_, _) ty_case =
     TCarg : ('b, 'a) ty_sel * ('a, 'e) ty -> ('e, 'b) ty_case
   | TCnoarg : ('b, noarg) ty_sel -> ('e, 'b) ty_case
-#         type 'a ty_env =
+#         type _ ty_env =
     Enil : unit ty_env
   | Econs : ('a, 'e) ty * 'e ty_env -> ('a -> 'e) ty_env
-#                                                         type ('a, 'b) eq = Eq : ('a, 'a) eq
+#                                                         type (_, _) eq = Eq : ('a, 'a) eq
 val eq_sel : ('a, 'b) ty_sel -> ('a, 'c) ty_sel -> ('b, 'c) eq option = <fun>
 val get_case :
-  ('a, 'b) ty_sel ->
-  (string * ('c, 'a) ty_case) list -> string * ('b, 'c) ty option = <fun>
+  ('b, 'a) ty_sel ->
+  (string * ('e, 'b) ty_case) list -> string * ('a, 'e) ty option = <fun>
 #                                                         type variant =
     VInt of int
   | VString of string
@@ -98,8 +98,8 @@ val get_case :
   | VConv of string * variant
   | VSum of string * variant option
 val may_map : ('a -> 'b) -> 'a option -> 'b option = <fun>
-val variantize : 'a ty_env -> ('b, 'a) ty -> 'b -> variant = <fun>
-#                                               val devariantize : 'a ty_env -> ('b, 'a) ty -> variant -> 'b = <fun>
+val variantize : 'e ty_env -> ('a, 'e) ty -> 'a -> variant = <fun>
+#                                               val devariantize : 'e ty_env -> ('t, 'e) ty -> variant -> 't = <fun>
 #     val wrap_A : ('a, 'b) ty -> ([ `A of 'a ], 'b) ty = <fun>
 #   val ty : ('a, ([ `A of ('a * 'b) option ] as 'b) -> 'c) ty -> ('b, 'c) ty =
   <fun>
@@ -124,12 +124,12 @@ val v : variant =
     sum_inj = <fun>}
 #                                             val a : [ `A of int | `B of string | `C ] = `A 3
 type 'a vlist = [ `Cons of 'a * 'a vlist | `Nil ]
-val ty_list : ('a, 'b) ty -> ('a vlist, 'b) ty = <fun>
+val ty_list : ('a, 'e) ty -> ('a vlist, 'e) ty = <fun>
 val v : variant =
   VSum ("Cons",
    Some
     (VPair (VInt 1, VSum ("Cons", Some (VPair (VInt 2, VSum ("Nil", None)))))))
-#                                                               type ('a, 'b) ty =
+#                                                               type (_, _) ty =
     Int : (int, 'c) ty
   | String : (string, 'd) ty
   | List : ('a, 'e) ty -> ('a list, 'e) ty
@@ -149,7 +149,7 @@ val ty_abc : ([ `A of int | `B of string | `C ], 'e) ty = Sum (<fun>, <fun>)
 Error: This pattern matches values of type a * a vlist
        but a pattern was expected which matches values of type
          ex#46 = ex#47 * ex#48
-#                                                         type ('a, 'b) ty =
+#                                                         type (_, _) ty =
     Int : (int, 'd) ty
   | String : (string, 'f) ty
   | List : ('a, 'e) ty -> ('a list, 'e) ty
@@ -164,13 +164,13 @@ Error: This pattern matches values of type a * a vlist
         inj : 'c. ('b, 'c) ty_sel * 'c -> 'a;
         proj : 'a -> string * 'e ty_dyn option > -> ('a, 'e) ty
 and 'e ty_dyn = Tdyn : ('a, 'e) ty * 'a -> 'e ty_dyn
-and ('a, 'b) ty_sel =
+and (_, _) ty_sel =
     Thd : ('a -> 'b, 'a) ty_sel
   | Ttl : ('b -> 'c, 'd) ty_sel -> ('a -> 'b -> 'c, 'd) ty_sel
-and ('a, 'b) ty_case =
+and (_, _) ty_case =
     TCarg : ('b, 'a) ty_sel * ('a, 'e) ty -> ('e, 'b) ty_case
   | TCnoarg : ('b, noarg) ty_sel -> ('e, 'b) ty_case
 #                                                                     val ty_abc : ([ `A of int | `B of string | `C ], 'e) ty = Sum <obj>
 type 'a vlist = [ `Cons of 'a * 'a vlist | `Nil ]
-val ty_list : ('a, 'b) ty -> ('a vlist, 'b) ty = <fun>
+val ty_list : ('a, 'e) ty -> ('a vlist, 'e) ty = <fun>
 #   * * * * * * * * *   
diff --git a/testsuite/tests/typing-gadts/omega07.ml.principal.reference b/testsuite/tests/typing-gadts/omega07.ml.principal.reference
index 60ef06cb35..cf8b0b5bc1 100644
--- a/testsuite/tests/typing-gadts/omega07.ml.principal.reference
+++ b/testsuite/tests/typing-gadts/omega07.ml.principal.reference
@@ -1,47 +1,47 @@
 
 # * * * * *                       type ('a, 'b) sum = Inl of 'a | Inr of 'b
 type zero = Zero
-type 'a succ
-type 'a nat = NZ : zero nat | NS : 'a nat -> 'a succ nat
-#             type ('a, 'b) seq =
+type _ succ
+type _ nat = NZ : zero nat | NS : 'a nat -> 'a succ nat
+#             type (_, _) seq =
     Snil : ('a, zero) seq
   | Scons : 'a * ('a, 'n) seq -> ('a, 'n succ) seq
 #   val l1 : (int, zero succ succ) seq = Scons (3, Scons (5, Snil))
-#       *         type ('a, 'b, 'c) plus =
+#       *         type (_, _, _) plus =
     PlusZ : 'a nat -> (zero, 'a, 'a) plus
   | PlusS : ('a, 'b, 'c) plus -> ('a succ, 'b, 'c succ) plus
-#         val length : ('a, 'b) seq -> 'b nat = <fun>
-#   *                     type ('a, 'b, 'c) app =
+#         val length : ('a, 'n) seq -> 'n nat = <fun>
+#   *                     type (_, _, _) app =
     App : ('a, 'p) seq * ('n, 'm, 'p) plus -> ('a, 'n, 'm) app
-val app : ('a, 'b) seq -> ('a, 'c) seq -> ('a, 'b, 'c) app = <fun>
+val app : ('a, 'n) seq -> ('a, 'm) seq -> ('a, 'n, 'm) app = <fun>
 # *                           type tp
 type nd
-type ('a, 'b) fk
-type 'a shape =
+type (_, _) fk
+type _ shape =
     Tp : tp shape
   | Nd : nd shape
   | Fk : 'a shape * 'b shape -> ('a, 'b) fk shape
 #           type tt
 type ff
-type 'a boolean = BT : tt boolean | BF : ff boolean
-#                 type ('a, 'b) path =
+type _ boolean = BT : tt boolean | BF : ff boolean
+#                 type (_, _) path =
     Pnone : 'a -> (tp, 'a) path
   | Phere : (nd, 'a) path
   | Pleft : ('x, 'a) path -> (('x, 'y) fk, 'a) path
   | Pright : ('y, 'a) path -> (('x, 'y) fk, 'a) path
-#         type ('a, 'b) tree =
+#         type (_, _) tree =
     Ttip : (tp, 'a) tree
   | Tnode : 'a -> (nd, 'a) tree
   | Tfork : ('x, 'a) tree * ('y, 'a) tree -> (('x, 'y) fk, 'a) tree
 #   val tree1 : (((tp, nd) fk, (nd, nd) fk) fk, int) tree =
   Tfork (Tfork (Ttip, Tnode 4), Tfork (Tnode 4, Tnode 3))
-#                     val find : ('a -> 'a -> bool) -> 'a -> ('b, 'a) tree -> ('b, 'a) path list =
+#                     val find : ('a -> 'a -> bool) -> 'a -> ('sh, 'a) tree -> ('sh, 'a) path list =
   <fun>
-#             val extract : ('b, 'a) path -> ('b, 'a) tree -> 'a = <fun>
-#             type ('a, 'b) le =
+#             val extract : ('sh, 'a) path -> ('sh, 'a) tree -> 'a = <fun>
+#             type (_, _) le =
     LeZ : 'a nat -> (zero, 'a) le
   | LeS : ('n, 'm) le -> ('n succ, 'm succ) le
-#       type 'a even = EvenZ : zero even | EvenSS : 'n even -> 'n succ succ even
+#       type _ even = EvenZ : zero even | EvenSS : 'n even -> 'n succ succ even
 #         type one = zero succ
 type two = one succ
 type three = two succ
@@ -51,11 +51,11 @@ val even2 : two even = EvenSS EvenZ
 val even4 : four even = EvenSS (EvenSS EvenZ)
 #   val p1 : (two, one, three) plus = PlusS (PlusS (PlusZ (NS NZ)))
 #         val summandLessThanSum : ('a, 'b, 'c) plus -> ('a, 'c) le = <fun>
-#                                 type ('a, 'b) equal = Eq : ('a, 'a) equal
+#                                 type (_, _) equal = Eq : ('a, 'a) equal
 val convert : ('a, 'b) equal -> 'a -> 'b = <fun>
 val sameNat : 'a nat -> 'b nat -> ('a, 'b) equal option = <fun>
 #             val smaller : ('a succ, 'b succ) le -> ('a, 'b) le = <fun>
-#   type ('a, 'b) diff = Diff : 'c nat * ('a, 'c, 'b) plus -> ('a, 'b) diff
+#   type (_, _) diff = Diff : 'c nat * ('a, 'c, 'b) plus -> ('a, 'b) diff
 #   * * * * * * * * *                 val diff : ('a, 'b) le -> 'a nat -> 'b nat -> ('a, 'b) diff = <fun>
 #               Characters 87-243:
   ..match a, b,le with (* warning *)
@@ -67,38 +67,38 @@ Here is an example of a value that is not matched:
 (NS _, NZ, _)
 val diff : ('a, 'b) le -> 'a nat -> 'b nat -> ('a, 'b) diff = <fun>
 #               val diff : ('a, 'b) le -> 'b nat -> ('a, 'b) diff = <fun>
-#             type ('a, 'b) filter = Filter : ('m, 'n) le * ('a, 'm) seq -> ('a, 'n) filter
-val leS' : ('a, 'b) le -> ('a, 'b succ) le = <fun>
-#                   val filter : ('a -> bool) -> ('a, 'b) seq -> ('a, 'b) filter = <fun>
-#                             type ('a, 'b, 'c) balance =
+#             type (_, _) filter = Filter : ('m, 'n) le * ('a, 'm) seq -> ('a, 'n) filter
+val leS' : ('m, 'n) le -> ('m, 'n succ) le = <fun>
+#                   val filter : ('a -> bool) -> ('a, 'n) seq -> ('a, 'n) filter = <fun>
+#                             type (_, _, _) balance =
     Less : ('h, 'h succ, 'h succ) balance
   | Same : ('h, 'h, 'h) balance
   | More : ('h succ, 'h, 'h succ) balance
-type 'a avl =
+type _ avl =
     Leaf : zero avl
   | Node : ('hL, 'hR, 'hMax) balance * 'hL avl * int *
       'hR avl -> 'hMax succ avl
 type avl' = Avl : 'h avl -> avl'
 #                 val empty : avl' = Avl Leaf
-val elem : int -> 'a avl -> bool = <fun>
+val elem : int -> 'h avl -> bool = <fun>
 #                           val rotr :
-  'a succ succ avl ->
-  int -> 'a avl -> ('a succ succ avl, 'a succ succ succ avl) sum = <fun>
+  'n succ succ avl ->
+  int -> 'n avl -> ('n succ succ avl, 'n succ succ succ avl) sum = <fun>
 #                         val rotl :
-  'a avl ->
-  int -> 'a succ succ avl -> ('a succ succ avl, 'a succ succ succ avl) sum =
+  'n avl ->
+  int -> 'n succ succ avl -> ('n succ succ avl, 'n succ succ succ avl) sum =
   <fun>
-#                                               val ins : int -> 'a avl -> ('a avl, 'a succ avl) sum = <fun>
+#                                               val ins : int -> 'n avl -> ('n avl, 'n succ avl) sum = <fun>
 #           val insert : int -> avl' -> avl' = <fun>
-#                                                                                                                                 val del_min : 'a succ avl -> int * ('a avl, 'a succ avl) sum = <fun>
-type 'a avl_del =
+#                                                                                                                                 val del_min : 'n succ avl -> int * ('n avl, 'n succ avl) sum = <fun>
+type _ avl_del =
     Dsame : 'n avl -> 'n avl_del
   | Ddecr : ('m succ, 'n) equal * 'm avl -> 'n avl_del
-val del : int -> 'a avl -> 'a avl_del = <fun>
+val del : int -> 'n avl -> 'n avl_del = <fun>
 #           val delete : int -> avl' -> avl' = <fun>
 #                             type red
 type black
-type ('a, 'b) sub_tree =
+type (_, _) sub_tree =
     Bleaf : (black, zero) sub_tree
   | Rnode : (black, 'n) sub_tree * int *
       (black, 'n) sub_tree -> (red, 'n) sub_tree
@@ -106,16 +106,16 @@ type ('a, 'b) sub_tree =
       ('cR, 'n) sub_tree -> (black, 'n succ) sub_tree
 type rb_tree = Root : (black, 'n) sub_tree -> rb_tree
 #               type dir = LeftD | RightD
-type ('a, 'b) ctxt =
+type (_, _) ctxt =
     CNil : (black, 'n) ctxt
   | CRed : int * dir * (black, 'n) sub_tree *
       (red, 'n) ctxt -> (black, 'n) ctxt
   | CBlk : int * dir * ('c1, 'n) sub_tree *
       (black, 'n succ) ctxt -> ('c, 'n) ctxt
 #                         val blacken : (red, 'a) sub_tree -> (black, 'a succ) sub_tree = <fun>
-type 'a crep = Red : red crep | Black : black crep
-val color : ('a, 'b) sub_tree -> 'a crep = <fun>
-#                   val fill : ('a, 'b) ctxt -> ('a, 'b) sub_tree -> rb_tree = <fun>
+type _ crep = Red : red crep | Black : black crep
+val color : ('c, 'n) sub_tree -> 'c crep = <fun>
+#                   val fill : ('c, 'n) ctxt -> ('c, 'n) sub_tree -> rb_tree = <fun>
 #             val recolor :
   dir ->
   int ->
@@ -132,10 +132,10 @@ val color : ('a, 'b) sub_tree -> 'a crep = <fun>
   int ->
   (black, 'a) sub_tree -> (red, 'a) sub_tree -> (black, 'a succ) sub_tree =
   <fun>
-#                     val repair : (red, 'a) sub_tree -> ('b, 'a) ctxt -> rb_tree = <fun>
-#                     val ins : int -> ('a, 'b) sub_tree -> ('a, 'b) ctxt -> rb_tree = <fun>
+#                     val repair : (red, 'n) sub_tree -> ('c, 'n) ctxt -> rb_tree = <fun>
+#                     val ins : int -> ('c, 'n) sub_tree -> ('c, 'n) ctxt -> rb_tree = <fun>
 #   val insert : int -> rb_tree -> rb_tree = <fun>
-#                                                                                                 type 'a term =
+#                                                                                                 type _ term =
     Const : int -> int term
   | Add : (int * int -> int) term
   | LT : (int * int -> bool) term
@@ -145,16 +145,16 @@ val ex1 : int term = Ap (Add, Pair (Const 3, Const 5))
 val ex2 : (int * int) term =
   Pair (Ap (Add, Pair (Const 3, Const 5)), Const 1)
 val eval_term : 'a term -> 'a = <fun>
-type 'a rep =
+type _ rep =
     Rint : int rep
   | Rbool : bool rep
   | Rpair : 'a rep * 'b rep -> ('a * 'b) rep
   | Rfun : 'a rep * 'b rep -> ('a -> 'b) rep
-type ('a, 'b) equal = Eq : ('a, 'a) equal
+type (_, _) equal = Eq : ('a, 'a) equal
 val rep_equal : 'a rep -> 'b rep -> ('a, 'b) equal option = <fun>
 #                                                               type assoc = Assoc : string * 'a rep * 'a -> assoc
 val assoc : string -> 'a rep -> assoc list -> 'a = <fun>
-type 'a term =
+type _ term =
     Var : string * 'a rep -> 'a term
   | Abs : string * 'a rep * 'b term -> ('a -> 'b) term
   | Const : int -> int term
@@ -170,11 +170,11 @@ val ex4 : int term =
    Const 3)
 val v4 : int = 6
 #                                             type rnil
-type ('a, 'b, 'c) rcons
-type 'a is_row =
+type (_, _, _) rcons
+type _ is_row =
     Rnil : rnil is_row
   | Rcons : 'c is_row -> ('a, 'b, 'c) rcons is_row
-type ('a, 'b) lam =
+type (_, _) lam =
     Const : int -> ('e, int) lam
   | Var : 'a -> (('a, 't, 'e) rcons, 't) lam
   | Shift : ('e, 't) lam -> (('a, 'q, 'e) rcons, 't) lam
@@ -186,10 +186,10 @@ val ex1 : ((x, 'a -> 'b, (y, 'a, 'c) rcons) rcons, 'b) lam =
   App (Var X, Shift (Var Y))
 val ex2 : ('a, ('b -> 'c) -> 'b -> 'c) lam =
   Abs (<poly>, Abs (<poly>, App (Shift (Var <poly>), Var <poly>)))
-#                           type 'a env =
+#                           type _ env =
     Enil : rnil env
   | Econs : 'a * 't * 'e env -> ('a, 't, 'e) rcons env
-val eval_lam : 'a env -> ('a, 'b) lam -> 'b = <fun>
+val eval_lam : 'e env -> ('e, 't) lam -> 't = <fun>
 #                               type add = Add
 type suc = Suc
 val env0 :
@@ -233,21 +233,19 @@ val ex3 :
    App (Shift (Var Suc),
     App (Shift (Var Suc), App (Shift (Var Suc), Var Zero))))
 #     val v3 : int = 6
-#       *                                       type 'a rep = I : int rep | Ar : 'a rep * 'b rep -> ('a -> 'b) rep
+#       *                                       type _ rep = I : int rep | Ar : 'a rep * 'b rep -> ('a -> 'b) rep
 val compare : 'a rep -> 'b rep -> (string, ('a, 'b) equal) sum = <fun>
 #                     type term =
     C of int
   | Ab : string * 'a rep * term -> term
   | Ap of term * term
   | V of string
-type 'a ctx =
+type _ ctx =
     Cnil : rnil ctx
   | Ccons : 't * string * 'x rep * 'e ctx -> ('t, 'x, 'e) rcons ctx
-#                             type 'a checked =
-    Cerror of string
-  | Cok : ('e, 't) lam * 't rep -> 'e checked
-val lookup : string -> 'a ctx -> 'a checked = <fun>
-#                                                   val tc : 'a nat -> 'b ctx -> term -> 'b checked = <fun>
+#                             type _ checked = Cerror of string | Cok : ('e, 't) lam * 't rep -> 'e checked
+val lookup : string -> 'e ctx -> 'e checked = <fun>
+#                                                   val tc : 'n nat -> 'e ctx -> term -> 'e checked = <fun>
 #             val ctx0 :
   (zero, int, (suc, int -> int, (add, int -> int -> int, rnil) rcons) rcons)
   rcons ctx =
@@ -275,13 +273,13 @@ val ex1 : term = Ab ("x", I, Ap (Ap (V "+", V "x"), V "x"))
 #   val v2 : int = 6
 #                                             type pexp
 type pval
-type 'a mode = Pexp : pexp mode | Pval : pval mode
-type ('a, 'b) tarr
+type _ mode = Pexp : pexp mode | Pval : pval mode
+type (_, _) tarr
 type tint
-type ('a, 'b) rel =
+type (_, _) rel =
     IntR : (tint, int) rel
   | IntTo : ('b, 's) rel -> ((tint, 'b) tarr, int -> 's) rel
-type ('a, 'b, 'c) lam =
+type (_, _, _) lam =
     Const : ('a, 'b) rel * 'b -> (pval, 'env, 'a) lam
   | Var : 'a -> (pval, ('a, 't, 'e) rcons, 't) lam
   | Shift : ('m, 'e, 't) lam -> ('m, ('a, 'q, 'e) rcons, 't) lam
@@ -291,18 +289,18 @@ type ('a, 'b, 'c) lam =
       ('m2, 'e, 's) lam -> (pexp, 'e, 't) lam
 #                   val ex1 : (pexp, 'a, tint) lam =
   App (Lam (<poly>, Var <poly>), Const (IntR, <poly>))
-val mode : ('a, 'b, 'c) lam -> 'a mode = <fun>
-#               type ('a, 'b) sub =
+val mode : ('m, 'e, 't) lam -> 'm mode = <fun>
+#               type (_, _) sub =
     Id : ('r, 'r) sub
   | Bind : 't * ('m, 'r2, 'x) lam *
       ('r, 'r2) sub -> (('t, 'x, 'r) rcons, 'r2) sub
   | Push : ('r1, 'r2) sub -> (('a, 'b, 'r1) rcons, ('a, 'b, 'r2) rcons) sub
-type ('a, 'b) lam' = Ex : ('m, 's, 't) lam -> ('s, 't) lam'
-#                               val subst : ('a, 'b, 'c) lam -> ('b, 'd) sub -> ('d, 'c) lam' = <fun>
+type (_, _) lam' = Ex : ('m, 's, 't) lam -> ('s, 't) lam'
+#                               val subst : ('m1, 'r, 't) lam -> ('r, 's) sub -> ('s, 't) lam' = <fun>
 #       type closed = rnil
 type 'a rlam = ((pexp, closed, 'a) lam, (pval, closed, 'a) lam) sum
 #                             val rule :
   (pval, closed, ('a, 'b) tarr) lam -> (pval, closed, 'a) lam -> 'b rlam =
   <fun>
-#                                 val onestep : ('a, closed, 'b) lam -> 'b rlam = <fun>
+#                                 val onestep : ('m, closed, 't) lam -> 't rlam = <fun>
 # 
diff --git a/testsuite/tests/typing-gadts/omega07.ml.reference b/testsuite/tests/typing-gadts/omega07.ml.reference
index 60ef06cb35..cf8b0b5bc1 100644
--- a/testsuite/tests/typing-gadts/omega07.ml.reference
+++ b/testsuite/tests/typing-gadts/omega07.ml.reference
@@ -1,47 +1,47 @@
 
 # * * * * *                       type ('a, 'b) sum = Inl of 'a | Inr of 'b
 type zero = Zero
-type 'a succ
-type 'a nat = NZ : zero nat | NS : 'a nat -> 'a succ nat
-#             type ('a, 'b) seq =
+type _ succ
+type _ nat = NZ : zero nat | NS : 'a nat -> 'a succ nat
+#             type (_, _) seq =
     Snil : ('a, zero) seq
   | Scons : 'a * ('a, 'n) seq -> ('a, 'n succ) seq
 #   val l1 : (int, zero succ succ) seq = Scons (3, Scons (5, Snil))
-#       *         type ('a, 'b, 'c) plus =
+#       *         type (_, _, _) plus =
     PlusZ : 'a nat -> (zero, 'a, 'a) plus
   | PlusS : ('a, 'b, 'c) plus -> ('a succ, 'b, 'c succ) plus
-#         val length : ('a, 'b) seq -> 'b nat = <fun>
-#   *                     type ('a, 'b, 'c) app =
+#         val length : ('a, 'n) seq -> 'n nat = <fun>
+#   *                     type (_, _, _) app =
     App : ('a, 'p) seq * ('n, 'm, 'p) plus -> ('a, 'n, 'm) app
-val app : ('a, 'b) seq -> ('a, 'c) seq -> ('a, 'b, 'c) app = <fun>
+val app : ('a, 'n) seq -> ('a, 'm) seq -> ('a, 'n, 'm) app = <fun>
 # *                           type tp
 type nd
-type ('a, 'b) fk
-type 'a shape =
+type (_, _) fk
+type _ shape =
     Tp : tp shape
   | Nd : nd shape
   | Fk : 'a shape * 'b shape -> ('a, 'b) fk shape
 #           type tt
 type ff
-type 'a boolean = BT : tt boolean | BF : ff boolean
-#                 type ('a, 'b) path =
+type _ boolean = BT : tt boolean | BF : ff boolean
+#                 type (_, _) path =
     Pnone : 'a -> (tp, 'a) path
   | Phere : (nd, 'a) path
   | Pleft : ('x, 'a) path -> (('x, 'y) fk, 'a) path
   | Pright : ('y, 'a) path -> (('x, 'y) fk, 'a) path
-#         type ('a, 'b) tree =
+#         type (_, _) tree =
     Ttip : (tp, 'a) tree
   | Tnode : 'a -> (nd, 'a) tree
   | Tfork : ('x, 'a) tree * ('y, 'a) tree -> (('x, 'y) fk, 'a) tree
 #   val tree1 : (((tp, nd) fk, (nd, nd) fk) fk, int) tree =
   Tfork (Tfork (Ttip, Tnode 4), Tfork (Tnode 4, Tnode 3))
-#                     val find : ('a -> 'a -> bool) -> 'a -> ('b, 'a) tree -> ('b, 'a) path list =
+#                     val find : ('a -> 'a -> bool) -> 'a -> ('sh, 'a) tree -> ('sh, 'a) path list =
   <fun>
-#             val extract : ('b, 'a) path -> ('b, 'a) tree -> 'a = <fun>
-#             type ('a, 'b) le =
+#             val extract : ('sh, 'a) path -> ('sh, 'a) tree -> 'a = <fun>
+#             type (_, _) le =
     LeZ : 'a nat -> (zero, 'a) le
   | LeS : ('n, 'm) le -> ('n succ, 'm succ) le
-#       type 'a even = EvenZ : zero even | EvenSS : 'n even -> 'n succ succ even
+#       type _ even = EvenZ : zero even | EvenSS : 'n even -> 'n succ succ even
 #         type one = zero succ
 type two = one succ
 type three = two succ
@@ -51,11 +51,11 @@ val even2 : two even = EvenSS EvenZ
 val even4 : four even = EvenSS (EvenSS EvenZ)
 #   val p1 : (two, one, three) plus = PlusS (PlusS (PlusZ (NS NZ)))
 #         val summandLessThanSum : ('a, 'b, 'c) plus -> ('a, 'c) le = <fun>
-#                                 type ('a, 'b) equal = Eq : ('a, 'a) equal
+#                                 type (_, _) equal = Eq : ('a, 'a) equal
 val convert : ('a, 'b) equal -> 'a -> 'b = <fun>
 val sameNat : 'a nat -> 'b nat -> ('a, 'b) equal option = <fun>
 #             val smaller : ('a succ, 'b succ) le -> ('a, 'b) le = <fun>
-#   type ('a, 'b) diff = Diff : 'c nat * ('a, 'c, 'b) plus -> ('a, 'b) diff
+#   type (_, _) diff = Diff : 'c nat * ('a, 'c, 'b) plus -> ('a, 'b) diff
 #   * * * * * * * * *                 val diff : ('a, 'b) le -> 'a nat -> 'b nat -> ('a, 'b) diff = <fun>
 #               Characters 87-243:
   ..match a, b,le with (* warning *)
@@ -67,38 +67,38 @@ Here is an example of a value that is not matched:
 (NS _, NZ, _)
 val diff : ('a, 'b) le -> 'a nat -> 'b nat -> ('a, 'b) diff = <fun>
 #               val diff : ('a, 'b) le -> 'b nat -> ('a, 'b) diff = <fun>
-#             type ('a, 'b) filter = Filter : ('m, 'n) le * ('a, 'm) seq -> ('a, 'n) filter
-val leS' : ('a, 'b) le -> ('a, 'b succ) le = <fun>
-#                   val filter : ('a -> bool) -> ('a, 'b) seq -> ('a, 'b) filter = <fun>
-#                             type ('a, 'b, 'c) balance =
+#             type (_, _) filter = Filter : ('m, 'n) le * ('a, 'm) seq -> ('a, 'n) filter
+val leS' : ('m, 'n) le -> ('m, 'n succ) le = <fun>
+#                   val filter : ('a -> bool) -> ('a, 'n) seq -> ('a, 'n) filter = <fun>
+#                             type (_, _, _) balance =
     Less : ('h, 'h succ, 'h succ) balance
   | Same : ('h, 'h, 'h) balance
   | More : ('h succ, 'h, 'h succ) balance
-type 'a avl =
+type _ avl =
     Leaf : zero avl
   | Node : ('hL, 'hR, 'hMax) balance * 'hL avl * int *
       'hR avl -> 'hMax succ avl
 type avl' = Avl : 'h avl -> avl'
 #                 val empty : avl' = Avl Leaf
-val elem : int -> 'a avl -> bool = <fun>
+val elem : int -> 'h avl -> bool = <fun>
 #                           val rotr :
-  'a succ succ avl ->
-  int -> 'a avl -> ('a succ succ avl, 'a succ succ succ avl) sum = <fun>
+  'n succ succ avl ->
+  int -> 'n avl -> ('n succ succ avl, 'n succ succ succ avl) sum = <fun>
 #                         val rotl :
-  'a avl ->
-  int -> 'a succ succ avl -> ('a succ succ avl, 'a succ succ succ avl) sum =
+  'n avl ->
+  int -> 'n succ succ avl -> ('n succ succ avl, 'n succ succ succ avl) sum =
   <fun>
-#                                               val ins : int -> 'a avl -> ('a avl, 'a succ avl) sum = <fun>
+#                                               val ins : int -> 'n avl -> ('n avl, 'n succ avl) sum = <fun>
 #           val insert : int -> avl' -> avl' = <fun>
-#                                                                                                                                 val del_min : 'a succ avl -> int * ('a avl, 'a succ avl) sum = <fun>
-type 'a avl_del =
+#                                                                                                                                 val del_min : 'n succ avl -> int * ('n avl, 'n succ avl) sum = <fun>
+type _ avl_del =
     Dsame : 'n avl -> 'n avl_del
   | Ddecr : ('m succ, 'n) equal * 'm avl -> 'n avl_del
-val del : int -> 'a avl -> 'a avl_del = <fun>
+val del : int -> 'n avl -> 'n avl_del = <fun>
 #           val delete : int -> avl' -> avl' = <fun>
 #                             type red
 type black
-type ('a, 'b) sub_tree =
+type (_, _) sub_tree =
     Bleaf : (black, zero) sub_tree
   | Rnode : (black, 'n) sub_tree * int *
       (black, 'n) sub_tree -> (red, 'n) sub_tree
@@ -106,16 +106,16 @@ type ('a, 'b) sub_tree =
       ('cR, 'n) sub_tree -> (black, 'n succ) sub_tree
 type rb_tree = Root : (black, 'n) sub_tree -> rb_tree
 #               type dir = LeftD | RightD
-type ('a, 'b) ctxt =
+type (_, _) ctxt =
     CNil : (black, 'n) ctxt
   | CRed : int * dir * (black, 'n) sub_tree *
       (red, 'n) ctxt -> (black, 'n) ctxt
   | CBlk : int * dir * ('c1, 'n) sub_tree *
       (black, 'n succ) ctxt -> ('c, 'n) ctxt
 #                         val blacken : (red, 'a) sub_tree -> (black, 'a succ) sub_tree = <fun>
-type 'a crep = Red : red crep | Black : black crep
-val color : ('a, 'b) sub_tree -> 'a crep = <fun>
-#                   val fill : ('a, 'b) ctxt -> ('a, 'b) sub_tree -> rb_tree = <fun>
+type _ crep = Red : red crep | Black : black crep
+val color : ('c, 'n) sub_tree -> 'c crep = <fun>
+#                   val fill : ('c, 'n) ctxt -> ('c, 'n) sub_tree -> rb_tree = <fun>
 #             val recolor :
   dir ->
   int ->
@@ -132,10 +132,10 @@ val color : ('a, 'b) sub_tree -> 'a crep = <fun>
   int ->
   (black, 'a) sub_tree -> (red, 'a) sub_tree -> (black, 'a succ) sub_tree =
   <fun>
-#                     val repair : (red, 'a) sub_tree -> ('b, 'a) ctxt -> rb_tree = <fun>
-#                     val ins : int -> ('a, 'b) sub_tree -> ('a, 'b) ctxt -> rb_tree = <fun>
+#                     val repair : (red, 'n) sub_tree -> ('c, 'n) ctxt -> rb_tree = <fun>
+#                     val ins : int -> ('c, 'n) sub_tree -> ('c, 'n) ctxt -> rb_tree = <fun>
 #   val insert : int -> rb_tree -> rb_tree = <fun>
-#                                                                                                 type 'a term =
+#                                                                                                 type _ term =
     Const : int -> int term
   | Add : (int * int -> int) term
   | LT : (int * int -> bool) term
@@ -145,16 +145,16 @@ val ex1 : int term = Ap (Add, Pair (Const 3, Const 5))
 val ex2 : (int * int) term =
   Pair (Ap (Add, Pair (Const 3, Const 5)), Const 1)
 val eval_term : 'a term -> 'a = <fun>
-type 'a rep =
+type _ rep =
     Rint : int rep
   | Rbool : bool rep
   | Rpair : 'a rep * 'b rep -> ('a * 'b) rep
   | Rfun : 'a rep * 'b rep -> ('a -> 'b) rep
-type ('a, 'b) equal = Eq : ('a, 'a) equal
+type (_, _) equal = Eq : ('a, 'a) equal
 val rep_equal : 'a rep -> 'b rep -> ('a, 'b) equal option = <fun>
 #                                                               type assoc = Assoc : string * 'a rep * 'a -> assoc
 val assoc : string -> 'a rep -> assoc list -> 'a = <fun>
-type 'a term =
+type _ term =
     Var : string * 'a rep -> 'a term
   | Abs : string * 'a rep * 'b term -> ('a -> 'b) term
   | Const : int -> int term
@@ -170,11 +170,11 @@ val ex4 : int term =
    Const 3)
 val v4 : int = 6
 #                                             type rnil
-type ('a, 'b, 'c) rcons
-type 'a is_row =
+type (_, _, _) rcons
+type _ is_row =
     Rnil : rnil is_row
   | Rcons : 'c is_row -> ('a, 'b, 'c) rcons is_row
-type ('a, 'b) lam =
+type (_, _) lam =
     Const : int -> ('e, int) lam
   | Var : 'a -> (('a, 't, 'e) rcons, 't) lam
   | Shift : ('e, 't) lam -> (('a, 'q, 'e) rcons, 't) lam
@@ -186,10 +186,10 @@ val ex1 : ((x, 'a -> 'b, (y, 'a, 'c) rcons) rcons, 'b) lam =
   App (Var X, Shift (Var Y))
 val ex2 : ('a, ('b -> 'c) -> 'b -> 'c) lam =
   Abs (<poly>, Abs (<poly>, App (Shift (Var <poly>), Var <poly>)))
-#                           type 'a env =
+#                           type _ env =
     Enil : rnil env
   | Econs : 'a * 't * 'e env -> ('a, 't, 'e) rcons env
-val eval_lam : 'a env -> ('a, 'b) lam -> 'b = <fun>
+val eval_lam : 'e env -> ('e, 't) lam -> 't = <fun>
 #                               type add = Add
 type suc = Suc
 val env0 :
@@ -233,21 +233,19 @@ val ex3 :
    App (Shift (Var Suc),
     App (Shift (Var Suc), App (Shift (Var Suc), Var Zero))))
 #     val v3 : int = 6
-#       *                                       type 'a rep = I : int rep | Ar : 'a rep * 'b rep -> ('a -> 'b) rep
+#       *                                       type _ rep = I : int rep | Ar : 'a rep * 'b rep -> ('a -> 'b) rep
 val compare : 'a rep -> 'b rep -> (string, ('a, 'b) equal) sum = <fun>
 #                     type term =
     C of int
   | Ab : string * 'a rep * term -> term
   | Ap of term * term
   | V of string
-type 'a ctx =
+type _ ctx =
     Cnil : rnil ctx
   | Ccons : 't * string * 'x rep * 'e ctx -> ('t, 'x, 'e) rcons ctx
-#                             type 'a checked =
-    Cerror of string
-  | Cok : ('e, 't) lam * 't rep -> 'e checked
-val lookup : string -> 'a ctx -> 'a checked = <fun>
-#                                                   val tc : 'a nat -> 'b ctx -> term -> 'b checked = <fun>
+#                             type _ checked = Cerror of string | Cok : ('e, 't) lam * 't rep -> 'e checked
+val lookup : string -> 'e ctx -> 'e checked = <fun>
+#                                                   val tc : 'n nat -> 'e ctx -> term -> 'e checked = <fun>
 #             val ctx0 :
   (zero, int, (suc, int -> int, (add, int -> int -> int, rnil) rcons) rcons)
   rcons ctx =
@@ -275,13 +273,13 @@ val ex1 : term = Ab ("x", I, Ap (Ap (V "+", V "x"), V "x"))
 #   val v2 : int = 6
 #                                             type pexp
 type pval
-type 'a mode = Pexp : pexp mode | Pval : pval mode
-type ('a, 'b) tarr
+type _ mode = Pexp : pexp mode | Pval : pval mode
+type (_, _) tarr
 type tint
-type ('a, 'b) rel =
+type (_, _) rel =
     IntR : (tint, int) rel
   | IntTo : ('b, 's) rel -> ((tint, 'b) tarr, int -> 's) rel
-type ('a, 'b, 'c) lam =
+type (_, _, _) lam =
     Const : ('a, 'b) rel * 'b -> (pval, 'env, 'a) lam
   | Var : 'a -> (pval, ('a, 't, 'e) rcons, 't) lam
   | Shift : ('m, 'e, 't) lam -> ('m, ('a, 'q, 'e) rcons, 't) lam
@@ -291,18 +289,18 @@ type ('a, 'b, 'c) lam =
       ('m2, 'e, 's) lam -> (pexp, 'e, 't) lam
 #                   val ex1 : (pexp, 'a, tint) lam =
   App (Lam (<poly>, Var <poly>), Const (IntR, <poly>))
-val mode : ('a, 'b, 'c) lam -> 'a mode = <fun>
-#               type ('a, 'b) sub =
+val mode : ('m, 'e, 't) lam -> 'm mode = <fun>
+#               type (_, _) sub =
     Id : ('r, 'r) sub
   | Bind : 't * ('m, 'r2, 'x) lam *
       ('r, 'r2) sub -> (('t, 'x, 'r) rcons, 'r2) sub
   | Push : ('r1, 'r2) sub -> (('a, 'b, 'r1) rcons, ('a, 'b, 'r2) rcons) sub
-type ('a, 'b) lam' = Ex : ('m, 's, 't) lam -> ('s, 't) lam'
-#                               val subst : ('a, 'b, 'c) lam -> ('b, 'd) sub -> ('d, 'c) lam' = <fun>
+type (_, _) lam' = Ex : ('m, 's, 't) lam -> ('s, 't) lam'
+#                               val subst : ('m1, 'r, 't) lam -> ('r, 's) sub -> ('s, 't) lam' = <fun>
 #       type closed = rnil
 type 'a rlam = ((pexp, closed, 'a) lam, (pval, closed, 'a) lam) sum
 #                             val rule :
   (pval, closed, ('a, 'b) tarr) lam -> (pval, closed, 'a) lam -> 'b rlam =
   <fun>
-#                                 val onestep : ('a, closed, 'b) lam -> 'b rlam = <fun>
+#                                 val onestep : ('m, closed, 't) lam -> 't rlam = <fun>
 # 
diff --git a/testsuite/tests/typing-gadts/pr5332.ml.reference b/testsuite/tests/typing-gadts/pr5332.ml.reference
index a77459917c..4cf48a22c9 100644
--- a/testsuite/tests/typing-gadts/pr5332.ml.reference
+++ b/testsuite/tests/typing-gadts/pr5332.ml.reference
@@ -14,6 +14,6 @@
 Warning 8: this pattern-matching is not exhaustive.
 Here is an example of a value that is not matched:
 (Tbool, Tvar _)
-val f : ('a, 'b) typ -> ('a, 'b) typ -> int = <fun>
+val f : ('env, 'a) typ -> ('env, 'a) typ -> int = <fun>
 #   Exception: Match_failure ("//toplevel//", 9, 1).
 # 
diff --git a/testsuite/tests/typing-gadts/term-conv.ml.principal.reference b/testsuite/tests/typing-gadts/term-conv.ml.principal.reference
index 3c6b335f67..cff10f16f9 100644
--- a/testsuite/tests/typing-gadts/term-conv.ml.principal.reference
+++ b/testsuite/tests/typing-gadts/term-conv.ml.principal.reference
@@ -7,48 +7,48 @@
       | List : 'a ty -> 'a list ty
       | Pair : ('a ty * 'b ty) -> ('a * 'b) ty
       | Fun : ('a ty * 'b ty) -> ('a -> 'b) ty
-    type ('a, 'b) eq = Eq : ('a, 'a) eq
+    type (_, _) eq = Eq : ('a, 'a) eq
     exception CastFailure
-    val check_eq : 'a ty -> 'b ty -> ('a, 'b) eq
-    val gcast : 'a ty -> 'b ty -> 'a -> 'b
+    val check_eq : 't ty -> 't' ty -> ('t, 't') eq
+    val gcast : 't ty -> 't' ty -> 't -> 't'
   end
 #                               module HOAS :
   sig
-    type 'a term =
+    type _ term =
         Tag : 't Typeable.ty * int -> 't term
       | Con : 't -> 't term
       | Lam : 's Typeable.ty * ('s term -> 't term) -> ('s -> 't) term
       | App : ('s -> 't) term * 's term -> 't term
-    val intp : 'a term -> 'a
+    val intp : 't term -> 't
   end
 #                                                               module DeBruijn :
   sig
     type ('env, 't) ix =
         ZeroIx : ('env * 't, 't) ix
       | SuccIx : ('env, 't) ix -> ('env * 's, 't) ix
-    val to_int : ('a, 'b) ix -> int
+    val to_int : ('env, 't) ix -> int
     type ('env, 't) term =
         Var : ('env, 't) ix -> ('env, 't) term
       | Con : 't -> ('env, 't) term
       | Lam : ('env * 's, 't) term -> ('env, 's -> 't) term
       | App : ('env, 's -> 't) term * ('env, 's) term -> ('env, 't) term
-    type 'a stack =
+    type _ stack =
         Empty : unit stack
       | Push : 'env stack * 't -> ('env * 't) stack
-    val prj : ('a, 'b) ix -> 'a stack -> 'b
-    val intp : ('a, 'b) term -> 'a stack -> 'b
+    val prj : ('env, 't) ix -> 'env stack -> 't
+    val intp : ('env, 't) term -> 'env stack -> 't
   end
 #                                                                             module Convert :
   sig
-    type ('a, 'b) layout =
+    type (_, _) layout =
         EmptyLayout : ('env, unit) layout
       | PushLayout : 't Typeable.ty * ('env, 'env') layout *
           ('env, 't) DeBruijn.ix -> ('env, 'env' * 't) layout
-    val size : ('a, 'b) layout -> int
-    val inc : ('a, 'b) layout -> ('a * 't, 'b) layout
+    val size : ('env, 'env') layout -> int
+    val inc : ('env, 'env') layout -> ('env * 't, 'env') layout
     val prj :
-      'a Typeable.ty -> int -> ('b, 'c) layout -> ('b, 'a) DeBruijn.ix
-    val cvt : ('a, 'a) layout -> 'b HOAS.term -> ('a, 'b) DeBruijn.term
+      't Typeable.ty -> int -> ('env, 'env') layout -> ('env, 't) DeBruijn.ix
+    val cvt : ('env, 'env) layout -> 't HOAS.term -> ('env, 't) DeBruijn.term
     val convert : 'a HOAS.term -> (unit, 'a) DeBruijn.term
   end
 #                                               module Main :
diff --git a/testsuite/tests/typing-gadts/term-conv.ml.reference b/testsuite/tests/typing-gadts/term-conv.ml.reference
index 3c6b335f67..cff10f16f9 100644
--- a/testsuite/tests/typing-gadts/term-conv.ml.reference
+++ b/testsuite/tests/typing-gadts/term-conv.ml.reference
@@ -7,48 +7,48 @@
       | List : 'a ty -> 'a list ty
       | Pair : ('a ty * 'b ty) -> ('a * 'b) ty
       | Fun : ('a ty * 'b ty) -> ('a -> 'b) ty
-    type ('a, 'b) eq = Eq : ('a, 'a) eq
+    type (_, _) eq = Eq : ('a, 'a) eq
     exception CastFailure
-    val check_eq : 'a ty -> 'b ty -> ('a, 'b) eq
-    val gcast : 'a ty -> 'b ty -> 'a -> 'b
+    val check_eq : 't ty -> 't' ty -> ('t, 't') eq
+    val gcast : 't ty -> 't' ty -> 't -> 't'
   end
 #                               module HOAS :
   sig
-    type 'a term =
+    type _ term =
         Tag : 't Typeable.ty * int -> 't term
       | Con : 't -> 't term
       | Lam : 's Typeable.ty * ('s term -> 't term) -> ('s -> 't) term
       | App : ('s -> 't) term * 's term -> 't term
-    val intp : 'a term -> 'a
+    val intp : 't term -> 't
   end
 #                                                               module DeBruijn :
   sig
     type ('env, 't) ix =
         ZeroIx : ('env * 't, 't) ix
       | SuccIx : ('env, 't) ix -> ('env * 's, 't) ix
-    val to_int : ('a, 'b) ix -> int
+    val to_int : ('env, 't) ix -> int
     type ('env, 't) term =
         Var : ('env, 't) ix -> ('env, 't) term
       | Con : 't -> ('env, 't) term
       | Lam : ('env * 's, 't) term -> ('env, 's -> 't) term
       | App : ('env, 's -> 't) term * ('env, 's) term -> ('env, 't) term
-    type 'a stack =
+    type _ stack =
         Empty : unit stack
       | Push : 'env stack * 't -> ('env * 't) stack
-    val prj : ('a, 'b) ix -> 'a stack -> 'b
-    val intp : ('a, 'b) term -> 'a stack -> 'b
+    val prj : ('env, 't) ix -> 'env stack -> 't
+    val intp : ('env, 't) term -> 'env stack -> 't
   end
 #                                                                             module Convert :
   sig
-    type ('a, 'b) layout =
+    type (_, _) layout =
         EmptyLayout : ('env, unit) layout
       | PushLayout : 't Typeable.ty * ('env, 'env') layout *
           ('env, 't) DeBruijn.ix -> ('env, 'env' * 't) layout
-    val size : ('a, 'b) layout -> int
-    val inc : ('a, 'b) layout -> ('a * 't, 'b) layout
+    val size : ('env, 'env') layout -> int
+    val inc : ('env, 'env') layout -> ('env * 't, 'env') layout
     val prj :
-      'a Typeable.ty -> int -> ('b, 'c) layout -> ('b, 'a) DeBruijn.ix
-    val cvt : ('a, 'a) layout -> 'b HOAS.term -> ('a, 'b) DeBruijn.term
+      't Typeable.ty -> int -> ('env, 'env') layout -> ('env, 't) DeBruijn.ix
+    val cvt : ('env, 'env) layout -> 't HOAS.term -> ('env, 't) DeBruijn.term
     val convert : 'a HOAS.term -> (unit, 'a) DeBruijn.term
   end
 #                                               module Main :
diff --git a/testsuite/tests/typing-gadts/test.ml.principal.reference b/testsuite/tests/typing-gadts/test.ml.principal.reference
index 5e4458a981..f692325f1d 100644
--- a/testsuite/tests/typing-gadts/test.ml.principal.reference
+++ b/testsuite/tests/typing-gadts/test.ml.principal.reference
@@ -1,19 +1,19 @@
 
 #                                                         module Exp :
   sig
-    type 'a t =
+    type _ t =
         IntLit : int -> int t
       | BoolLit : bool -> bool t
       | Pair : 'a t * 'b t -> ('a * 'b) t
       | App : ('a -> 'b) t * 'a t -> 'b t
       | Abs : ('a -> 'b) -> ('a -> 'b) t
-    val eval : 'a t -> 'a
+    val eval : 's t -> 's
     val discern : 'a t -> int
   end
 #                                     module List :
   sig
     type zero
-    type 'a t = Nil : zero t | Cons : 'a * 'b t -> ('a * 'b) t
+    type _ t = Nil : zero t | Cons : 'a * 'b t -> ('a * 'b) t
     val head : ('a * 'b) t -> 'a
     val tail : ('a * 'b) t -> 'b t
     val length : 'a t -> int
@@ -35,17 +35,17 @@ module Nonexhaustive :
   sig
     type 'a u = C1 : int -> int u | C2 : bool -> bool u
     type 'a v = C1 : int -> int v
-    val unexhaustive : 'a u -> 'a
+    val unexhaustive : 's u -> 's
     module M : sig type t type u end
     type 'a t = Foo : M.t -> M.t t | Bar : M.u -> M.u t
-    val same_type : 'a t * 'a t -> bool
+    val same_type : 's t * 's t -> bool
   end
 #                             module Exhaustive :
   sig
     type t = int
     type u = bool
     type 'a v = Foo : t -> t v | Bar : u -> u v
-    val same_type : 'a v * 'a v -> bool
+    val same_type : 's v * 's v -> bool
   end
 #               Characters 119-120:
       let eval (D x) = x
@@ -76,7 +76,7 @@ Error: This expression has type bool but an expression was expected of type s
                               ^
 Error: This pattern matches values of type b
        but a pattern was expected which matches values of type a
-#   type 'a t = Int : int t
+#   type _ t = Int : int t
 #   val ky : 'a -> 'a -> 'a = <fun>
 #       val test : 'a t -> 'a = <fun>
 #       val test : 'a t -> int = <fun>
@@ -138,11 +138,11 @@ Error: This expression has type a = int
        This instance of int is ambiguous:
        it would escape the scope of its equation
 #           val f : 'a t -> int -> int = <fun>
-#                     type 'a h = Has_m : < m : int > h | Has_b : < b : bool > h
+#                     type _ h = Has_m : < m : int > h | Has_b : < b : bool > h
 val f : 'a h -> 'a = <fun>
-#               type 'a j = Has_A : [ `A of int ] j | Has_B : [ `B of bool ] j
+#               type _ j = Has_A : [ `A of int ] j | Has_B : [ `B of bool ] j
 val f : 'a j -> 'a = <fun>
-#   type ('a, 'b) eq = Eq : ('a, 'a) eq
+#   type (_, _) eq = Eq : ('a, 'a) eq
 #       Characters 5-91:
   ....f : type a b. (a,b) eq -> (<m : a; ..> as 'a) -> (<m : b; ..> as 'a) =
     fun Eq o -> o
@@ -205,8 +205,8 @@ Error: This expression has type [> `A of a ]
   ....f : type a b. (a,b) eq -> [< `A of a | `B] -> [< `A of b | `B] =
     fun Eq o -> o..............
 Error: This definition has type
-         ('c, 'd) eq -> ([< `A of 'd & 'c | `B ] as 'e) -> 'e
-       which is less general than 'a 'b. ('a, 'b) eq -> 'e -> 'e
+         ('a, 'b) eq -> ([< `A of 'b & 'a | `B ] as 'c) -> 'c
+       which is less general than 'a0 'b0. ('a0, 'b0) eq -> 'c -> 'c
 #     val f : ('a, 'b) eq -> [ `A of 'a | `B ] -> [ `A of 'b | `B ] = <fun>
 #       val f : ('a, int) eq -> [ `A of 'a ] -> bool = <fun>
 #           Characters 166-167:
@@ -226,7 +226,7 @@ Error: This expression has type [> `A of a | `B ]
        This instance of a is ambiguous:
        it would escape the scope of its equation
 #                                                     type 'a t = A of int | B of bool | C of float | D of 'a
-type 'a ty =
+type _ ty =
     TE : 'a ty -> 'a array ty
   | TA : int ty
   | TB : bool ty
@@ -276,11 +276,11 @@ Error: This expression has type (a, a) eq
        but an expression was expected of type (a, b) eq
 #       val f : ('a M.t * 'a, 'b M.t * 'b) eq -> ('a, 'b) eq = <fun>
 #       val f : ('a * 'a M.t, 'b * 'b M.t) eq -> ('a, 'b) eq = <fun>
-#                     type 'a t = V1 : [ `A | `B ] t | V2 : [ `C | `D ] t
+#                     type _ t = V1 : [ `A | `B ] t | V2 : [ `C | `D ] t
 val f : 'a t -> 'a = <fun>
 #   - : [ `A | `B ] = `A
-#                 type 'a int_foo = IF_constr : < foo : int; .. > int_foo
-type 'a int_bar = IB_constr : < bar : int; .. > int_bar
+#                 type _ int_foo = IF_constr : < foo : int; .. > int_foo
+type _ int_bar = IB_constr : < bar : int; .. > int_bar
 #         Characters 98-99:
     (x:<foo:int>)
      ^
diff --git a/testsuite/tests/typing-gadts/test.ml.reference b/testsuite/tests/typing-gadts/test.ml.reference
index 3b62fdef83..8d05b4ffe8 100644
--- a/testsuite/tests/typing-gadts/test.ml.reference
+++ b/testsuite/tests/typing-gadts/test.ml.reference
@@ -1,19 +1,19 @@
 
 #                                                         module Exp :
   sig
-    type 'a t =
+    type _ t =
         IntLit : int -> int t
       | BoolLit : bool -> bool t
       | Pair : 'a t * 'b t -> ('a * 'b) t
       | App : ('a -> 'b) t * 'a t -> 'b t
       | Abs : ('a -> 'b) -> ('a -> 'b) t
-    val eval : 'a t -> 'a
+    val eval : 's t -> 's
     val discern : 'a t -> int
   end
 #                                     module List :
   sig
     type zero
-    type 'a t = Nil : zero t | Cons : 'a * 'b t -> ('a * 'b) t
+    type _ t = Nil : zero t | Cons : 'a * 'b t -> ('a * 'b) t
     val head : ('a * 'b) t -> 'a
     val tail : ('a * 'b) t -> 'b t
     val length : 'a t -> int
@@ -35,17 +35,17 @@ module Nonexhaustive :
   sig
     type 'a u = C1 : int -> int u | C2 : bool -> bool u
     type 'a v = C1 : int -> int v
-    val unexhaustive : 'a u -> 'a
+    val unexhaustive : 's u -> 's
     module M : sig type t type u end
     type 'a t = Foo : M.t -> M.t t | Bar : M.u -> M.u t
-    val same_type : 'a t * 'a t -> bool
+    val same_type : 's t * 's t -> bool
   end
 #                             module Exhaustive :
   sig
     type t = int
     type u = bool
     type 'a v = Foo : t -> t v | Bar : u -> u v
-    val same_type : 'a v * 'a v -> bool
+    val same_type : 's v * 's v -> bool
   end
 #               Characters 119-120:
       let eval (D x) = x
@@ -69,15 +69,15 @@ Error: This pattern matches values of type ([? `A ] as 'a) * bool t
        but a pattern was expected which matches values of type 'a * int t
 #                                 module Propagation :
   sig
-    type 'a t = IntLit : int -> int t | BoolLit : bool -> bool t
-    val check : 'a t -> 'a
+    type _ t = IntLit : int -> int t | BoolLit : bool -> bool t
+    val check : 's t -> 's
   end
 #             Characters 87-88:
     let f = function A -> 1 | B -> 2
                               ^
 Error: This pattern matches values of type b
        but a pattern was expected which matches values of type a
-#   type 'a t = Int : int t
+#   type _ t = Int : int t
 #   val ky : 'a -> 'a -> 'a = <fun>
 #       val test : 'a t -> 'a = <fun>
 #       val test : 'a t -> int = <fun>
@@ -139,11 +139,11 @@ Error: This expression has type a = int
        This instance of int is ambiguous:
        it would escape the scope of its equation
 #           val f : 'a t -> int -> int = <fun>
-#                     type 'a h = Has_m : < m : int > h | Has_b : < b : bool > h
+#                     type _ h = Has_m : < m : int > h | Has_b : < b : bool > h
 val f : 'a h -> 'a = <fun>
-#               type 'a j = Has_A : [ `A of int ] j | Has_B : [ `B of bool ] j
+#               type _ j = Has_A : [ `A of int ] j | Has_B : [ `B of bool ] j
 val f : 'a j -> 'a = <fun>
-#   type ('a, 'b) eq = Eq : ('a, 'a) eq
+#   type (_, _) eq = Eq : ('a, 'a) eq
 #       Characters 5-91:
   ....f : type a b. (a,b) eq -> (<m : a; ..> as 'a) -> (<m : b; ..> as 'a) =
     fun Eq o -> o
@@ -199,8 +199,8 @@ Error: This expression has type [> `A of a ]
   ....f : type a b. (a,b) eq -> [< `A of a | `B] -> [< `A of b | `B] =
     fun Eq o -> o..............
 Error: This definition has type
-         ('c, 'd) eq -> ([< `A of 'd & 'c | `B ] as 'e) -> 'e
-       which is less general than 'a 'b. ('a, 'b) eq -> 'e -> 'e
+         ('a, 'b) eq -> ([< `A of 'b & 'a | `B ] as 'c) -> 'c
+       which is less general than 'a0 'b0. ('a0, 'b0) eq -> 'c -> 'c
 #     val f : ('a, 'b) eq -> [ `A of 'a | `B ] -> [ `A of 'b | `B ] = <fun>
 #       val f : ('a, int) eq -> [ `A of 'a ] -> bool = <fun>
 #           val f : ('a, 'b) eq -> [ `A of 'a | `B ] -> [ `A of 'b | `B ] = <fun>
@@ -213,7 +213,7 @@ Error: This expression has type [> `A of a | `B ]
        This instance of a is ambiguous:
        it would escape the scope of its equation
 #                                                     type 'a t = A of int | B of bool | C of float | D of 'a
-type 'a ty =
+type _ ty =
     TE : 'a ty -> 'a array ty
   | TA : int ty
   | TB : bool ty
@@ -263,11 +263,11 @@ Error: This expression has type (a, a) eq
        but an expression was expected of type (a, b) eq
 #       val f : ('a M.t * 'a, 'b M.t * 'b) eq -> ('a, 'b) eq = <fun>
 #       val f : ('a * 'a M.t, 'b * 'b M.t) eq -> ('a, 'b) eq = <fun>
-#                     type 'a t = V1 : [ `A | `B ] t | V2 : [ `C | `D ] t
+#                     type _ t = V1 : [ `A | `B ] t | V2 : [ `C | `D ] t
 val f : 'a t -> 'a = <fun>
 #   - : [ `A | `B ] = `A
-#                 type 'a int_foo = IF_constr : < foo : int; .. > int_foo
-type 'a int_bar = IB_constr : < bar : int; .. > int_bar
+#                 type _ int_foo = IF_constr : < foo : int; .. > int_foo
+type _ int_bar = IB_constr : < bar : int; .. > int_bar
 #         Characters 98-99:
     (x:<foo:int>)
      ^
diff --git a/testsuite/tests/typing-gadts/yallop_bugs.ml.principal.reference b/testsuite/tests/typing-gadts/yallop_bugs.ml.principal.reference
index 5b1016c97c..ddae4d248e 100644
--- a/testsuite/tests/typing-gadts/yallop_bugs.ml.principal.reference
+++ b/testsuite/tests/typing-gadts/yallop_bugs.ml.principal.reference
@@ -15,8 +15,8 @@ Error: In this GADT definition, the variance of some parameter
 Warning 8: this pattern-matching is not exhaustive.
 Here is an example of a value that is not matched:
 (IntLit, 0)
-type 'a t = IntLit : int t | BoolLit : bool t
-val check : 'a t * 'a -> bool = <fun>
+type _ t = IntLit : int t | BoolLit : bool t
+val check : 's t * 's -> bool = <fun>
 #             Characters 91-180:
   .............................................function
     | {fst = BoolLit; snd = false} -> false
@@ -25,5 +25,5 @@ Warning 8: this pattern-matching is not exhaustive.
 Here is an example of a value that is not matched:
 {fst=IntLit; snd=0}
 type ('a, 'b) pair = { fst : 'a; snd : 'b; }
-val check : ('a t, 'a) pair -> bool = <fun>
+val check : ('s t, 's) pair -> bool = <fun>
 # 
diff --git a/testsuite/tests/typing-gadts/yallop_bugs.ml.reference b/testsuite/tests/typing-gadts/yallop_bugs.ml.reference
index 5b1016c97c..ddae4d248e 100644
--- a/testsuite/tests/typing-gadts/yallop_bugs.ml.reference
+++ b/testsuite/tests/typing-gadts/yallop_bugs.ml.reference
@@ -15,8 +15,8 @@ Error: In this GADT definition, the variance of some parameter
 Warning 8: this pattern-matching is not exhaustive.
 Here is an example of a value that is not matched:
 (IntLit, 0)
-type 'a t = IntLit : int t | BoolLit : bool t
-val check : 'a t * 'a -> bool = <fun>
+type _ t = IntLit : int t | BoolLit : bool t
+val check : 's t * 's -> bool = <fun>
 #             Characters 91-180:
   .............................................function
     | {fst = BoolLit; snd = false} -> false
@@ -25,5 +25,5 @@ Warning 8: this pattern-matching is not exhaustive.
 Here is an example of a value that is not matched:
 {fst=IntLit; snd=0}
 type ('a, 'b) pair = { fst : 'a; snd : 'b; }
-val check : ('a t, 'a) pair -> bool = <fun>
+val check : ('s t, 's) pair -> bool = <fun>
 # 
diff --git a/testsuite/tests/typing-objects/Tests.ml b/testsuite/tests/typing-objects/Tests.ml
index 19d20d8821..c7a5cb3d16 100644
--- a/testsuite/tests/typing-objects/Tests.ml
+++ b/testsuite/tests/typing-objects/Tests.ml
@@ -302,3 +302,26 @@ end;;
 let x = new d () in x#n, x#o;;
 
 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 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'');;
+
+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);;
+
+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);;
diff --git a/testsuite/tests/typing-objects/Tests.ml.reference b/testsuite/tests/typing-objects/Tests.ml.reference
index a78367fdfe..4df2316922 100644
--- a/testsuite/tests/typing-objects/Tests.ml.reference
+++ b/testsuite/tests/typing-objects/Tests.ml.reference
@@ -292,4 +292,10 @@ 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 = 15
+# - : int = 16
+# - : int = 17
+#         - : int * int * int = (18, 19, 20)
+#           - : int * int * int * int * int = (21, 22, 23, 33, 33)
+#           - : int * int * int * int * int = (24, 25, 26, 33, 33)
 # 
diff --git a/testsuite/tests/typing-poly/poly.ml.principal.reference b/testsuite/tests/typing-poly/poly.ml.principal.reference
index 65043c786e..b953491622 100644
--- a/testsuite/tests/typing-poly/poly.ml.principal.reference
+++ b/testsuite/tests/typing-poly/poly.ml.principal.reference
@@ -576,8 +576,8 @@ val g : 'a -> int = <fun>
 #     Characters 34-74:
     function Leaf _ -> 1 | Node x -> 1 + d x
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: This definition has type 'b t -> int which is less general than
-         'a. 'a t -> int
+Error: This definition has type 'a t -> int which is less general than
+         'a0. 'a0 t -> int
 #   Characters 34-78:
     function Leaf x -> x | Node x -> 1 + depth x;; (* fails *)
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
@@ -586,12 +586,12 @@ Error: This definition has type int t -> int which is less general than
 #   Characters 34-74:
     function Leaf x -> x | Node x -> depth x;; (* fails *)
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: This definition has type 'b t -> 'b which is less general than
-         'a. 'a t -> 'b
+Error: This definition has type 'a t -> 'a which is less general than
+         'a0. 'a0 t -> 'a
 #   Characters 38-78:
     function Leaf x -> x | Node x -> depth x;; (* fails *)
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: This definition has type 'c. 'c t -> 'c which is less general than
+Error: This definition has type 'b. 'b t -> 'b which is less general than
          'b 'a. 'a t -> 'b
 #   val r : 'a list * '_b list ref = ([], {contents = []})
 val q : unit -> 'a list * '_b list ref = <fun>
diff --git a/testsuite/tests/typing-poly/poly.ml.reference b/testsuite/tests/typing-poly/poly.ml.reference
index 37601416bb..71befc5820 100644
--- a/testsuite/tests/typing-poly/poly.ml.reference
+++ b/testsuite/tests/typing-poly/poly.ml.reference
@@ -539,8 +539,8 @@ val g : 'a -> int = <fun>
 #     Characters 34-74:
     function Leaf _ -> 1 | Node x -> 1 + d x
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: This definition has type 'b t -> int which is less general than
-         'a. 'a t -> int
+Error: This definition has type 'a t -> int which is less general than
+         'a0. 'a0 t -> int
 #   Characters 34-78:
     function Leaf x -> x | Node x -> 1 + depth x;; (* fails *)
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
@@ -549,12 +549,12 @@ Error: This definition has type int t -> int which is less general than
 #   Characters 34-74:
     function Leaf x -> x | Node x -> depth x;; (* fails *)
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: This definition has type 'b t -> 'b which is less general than
-         'a. 'a t -> 'b
+Error: This definition has type 'a t -> 'a which is less general than
+         'a0. 'a0 t -> 'a
 #   Characters 38-78:
     function Leaf x -> x | Node x -> depth x;; (* fails *)
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: This definition has type 'c. 'c t -> 'c which is less general than
+Error: This definition has type 'b. 'b t -> 'b which is less general than
          'b 'a. 'a t -> 'b
 #   val r : 'a list * '_b list ref = ([], {contents = []})
 val q : unit -> 'a list * '_b list ref = <fun>
diff --git a/testsuite/tests/typing-private-bugs/pr5469_ok.ml b/testsuite/tests/typing-private-bugs/pr5469_ok.ml
new file mode 100644
index 0000000000..74d355499c
--- /dev/null
+++ b/testsuite/tests/typing-private-bugs/pr5469_ok.ml
@@ -0,0 +1,7 @@
+module M (T:sig type t end)
+ = struct type t = private { t : T.t } end
+module P
+ = struct
+       module T = struct type t end
+       module R = M(T)
+ end
diff --git a/testsuite/tests/warnings/Makefile b/testsuite/tests/warnings/Makefile
index eca0a1ee7b..12d375e4a7 100644
--- a/testsuite/tests/warnings/Makefile
+++ b/testsuite/tests/warnings/Makefile
@@ -6,7 +6,7 @@ run-all:
 	@for file in *.ml; do \
 	  printf " ... testing '$$file':"; \
 	  $(OCAMLC) $(FLAGS) -o $(EXECNAME) $$file 2> `basename $$file ml`result; \
-	  diff -q `basename $$file ml`reference `basename $$file ml`result > /dev/null && echo " => passed" || echo " => failed"; \
+	  $(DIFF) `basename $$file ml`reference `basename $$file ml`result > /dev/null && echo " => passed" || echo " => failed"; \
 	done;
 
 promote: defaultpromote