309

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

26 files changed, 811 insertions, 493 deletions

diff --git a/test/KB/kbmain.ml b/test/KB/kbmain.ml
index 63ebf4b8f3..0a5da2fb63 100644
--- a/test/KB/kbmain.ml
+++ b/test/KB/kbmain.ml
@@ -77,5 +77,6 @@ let group_order = rpo group_precedence lex_ext
 let greater pair =
   match group_order pair with Greater -> true | _ -> false
 
-let _ = kb_complete greater [] geom_rules
+let _ =
+  for i = 1 to 20 do kb_complete greater [] geom_rules done
 
diff --git a/test/Makefile b/test/Makefile
index 395740d1a3..aa33d90eca 100644
--- a/test/Makefile
+++ b/test/Makefile
@@ -27,7 +27,7 @@ CODERUNPARAMS=OCAMLRUNPARAM='o=100'
 
 BYTE_EXE=fib.byt takc.byt taku.byt sieve.byt quicksort.byt quicksort.fast.byt \
   fft.byt fft.fast.byt soli.byt soli.fast.byt boyer.byt kb.byt \
-  nucleic.byt genlex.byt bdd.byt hamming.byt sorts.byt \
+  nucleic.byt bdd.byt hamming.byt sorts.byt \
   almabench.byt almabench.fast.byt
 
 CODE_EXE=$(BYTE_EXE:.byt=.out)
@@ -139,22 +139,14 @@ bytetest:
 	set -e; \
         for prog in $(BYTE_EXE:.byt=); do \
           echo $$prog; \
-          if test -f Results/$$prog.runtest; then \
-            sh Results/$$prog.runtest test $(CAMLRUN) $$prog.byt; \
-          else \
-            $(CAMLRUN) $$prog.byt | cmp - Results/$$prog.out; \
-          fi; \
+          $(CAMLRUN) $$prog.byt | cmp - Results/$$prog.out; \
         done
 
 codetest:
 	set -e; \
         for prog in $(CODE_EXE:.out=); do \
           echo $$prog; \
-          if test -f Results/$$prog.runtest; then \
-            sh Results/$$prog.runtest test ./$$prog.out; \
-          else \
-            ./$$prog.out | cmp - Results/$$prog.out; \
-          fi; \
+          ./$$prog.out | cmp - Results/$$prog.out; \
         done
 
 clean::
@@ -168,22 +160,14 @@ bytebench:
 	set -e; \
         for prog in $(BYTE_EXE:.byt=); do \
           echo "$$prog                " | cut -c 1-16 | tr -d '\012'; \
-          if test -f Results/$$prog.runtest; then \
-            sh Results/$$prog.runtest bench $(CAMLRUN) $$prog.byt; \
-          else \
-            xtime -o /dev/null -e /dev/null $(CAMLRUN) $$prog.byt; \
-          fi; \
+          xtime -mintime 5 -o /dev/null -e /dev/null $(CAMLRUN) $$prog.byt; \
         done
 
 codebench:
 	set -e; \
         for prog in $(CODE_EXE:.out=); do \
           echo "$$prog                " | cut -c 1-16 | tr -d '\012'; \
-          if test -f Results/$$prog.runtest; then \
-            $(CODERUNPARAMS) sh Results/$$prog.runtest bench ./$$prog.out; \
-          else \
-            $(CODERUNPARAMS) xtime -repeat 3 -o /dev/null -e /dev/null ./$$prog.out; \
-          fi; \
+          $(CODERUNPARAMS) xtime -mintime 5 -o /dev/null -e /dev/null ./$$prog.out; \
         done
 
 # Dependencies
diff --git a/test/Moretest/Makefile b/test/Moretest/Makefile
index e2b69441b0..c88ae58d5a 100644
--- a/test/Moretest/Makefile
+++ b/test/Moretest/Makefile
@@ -29,7 +29,7 @@ callback.out: callback.cmx callbackprim.o
 manyargs.byt: manyargs.cmo manyargsprim.o
 	$(CAMLC) -o manyargs.byt -custom manyargs.cmo manyargsprim.o
 manyargs.out: manyargs.cmx manyargsprim.o
-	$(CAMLOPT) -o manyargs.out manyargs.cmx manyargsprim.o
+	$(CAMLOPT) -inline 0 -o manyargs.out manyargs.cmx manyargsprim.o
 
 multdef.out: multdef.cmx usemultdef.cmx
 	$(CAMLOPT) -o multdef.out multdef.cmx usemultdef.cmx
@@ -117,9 +117,21 @@ tscanf.byt: tscanf.cmo
 tscanf.out: tscanf.cmx
 	${CAMLOPT} -o tscanf.out tscanf.cmx
 
-scanf: tscanf.byt tscanf.out
+tscanf2.byt: tscanf2_io.cmo tscanf2_slave.cmo tscanf2_master.cmo
+	${CAMLC} -o tscanf2_slave.byt tscanf2_io.cmo tscanf2_slave.cmo
+	${CAMLC} -o tscanf2_master.byt unix.cma \
+		tscanf2_io.cmo tscanf2_master.cmo
+
+tscanf2.out: tscanf2_io.cmx tscanf2_slave.cmx tscanf2_master.cmx
+	${CAMLOPT} -o tscanf2_slave.out tscanf2_io.cmx tscanf2_slave.cmx
+	${CAMLOPT} -o tscanf2_master.out unix.cmxa \
+		tscanf2_io.cmx tscanf2_master.cmx
+
+scanf: tscanf.byt tscanf.out tscanf2.byt tscanf2.out
 	./tscanf.byt
 	./tscanf.out
+	./tscanf2_master.byt ./tscanf2_slave.byt
+	./tscanf2_master.out ./tscanf2_slave.out
 
 regexp.byt: ../../otherlibs/str/str.cma regexp.ml
 	$(CAMLC) -custom -I ../../otherlibs/str -o regexp.byt str.cma regexp.ml
@@ -129,6 +141,12 @@ regexp.opt: ../../otherlibs/str/str.cmxa regexp.ml
 md5.out: md5.ml
 	$(CAMLOPT) -unsafe -inline 100 -o md5.out md5.ml
 
+recmod.byt: recmod.cmo
+	$(CAMLC) -o recmod.byt recmod.cmo
+
+recmod.out: recmod.cmx
+	$(CAMLOPT) -o recmod.out recmod.cmx
+
 # Common rules
 
 .SUFFIXES:
diff --git a/test/Moretest/boxedints.ml b/test/Moretest/boxedints.ml
index d5a1d5ba73..ed97513e75 100644
--- a/test/Moretest/boxedints.ml
+++ b/test/Moretest/boxedints.ml
@@ -159,10 +159,10 @@ struct
        3, -123, 1;
        4, 123, -1;
        5, -123, -1;
-       6, 1275312364, 365;
+       6, 127531236, 365;
        7, 16384, 256;
-       8, -1275312364, 365;
-       9, 1275312364, -365;
+       8, -127531236, 365;
+       9, 127531236, -365;
        10, 1234567, 12345678;
        11, 1234567, -12345678];
 
@@ -174,10 +174,10 @@ struct
        3, -123, 1;
        4, 123, -1;
        5, -123, -1;
-       6, 1275312364, 365;
+       6, 127531236, 365;
        7, 16384, 256;
-       8, -1275312364, 365;
-       9, 1275312364, -365;
+       8, -127531236, 365;
+       9, 127531236, -365;
        10, 1234567, 12345678;
        11, 1234567, -12345678];
 
@@ -391,10 +391,10 @@ struct
        3, -123, 1;
        4, 123, -1;
        5, -123, -1;
-       6, 1275312364, 365;
+       6, 127531236, 365;
        7, 16384, 256;
-       8, -1275312364, 365;
-       9, 1275312364, -365;
+       8, -127531236, 365;
+       9, 127531236, -365;
        10, 1234567, 12345678;
        11, 1234567, -12345678];
 
@@ -406,10 +406,10 @@ struct
        3, -123, 1;
        4, 123, -1;
        5, -123, -1;
-       6, 1275312364, 365;
+       6, 127531236, 365;
        7, 16384, 256;
-       8, -1275312364, 365;
-       9, 1275312364, -365;
+       8, -127531236, 365;
+       9, 127531236, -365;
        10, 1234567, 12345678;
        11, 1234567, -12345678];
 
@@ -538,6 +538,7 @@ let _ =
          (Nativeint.of_string "0x12345678");
   test 2 (Nativeint.to_int32 (Nativeint.of_string "0x12345678"))
          (Int32.of_string "0x12345678");
+  if Sys.word_size = 64 then
   test 3 (Nativeint.to_int32 (Nativeint.of_string "0x123456789ABCDEF0"))
          (Int32.of_string "0x9ABCDEF0");
   testing_function "int64 of/to int32";
@@ -553,11 +554,9 @@ let _ =
   test 2 (Int64.to_nativeint (Int64.of_string "-0x12345678"))
          (Nativeint.of_string "-0x12345678");
   test 3 (Int64.to_nativeint (Int64.of_string "0x123456789ABCDEF0"))
-         (Nativeint.of_string "0x123456789ABCDEF0");
-  test 4 (Int64.of_nativeint (Nativeint.of_string "0x9ABCDEF012345678"))
          (if Sys.word_size = 64
-          then Int64.of_string "0x9ABCDEF012345678"
-          else Int64.of_string "0x12345678")
+          then Nativeint.of_string "0x123456789ABCDEF0"
+          else Nativeint.of_string "0x9ABCDEF0")
 
 (********* End of test *********)
 
diff --git a/test/Moretest/manyargs.ml b/test/Moretest/manyargs.ml
index 0a1271ae0d..70c8662cf3 100644
--- a/test/Moretest/manyargs.ml
+++ b/test/Moretest/manyargs.ml
@@ -1,4 +1,4 @@
-let manyargs a b c d e f g h i j k =
+let manyargs a b c d e f g h i j k l m n o =
   print_string "a = "; print_int a; print_newline();
   print_string "b = "; print_int b; print_newline();
   print_string "c = "; print_int c; print_newline();
@@ -9,10 +9,34 @@ let manyargs a b c d e f g h i j k =
   print_string "h = "; print_int h; print_newline();
   print_string "i = "; print_int i; print_newline();
   print_string "j = "; print_int j; print_newline();
-  print_string "k = "; print_int k; print_newline()
+  print_string "k = "; print_int k; print_newline();
+  print_string "l = "; print_int l; print_newline();
+  print_string "m = "; print_int m; print_newline();
+  print_string "n = "; print_int n; print_newline();
+  print_string "o = "; print_int o; print_newline();
+  print_string "---"; print_newline()
 
-let _ = manyargs 1 2 3 4 5 6 7 8 9 10 11
+let manyargs_tail1 a b c d e f g h i j k l m n o =
+  print_string "tail1:\n";
+  manyargs a b c d e f g h i j k l m n o
+
+let manyargs_tail2 a b =
+  print_string "tail2:\n";
+  manyargs a b a b a b a b a b a b a b a
+
+let manyargs_tail3 a b c d e f g h i j k l m n o =
+  print_string "tail3:\n";
+  print_string "o = "; print_int o; print_newline();
+  print_string "---"; print_newline()
+
+let _ =
+  manyargs 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15;
+  manyargs_tail1 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15;
+  manyargs_tail2 0 1;
+  manyargs_tail3 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
 
 external manyargs_ext: int -> int -> int -> int -> int -> int -> int -> int -> int -> int -> int -> int = "manyargs_argv" "manyargs"
 
-let _ = manyargs_ext 1 2 3 4 5 6 7 8 9 10 11
+let _ =
+  print_string "external:\n"; flush stdout;
+  manyargs_ext 1 2 3 4 5 6 7 8 9 10 11
diff --git a/test/Moretest/signals.ml b/test/Moretest/signals.ml
index 5451d8e5ba..ce93a27e20 100644
--- a/test/Moretest/signals.ml
+++ b/test/Moretest/signals.ml
@@ -17,7 +17,7 @@ let _ =
   Sys.signal Sys.sigtstp (Sys.Signal_handle stop_handler);
   begin try
     print_string "Computing like crazy..."; print_newline();
-    for i = 1 to 100 do tak(18,12,6) done;
+    for i = 1 to 1000 do tak(18,12,6) done;
     print_string "Reading on input..."; print_newline();
     for i = 1 to 5 do
       try
diff --git a/test/Moretest/tscanf.ml b/test/Moretest/tscanf.ml
index a996c7ede6..cd66076c0c 100644
--- a/test/Moretest/tscanf.ml
+++ b/test/Moretest/tscanf.ml
@@ -18,8 +18,8 @@ let print_test_number () =
   print_int !test_num; print_string " "; flush stdout;;
 
 let next_test () =
- incr test_num;
- print_test_number ();;
+  incr test_num;
+  print_test_number ();;
 
 let print_test_fail () =
   all_tests_ok := false;
@@ -42,20 +42,20 @@ let print_failure_test_succeed () =
     !test_num);;
 
 let test b =
- next_test ();
- if not b then print_test_fail ();;
+  next_test ();
+  if not b then print_test_fail ();;
 
 (* Applies f to x and checks that the evaluation indeed
    raises an exception that verifies the predicate [pred]. *)
 let test_raises_exc_p pred f x =
- next_test ();
- try
-   let b = f x in
-   print_failure_test_succeed ();
-   false
- with
- | x ->
-   pred x || (print_failure_test_fail (); false);;
+  next_test ();
+  try
+    ignore (f x);
+    print_failure_test_succeed ();
+    false
+  with
+  | x ->
+    pred x || (print_failure_test_fail (); false);;
 
 (* Applies f to x and checks that the evaluation indeed
    raises some exception. *)
@@ -80,41 +80,41 @@ let scan_failure_test f x =
   test_raises_exc_p (function Scan_failure _ -> true | _ -> false) f x;;
 
 (* The ``continuation'' that returns the scanned value. *)
-let void x = x;;
+let id x = x;;
 
 (* Testing space scanning. *)
 let test0 () =
- (sscanf "" "" void) 1 +
- (sscanf "" " " void) 2 +
- (sscanf " " " " void) 3 +
- (sscanf "\t" " " void) 4 +
- (sscanf "\n" " " void) 5 +
- (sscanf "\n\t 6" " %d" void)
-;;
+  (sscanf "" "" id) 1 +
+  (sscanf "" " " id) 2 +
+  (sscanf " " " " id) 3 +
+  (sscanf "\t" " " id) 4 +
+  (sscanf "\n" " " id) 5 +
+  (sscanf "\n\t 6" " %d" id);;
+
 test (test0 () = 21);;
 
 (* Testing integer scanning %i and %d. *)
 let test1 () =
- sscanf "1" "%d" void +
- sscanf " 2" " %d" void +
- sscanf " -2" " %d" void +
- sscanf " +2" " %d" void +
- sscanf " 2a " " %da" void;;
+  sscanf "1" "%d" id +
+  sscanf " 2" " %d" id +
+  sscanf " -2" " %d" id +
+  sscanf " +2" " %d" id +
+  sscanf " 2a " " %da" id;;
 
 test (test1 () = 5);;
 
 let test2 () =
- sscanf "123" "%2i" void +
- sscanf "245" "%d" void +
- sscanf " 2a " " %1da" void;;
+  sscanf "123" "%2i" id +
+  sscanf "245" "%d" id +
+  sscanf " 2a " " %1da" id;;
 
 test (test2 () = 259);;
 
 let test3 () =
- sscanf "0xff" "%3i" void +
- sscanf "0XEF" "%3i" void +
- sscanf "x=-245" " x = %d" void +
- sscanf " 2a " " %1da" void;;
+  sscanf "0xff" "%3i" id +
+  sscanf "0XEF" "%3i" id +
+  sscanf "x=-245" " x = %d" id +
+  sscanf " 2a " " %1da" id;;
 
 test (test3 () = -214);;
 
@@ -168,8 +168,9 @@ let test5 () =
 
 (* g style. *)
   bscanf (Scanning.from_string "1 1.1 0e+1 1.3e-1")
-    "%g %g %g %g" (fun b1 b2 b3 b4 ->
-                     b1 = 1.0 && b2 = 1.1 && b3 = 0.0 && b4 = 0.13);;
+    "%g %g %g %g"
+    (fun b1 b2 b3 b4 ->
+     b1 = 1.0 && b2 = 1.1 && b3 = 0.0 && b4 = 0.13);;
 
 test (test5 ());;
 
@@ -207,7 +208,7 @@ test (test7 ());;
 let verify_read c =
   let s = Printf.sprintf "%C" c in
   let ib = Scanning.from_string s in
-  assert (bscanf ib "%C" void = c);;
+  assert (bscanf ib "%C" id = c);;
 
 let verify_scan_Chars () =
   for i = 0 to 255 do verify_read (char_of_int i) done;;
@@ -221,7 +222,7 @@ test (test8 ());;
 (* %S and %s styles. *)
 let unit fmt s =
   let ib = Scanning.from_string (Printf.sprintf "%S" s) in
-  Scanf.bscanf ib fmt void;;
+  Scanf.bscanf ib fmt id;;
 
 let test_fmt fmt s = unit fmt s = s;;
 
@@ -240,54 +241,52 @@ let test9 () =
           \\\n\
           b \\\n\
           c\010\\\n\
-          b"
-;;
+          b";;
+
 test (test9 ());;
 
 let test10 () =
-  let res = sscanf "Une chaîne: \"celle-ci\" et \"celle-là\"!"
-               "%s %s %S %s %S %s"
-               (fun s1 s2 s3 s4 s5 s6 -> s1 ^ s2 ^ s3 ^ s4 ^ s5 ^ s6) in
+  let res =
+    sscanf "Une chaîne: \"celle-ci\" et \"celle-là\"!"
+           "%s %s %S %s %S %s"
+           (fun s1 s2 s3 s4 s5 s6 -> s1 ^ s2 ^ s3 ^ s4 ^ s5 ^ s6) in
   res = "Unechaîne:celle-cietcelle-là!";;
 
 test (test10 ());;
 
 (* %[] style *)
 let test11 () =
- sscanf "Pierre	Weis	70" "%s %s %s"
-  (fun prenom nom poids ->
+  sscanf "Pierre	Weis	70" "%s %s %s"
+    (fun prenom nom poids ->
      prenom = "Pierre" && nom = "Weis" && int_of_string poids = 70)
- &&
- sscanf "Jean-Luc	de Léage	68" "%[^	] %[^	] %d"
-  (fun prenom nom poids ->
+  &&
+  sscanf "Jean-Luc	de Léage	68" "%[^	] %[^	] %d"
+    (fun prenom nom poids ->
      prenom = "Jean-Luc" && nom = "de Léage" && poids = 68)
- &&
- sscanf "Daniel	de Rauglaudre	66" "%s@\t %s@\t %d"
-  (fun prenom nom poids ->
-     prenom = "Daniel" && nom = "de Rauglaudre" && poids = 66)
-;;
+  &&
+  sscanf "Daniel	de Rauglaudre	66" "%s@\t %s@\t %d"
+    (fun prenom nom poids ->
+     prenom = "Daniel" && nom = "de Rauglaudre" && poids = 66);;
 
 (* Empty string (end of input) testing. *)
 let test110 () =
- sscanf "" " " (fun x -> x) "" = "" &&
- sscanf "" "%s" (fun x -> x = "") &&
- sscanf "" "%s%s" (fun x y -> x = "" && y = "") &&
- sscanf "" "%s " (fun x -> x = "") &&
- sscanf "" " %s" (fun x -> x = "") &&
- sscanf "" " %s " (fun x -> x = "") &&
- sscanf "" "%[^\n]" (fun x -> x = "") &&
- sscanf "" "%[^\n] " (fun x -> x = "") &&
- sscanf " " "%s" (fun x -> x = "") &&
- sscanf " " "%s%s" (fun x y -> x = "" && y = "") &&
- sscanf " " " %s " (fun x -> x = "") &&
- sscanf " " " %s %s" (fun x y -> x = "" && x = y) &&
- sscanf " " " %s@ %s" (fun x y -> x = "" && x = y) &&
- sscanf " poi !" " %s@ %s@." (fun x y -> x = "" && y = "poi!") &&
- sscanf " poi !" " %s@ %s@." (fun x y -> x = "poi" && y = "!") &&
- sscanf " poi !" "%s@ %s@." (fun x y -> x = "" && y = "poi !");;
-
-let test111 () =
- sscanf "" "%[^\n]@\n" (fun s -> s = "");;
+  sscanf "" " " (fun x -> x) "" = "" &&
+  sscanf "" "%s" (fun x -> x = "") &&
+  sscanf "" "%s%s" (fun x y -> x = "" && y = "") &&
+  sscanf "" "%s " (fun x -> x = "") &&
+  sscanf "" " %s" (fun x -> x = "") &&
+  sscanf "" " %s " (fun x -> x = "") &&
+  sscanf "" "%[^\n]" (fun x -> x = "") &&
+  sscanf "" "%[^\n] " (fun x -> x = "") &&
+  sscanf " " "%s" (fun x -> x = "") &&
+  sscanf " " "%s%s" (fun x y -> x = "" && y = "") &&
+  sscanf " " " %s " (fun x -> x = "") &&
+  sscanf " " " %s %s" (fun x y -> x = "" && x = y) &&
+  sscanf " " " %s@ %s" (fun x y -> x = "" && x = y) &&
+  sscanf " poi !" " %s@ %s@." (fun x y -> x = "poi" && y = "!") &&
+  sscanf " poi !" "%s@ %s@." (fun x y -> x = "" && y = "poi !");;
+
+let test111 () = sscanf "" "%[^\n]@\n" (fun x -> x = "");;
 
 test (test11 () && test110 () && test111 ());;
 
@@ -296,13 +295,13 @@ let ib () = Scanning.from_string "[1;2;3;4; ]";;
 
 (* Statically known lists can be scanned directly. *)
 let f ib =
- bscanf ib " [" ();
- bscanf ib " %i ;" (fun i ->
- bscanf ib " %i ;" (fun j ->
- bscanf ib " %i ;" (fun k ->
- bscanf ib " %i ;" (fun l ->
- bscanf ib " ]" ();
- [i; j; k; l]))));;
+  bscanf ib " [" ();
+  bscanf ib " %i ;" (fun i ->
+  bscanf ib " %i ;" (fun j ->
+  bscanf ib " %i ;" (fun k ->
+  bscanf ib " %i ;" (fun l ->
+  bscanf ib " ]" ();
+  [i; j; k; l]))));;
 
 let test12 () = f (ib ()) = [1; 2; 3; 4];;
 
@@ -310,8 +309,8 @@ test (test12 ());;
 
 (* A general list scanner that always fails to succeed. *)
 let rec scan_elems ib accu =
- try bscanf ib " %i ;" (fun i -> scan_elems ib (i :: accu))
- with _ -> accu;;
+  try bscanf ib " %i ;" (fun i -> scan_elems ib (i :: accu)) with
+  | _ -> accu;;
 
 let g ib = bscanf ib "[ " (); List.rev (scan_elems ib []);;
 
@@ -321,10 +320,10 @@ test (test13 ());;
 
 (* A general int list scanner. *)
 let rec scan_int_list ib =
- bscanf ib "[ " ();
- let accu = scan_elems ib [] in
- bscanf ib " ]" ();
- List.rev accu;;
+  bscanf ib "[ " ();
+  let accu = scan_elems ib [] in
+  bscanf ib " ]" ();
+   List.rev accu;;
 
 let test14 () = scan_int_list (ib ()) = [1; 2; 3; 4];;
 
@@ -333,14 +332,14 @@ test (test14 ());;
 (* A general list scanner that always succeeds. *)
 let rec scan_elems ib accu =
   bscanf ib " %i %c"
-   (fun i -> function
-    | ';' -> scan_elems ib (i :: accu)
-    | ']' -> List.rev (i :: accu)
-    | c -> failwith "scan_elems");;
+    (fun i -> function
+     | ';' -> scan_elems ib (i :: accu)
+     | ']' -> List.rev (i :: accu)
+     | c -> failwith "scan_elems");;
 
 let rec scan_int_list ib =
- bscanf ib "[ " ();
- scan_elems ib [];;
+  bscanf ib "[ " ();
+  scan_elems ib [];;
 
 let test15 () =
   scan_int_list (Scanning.from_string "[1;2;3;4]") = [1; 2; 3; 4];;
@@ -350,12 +349,12 @@ test (test15 ());;
 let rec scan_elems ib accu =
   try
   bscanf ib "%c %i"
-   (fun c i ->
-    match c with
-    | ';' -> scan_elems ib (i :: accu)
-    | ']' -> List.rev (i :: accu)
-    | '[' when accu = [] -> scan_elems ib (i :: accu)
-    | c -> prerr_endline (String.make 1 c); failwith "scan_elems")
+    (fun c i ->
+     match c with
+     | ';' -> scan_elems ib (i :: accu)
+     | ']' -> List.rev (i :: accu)
+     | '[' when accu = [] -> scan_elems ib (i :: accu)
+     | c -> prerr_endline (String.make 1 c); failwith "scan_elems")
   with
   | Scan_failure _ -> bscanf ib "]" (); accu
   | End_of_file -> accu;;
@@ -367,29 +366,27 @@ let test16 () =
   scan_int_list (Scanning.from_string "[1;2;3;4]") = List.rev [1;2;3;4] &&
   scan_int_list (Scanning.from_string "[1;2;3;4; ]") = List.rev [1;2;3;4] &&
   (* Should fail but succeeds! *)
-  scan_int_list (Scanning.from_string "[1;2;3;4") = List.rev [1;2;3;4]
-;;
+  scan_int_list (Scanning.from_string "[1;2;3;4") = List.rev [1;2;3;4];;
 
 test (test16 ());;
 
 let rec scan_elems ib accu =
   bscanf ib " %i%[]; \t\n\r]"
-   (fun i s ->
-    match s with
-    | ";" -> scan_elems ib (i :: accu)
-    | "]" -> List.rev (i :: accu)
-    | s -> List.rev (i :: accu));;
+    (fun i s ->
+     match s with
+     | ";" -> scan_elems ib (i :: accu)
+     | "]" -> List.rev (i :: accu)
+     | s -> List.rev (i :: accu));;
 
 let scan_int_list ib =
- bscanf ib " [" ();
- scan_elems ib [];;
+  bscanf ib " [" ();
+  scan_elems ib [];;
 
 let test17 () =
   scan_int_list (Scanning.from_string "[1;2;3;4]") = [1;2;3;4] &&
   scan_int_list (Scanning.from_string "[1;2;3;4; ]") = [1;2;3;4] &&
   (* Should fail but succeeds! *)
-  scan_int_list (Scanning.from_string "[1;2;3;4 5]") = [1;2;3;4]
-;;
+  scan_int_list (Scanning.from_string "[1;2;3;4 5]") = [1;2;3;4];;
 
 test (test17 ());;
 
@@ -399,13 +396,13 @@ let rec scan_elems ib accu =
     | '[' when accu = [] ->
         (* begginning of list: could find either
            - an int, if the list is not empty,
-           - the char ], if the list is empt *)
+           - the char ], if the list is empty. *)
         bscanf ib "%[]]"
-         (function
-          | "]" -> accu
-          | _ ->
-           bscanf ib " %i " (fun i ->
-            scan_rest ib (i :: accu)))
+          (function
+           | "]" -> accu
+           | _ ->
+             bscanf ib " %i " (fun i ->
+               scan_rest ib (i :: accu)))
     | _ -> failwith "scan_elems")
 
 and scan_rest ib accu =
@@ -413,44 +410,42 @@ and scan_rest ib accu =
     match c with
     | ';' ->
         bscanf ib "%[]]"
-         (function
-          | "]" -> accu
-          | _ ->
-            bscanf ib " %i " (fun i ->
-            scan_rest ib (i :: accu)))
+          (function
+           | "]" -> accu
+           | _ ->
+             bscanf ib " %i " (fun i ->
+             scan_rest ib (i :: accu)))
     | ']' -> accu
     | _ -> failwith "scan_rest");;
 
-
 let scan_int_list ib = List.rev (scan_elems ib []);;
 
 let test18 () =
   scan_int_list (Scanning.from_string "[]") = [] &&
   scan_int_list (Scanning.from_string "[ ]") = [] &&
   scan_int_list (Scanning.from_string "[1;2;3;4]") = [1;2;3;4] &&
-  scan_int_list (Scanning.from_string "[1;2;3;4; ]") = [1;2;3;4]
-;;
+  scan_int_list (Scanning.from_string "[1;2;3;4; ]") = [1;2;3;4];;
 
 test (test18 ());;
 
 (* Those properly fail *)
 
 let test19 () =
- failure_test
-   scan_int_list (Scanning.from_string "[1;2;3;4 5]")
-   "scan_rest";;
+  failure_test
+    scan_int_list (Scanning.from_string "[1;2;3;4 5]")
+    "scan_rest";;
 
 (test19 ());;
 
 let test20 () =
   scan_failure_test 
-   scan_int_list (Scanning.from_string "[1;2;3;4; ; 5]");;
+    scan_int_list (Scanning.from_string "[1;2;3;4; ; 5]");;
 
 (test20 ());;
 
 let test21 () =
- scan_failure_test
-   scan_int_list (Scanning.from_string "[1;2;3;4;;");;
+  scan_failure_test
+    scan_int_list (Scanning.from_string "[1;2;3;4;;");;
 
 (test21 ());;
 
@@ -459,22 +454,22 @@ let rec scan_elems ib accu =
   | "]" -> accu
   | ";" -> scan_rest ib accu
   | _ ->
-     failwith
+    failwith
       (Printf.sprintf "scan_int_list" (*
         "scan_int_list: char %i waiting for ']' or ';' but found %c"
         (Scanning.char_count ib) (Scanning.peek_char ib)*)))
 
 and scan_rest ib accu =
- bscanf ib "%[]]" (function
- | "]" -> accu
- | _ -> scan_elem ib accu)
+  bscanf ib "%[]]" (function
+  | "]" -> accu
+  | _ -> scan_elem ib accu)
 
 and scan_elem ib accu =
   bscanf ib " %i " (fun i -> scan_elems ib (i :: accu));;
 
 let scan_int_list ib =
- bscanf ib " [ " ();
- List.rev (scan_rest ib []);;
+  bscanf ib " [ " ();
+  List.rev (scan_rest ib []);;
 
 let test22 () =
   scan_int_list (Scanning.from_string "[]") = [] &&
@@ -495,29 +490,29 @@ scan_int_list (Scanning.from_string "[1;2;3;4;; 23]");;
 *)
 
 let rec scan_elems ib accu =
- try bscanf ib " %i %1[;]" (fun i s ->
-  if s = "" then i :: accu else scan_elems ib (i :: accu))
- with Scan_failure _ -> accu;;
+  try bscanf ib " %i %1[;]" (fun i s ->
+   if s = "" then i :: accu else scan_elems ib (i :: accu)) with
+  | Scan_failure _ -> accu;;
 
 (* The general int list scanner. *)
 let rec scan_int_list ib =
- bscanf ib "[ " ();
- let accu = scan_elems ib [] in
- bscanf ib " ]" ();
- List.rev accu;;
+  bscanf ib "[ " ();
+  let accu = scan_elems ib [] in
+  bscanf ib " ]" ();
+  List.rev accu;;
 
 (* The general HO list scanner. *)
 let rec scan_elems ib scan_elem accu =
- try scan_elem ib (fun i s ->
-  let accu = i :: accu in
-  if s = "" then accu else scan_elems ib scan_elem accu)
- with Scan_failure _ -> accu;;
+  try scan_elem ib (fun i s ->
+    let accu = i :: accu in
+    if s = "" then accu else scan_elems ib scan_elem accu) with
+  | Scan_failure _ -> accu;;
 
 let scan_list scan_elem ib =
- bscanf ib "[ " ();
- let accu = scan_elems ib scan_elem [] in
- bscanf ib " ]" ();
- List.rev accu;;
+  bscanf ib "[ " ();
+  let accu = scan_elems ib scan_elem [] in
+  bscanf ib " ]" ();
+  List.rev accu;;
 
 (* Deriving particular list scanners from the HO list scanner. *)
 let scan_int_elem ib = bscanf ib " %i %1[;]";;
@@ -528,8 +523,7 @@ let test23 () =
   scan_int_list (Scanning.from_string "[ ]") = [] &&
   scan_int_list (Scanning.from_string "[1]") = [1] &&
   scan_int_list (Scanning.from_string "[1;2;3;4]") = [1;2;3;4] &&
-  scan_int_list (Scanning.from_string "[1;2;3;4;]") = [1;2;3;4]
-;;
+  scan_int_list (Scanning.from_string "[1;2;3;4;]") = [1;2;3;4];;
 
 test (test23 ());;
 
@@ -574,24 +568,23 @@ let test28 () =
     ["Le"; "langage"; "Objective"; "Caml"] &&
   scan_String_list
     (Scanning.from_string "[\"Le\";\"langage\";\"Objective\";\"Caml\"; ]") =
-    ["Le"; "langage"; "Objective"; "Caml"]
-;;
+    ["Le"; "langage"; "Objective"; "Caml"];;
 
 test (test28 ());;
 
 (* The general HO list scanner with continuations. *)
 let rec scan_elems ib scan_elem accu =
- scan_elem ib
-  (fun i s ->
+  scan_elem ib
+    (fun i s ->
      let accu = i :: accu in
      if s = "" then accu else scan_elems ib scan_elem accu)
-  (fun ib exc -> accu);;
+    (fun ib exc -> accu);;
 
 let scan_list scan_elem ib =
- bscanf ib "[ " ();
- let accu = scan_elems ib scan_elem [] in
- bscanf ib " ]" ();
- List.rev accu;;
+  bscanf ib "[ " ();
+  let accu = scan_elems ib scan_elem [] in
+  bscanf ib " ]" ();
+  List.rev accu;;
 
 (* Deriving particular list scanners from the HO list scanner. *)
 let scan_int_elem ib f ek = kscanf ib ek " %i %1[;]" f;;
@@ -602,8 +595,7 @@ let test29 () =
   scan_int_list (Scanning.from_string "[ ]") = [] &&
   scan_int_list (Scanning.from_string "[1]") = [1] &&
   scan_int_list (Scanning.from_string "[1;2;3;4]") = [1;2;3;4] &&
-  scan_int_list (Scanning.from_string "[1;2;3;4;]") = [1;2;3;4]
-;;
+  scan_int_list (Scanning.from_string "[1;2;3;4;]") = [1;2;3;4];;
 
 test (test29 ());;
 
@@ -619,8 +611,7 @@ let test30 () =
     ["1"; "2"; "3"; "4"] &&
   scan_string_list
     (Scanning.from_string "[\"1\"; \"2\"; \"3\"; \"4\";]") =
-    ["1"; "2"; "3"; "4"]
-;;
+    ["1"; "2"; "3"; "4"];;
 
 test (test30 ());;
 
@@ -635,8 +626,8 @@ let scan_char_list = scan_list (scan_elem " %C %1[;]");;
 let scan_float_list = scan_list (scan_elem " %f %1[;]");;
 
 let rec scan_elems ib scan_elem accu =
- scan_elem ib
-  (fun i ->
+  scan_elem ib
+    (fun i ->
      let accu = i :: accu in
      kscanf ib
       (fun ib exc -> accu)
@@ -645,10 +636,10 @@ let rec scan_elems ib scan_elem accu =
   (fun ib exc -> accu);;
 
 let scan_list scan_elem ib =
- bscanf ib "[ " ();
- let accu = scan_elems ib scan_elem [] in
- bscanf ib " ]" ();
- List.rev accu;;
+  bscanf ib "[ " ();
+  let accu = scan_elems ib scan_elem [] in
+  bscanf ib " ]" ();
+  List.rev accu;;
 
 let scan_int_list = scan_list (scan_elem " %i");;
 let scan_string_list = scan_list (scan_elem " %S");;
@@ -661,8 +652,7 @@ let test31 () =
   scan_int_list (Scanning.from_string "[ ]") = [] &&
   scan_int_list (Scanning.from_string "[1]") = [1] &&
   scan_int_list (Scanning.from_string "[1;2;3;4]") = [1;2;3;4] &&
-  scan_int_list (Scanning.from_string "[1;2;3;4;]") = [1;2;3;4]
-;;
+  scan_int_list (Scanning.from_string "[1;2;3;4;]") = [1;2;3;4];;
 
 test (test31 ());;
 
@@ -675,28 +665,30 @@ let test32 () =
     ["1"; "2"; "3"; "4"] &&
   scan_string_list
     (Scanning.from_string "[\"1\"; \"2\"; \"3\"; \"4\";]") =
-    ["1"; "2"; "3"; "4"]
-;;
+    ["1"; "2"; "3"; "4"];;
 
 test (test32 ());;
 
-(* Using kscanf only. *)
-let rec scan_elems ib scan_elem accu =
+(* Using kscanf only.
+   Using formats as ``functional'' specifications to scan elements of
+   lists. *)
+let rec scan_elems ib scan_elem_fmt accu =
   kscanf ib (fun ib exc -> accu)
-   scan_elem
-   (fun i ->
-      let accu = i :: accu in
-      kscanf ib (fun ib exc -> accu)
+    scan_elem_fmt
+    (fun i ->
+     let accu = i :: accu in
+     kscanf ib (fun ib exc -> accu)
        " %1[;] "
-       (fun s -> if s = "" then accu else scan_elems ib scan_elem accu))
-;;
+       (function
+        | "" -> accu
+        | _ -> scan_elems ib scan_elem_fmt accu)
+    );;
 
-let scan_list scan_elem ib =
+let scan_list scan_elem_fmt ib =
   bscanf ib "[ " ();
-  let accu = scan_elems ib scan_elem [] in
+  let accu = scan_elems ib scan_elem_fmt [] in
   bscanf ib " ]" ();
-  List.rev accu
-;;
+  List.rev accu;;
 
 let scan_int_list = scan_list "%i";;
 let scan_string_list = scan_list "%S";;
@@ -709,8 +701,7 @@ let test33 () =
   scan_int_list (Scanning.from_string "[ ]") = [] &&
   scan_int_list (Scanning.from_string "[ 1 ]") = [1] &&
   scan_int_list (Scanning.from_string "[ 1 ; 2 ; 3 ; 4 ]") = [1; 2; 3; 4] &&
-  scan_int_list (Scanning.from_string "[1 ;2 ;3 ;4;]") = [1; 2; 3; 4]
-;;
+  scan_int_list (Scanning.from_string "[1 ;2 ;3 ;4;]") = [1; 2; 3; 4];;
 
 test (test33 ());;
 
@@ -723,8 +714,58 @@ let test34 () =
     ["1"; "2"; "3"; "4"] &&
   scan_string_list
     (Scanning.from_string "[\"1\"; \"2\"; \"3\"; \"4\";]") =
-    ["1"; "2"; "3"; "4"]
-;;
+    ["1"; "2"; "3"; "4"];;
+
+(* Using kscanf only.
+   Using functions to scan elements of lists. *)
+let rec scan_elems ib scan_elem accu =
+  scan_elem ib
+    (fun elem ->
+     let accu = elem :: accu in
+     kscanf ib (fun ib exc -> accu)
+       " %1[;] "
+       (function
+        | "" -> accu
+        | _ -> scan_elems ib scan_elem accu));;
+
+let scan_list scan_elem ib =
+  bscanf ib "[ " ();
+  let accu = scan_elems ib scan_elem [] in
+  bscanf ib " ]" ();
+  List.rev accu;;
+
+let scan_float ib = Scanf.bscanf ib "%f";;
+
+let scan_int_list = scan_list (fun ib -> Scanf.bscanf ib "%i");;
+let scan_string_list = scan_list (fun ib -> Scanf.bscanf ib "%S");;
+let scan_bool_list = scan_list (fun ib -> Scanf.bscanf ib "%B");;
+let scan_char_list = scan_list (fun ib -> Scanf.bscanf ib "%C");;
+let scan_float_list = scan_list scan_float;;
+
+(* Scanning list of lists of floats. *)
+let scan_float_list_list =
+  scan_list
+    (fun ib k -> k (scan_list (fun ib -> Scanf.bscanf ib "%f") ib));;
+
+let scan_float_list_list =
+  scan_list
+    (fun ib k -> k (scan_list scan_float ib));;
+
+let scan_float_list_list =
+  scan_list
+    (fun ib k -> k (scan_float_list ib));;
+
+(* A general scan_list_list functional. *)
+let scan_list_list scan_elems ib =
+  scan_list
+    (fun ib k -> k (scan_elems ib)) ib;;
+
+let scan_float_list_list = scan_list_list scan_float_list;;
+
+(* Programming with continuations :) *)
+let scan_float_item ib k = k (scan_float ib (fun x -> x));;
+let scan_float_list ib k = k (scan_list scan_float_item ib);;
+let scan_float_list_list ib k = k (scan_list scan_float_list ib);;
 
 test (test34 ());;
 
@@ -733,8 +774,7 @@ let test35 () =
   sscanf "" "%N" (fun x -> x) = 0 &&
   sscanf "456" "%N" (fun x -> x) = 0 &&
   sscanf "456" "%d%N" (fun x y -> x, y) = (456, 1) &&
-  sscanf " " "%N%s%N" (fun x s y -> x, s, y) = (0, "", 1)
-;;
+  sscanf " " "%N%s%N" (fun x s y -> x, s, y) = (0, "", 1);;
 
 test (test35 ());;
 
@@ -743,8 +783,7 @@ let test36 () =
   sscanf "" "%n" (fun x -> x) = 0 &&
   sscanf "456" "%n" (fun x -> x) = 0 &&
   sscanf "456" "%d%n" (fun x y -> x, y) = (456, 3) &&
-  sscanf " " "%n%s%n" (fun x s y -> x, s, y) = (0, "", 1)
-;;
+  sscanf " " "%n%s%n" (fun x s y -> x, s, y) = (0, "", 1);;
 
 test (test36 ());;
 
@@ -752,16 +791,20 @@ test (test36 ());;
 let test37 () =
   sscanf "" "" true &&
   sscanf "" "" (fun x -> x) 1 = 1 &&
-  sscanf "123" "" (fun x -> x) 1 = 1
-;;
+  sscanf "123" "" (fun x -> x) 1 = 1;;
 
 test (test37 ());;
 
 (* Testing end of input condition. *)
 let test38 () =
+  sscanf "a" "a%!" true &&
+  sscanf "a" "a%!%!" true &&
+  sscanf " a" " a%!" true &&
+  sscanf "a " "a %!" true &&
+  sscanf "" "%!" true &&
   sscanf " " " %!" true &&
   sscanf "" " %!" true &&
-  sscanf "" "%!" true;;
+  sscanf "" " %!%!" true;;
 
 test (test38 ());;
 
@@ -797,32 +840,160 @@ test (test41 ());;
 let test42 () =
  let s = "defcbaaghi" in
  let ib = Scanning.from_string s in
- bscanf ib "%[^abc]%[cba]%s%!" (fun s1 s2 s3 ->
-   s1 = "def" && s2 = "cbaa" && s3 = "ghi");;
+ bscanf ib "%[^abc]%[abc]%s%!" (fun s1 s2 s3 ->
+   s1 = "def" && s2 = "cbaa" && s3 = "ghi") &&
+ let ib = Scanning.from_string s in
+ bscanf ib "%s@\t" (fun s -> s = "defcbaaghi");;
 
 test (test42 ());;
 
-let test43 () =
- let s = "defcbaaghi" in
+(* Testing end of file condition (bug found). *)
+let test43, test44 =
+ let s = "" in
  let ib = Scanning.from_string s in
- bscanf ib "%s@\t" (fun s ->
-   s = "defcbaaghi");;
+ (fun () -> bscanf ib "%i%!" (fun i -> i)),
+ (fun () -> bscanf ib "%!%i" (fun i -> i));;
 
-test (test43 ());;
+test_raises_this_exc End_of_file test43 () &&
+test_raises_this_exc End_of_file test44 ();;
 
-let test50 () =
+(* Testing small range scanning (bug found). *)
+let test45 () =
  let s = "12.2" in
  let ib = Scanning.from_string s in
  bscanf ib "%[0-9].%[0-9]%s%!" (fun s1 s2 s3 ->
    s1 = "12" && s2 = "2" && s3 = "");;
 
+test (test45 ());;
+
+(* Testing meta formats. *)
+
+let test46, test47 =
+  (fun () ->
+     Printf.sprintf
+       (format_of_string "%i %(%s%).")
+       1 "spells one, %s" "in english"),
+  (fun () ->
+     Printf.sprintf
+       (format_of_string "%i ,%{%s%}, %s.")
+       1 "spells one %s" "in english");;
+
+test (test46 () = "1 spells one, in english.");;
+test (test47 () = "1 ,%s, in english.");;
+
+let test48 () =
+  sscanf "12 \"%i\"89 " "%i %{%d%}%s %!"
+    (fun i f s -> i=12 && f="%i" && s="89");;
+
+test (test48 ());;
+
+(* Testing stoppers after ranges. *)
+let test49 () =
+  sscanf "as" "%[\\]" (fun s -> s = "") &&
+  sscanf "as" "%[\\]%s" (fun s t -> s = "" && t = "as") &&
+  sscanf "as" "%[\\]%s%!" (fun s t -> s = "" && t = "as") &&
+  sscanf "as" "%[a..z]" (fun s -> s = "a") &&
+  sscanf "as" "%[a-z]" (fun s -> s = "as") &&
+  sscanf "as" "%[a..z]%s" (fun s t -> s = "a" && t = "s") &&
+  sscanf "as" "%[a-z]%s" (fun s t -> s = "as" && t = "") &&
+  sscanf "-as" "%[-a-z]" (fun s -> s = "-as") &&
+  sscanf "-as" "%[-a-z]@s" (fun s -> s = "-a") &&
+  sscanf "-as" "-%[a]@s" (fun s -> s = "a") &&   
+  sscanf "-asb" "-%[a]@sb%!" (fun s -> s = "a") &&
+  sscanf "-asb" "-%[a]@s%s" (fun s t -> s = "a" && t = "b");; 
+
+test (test49 ());;
+
+(* Testing buffers defined via functions +
+   co-routines that read and write from the same buffers
+   + range chars and proper handling of \n (and of the end of file
+   condition). *)
+let next_char ob () =
+  let s = Buffer.contents ob in
+  let len = String.length s in
+  if len = 0 then raise End_of_file else
+  let c = s.[0] in
+  Buffer.clear ob;
+  Buffer.add_string ob (String.sub s 1 (len - 1));
+  (*prerr_endline (Printf.sprintf "giving %C" c);*)
+  c;;
+
+let send_string ob s =
+  (*prerr_endline (Printf.sprintf "adding %s\n" s);*)
+  Buffer.add_string ob s; Buffer.add_char ob '\n';;
+let send_int ob i = send_string ob (string_of_int i);;
+
+let rec reader =
+  let count = ref 0 in
+  (fun ib ob ->
+    if Scanf.Scanning.beginning_of_input ib then begin
+      count := 0; send_string ob "start"; writer ib ob end else
+    Scanf.bscanf ib "%[^\n]\n" (function
+    | "stop" -> send_string ob "stop"; writer ib ob
+    | s ->
+      let l = String.length s in
+      count := l + !count;
+      if !count >= 100 then begin
+        send_string ob "stop";
+        send_int ob !count
+        end else
+      send_int ob l;
+      writer ib ob))
+
+and writer ib ob =
+  Scanf.bscanf ib "%s\n" (function
+    | "start" -> send_string ob "Hello World!"; reader ib ob
+    | "stop" -> Scanf.bscanf ib "%i" (function i -> i)
+    | s -> send_int ob (int_of_string s); reader ib ob);;
+
+let go () =
+  let ob = Buffer.create 17 in
+  let ib = Scanf.Scanning.from_function (next_char ob) in
+  reader ib ob;;
+
+let test50 () = go () = 100;;
+
 test (test50 ());;
 
-(*******
+(* Simple tests may also fail! *)
+let test51 () =
+ sscanf "Hello" "%s" id = "Hello" &&
+ sscanf "Hello\n" "%s\n" id = "Hello" &&
+ sscanf "Hello\n" "%s%s\n" (fun s1 s2 ->
+   s1 = "Hello" && s2 = "") &&
+ sscanf "Hello\nWorld" "%s\n%s%!" (fun s1 s2 ->
+   s1 = "Hello" && s2 = "World") &&
+ sscanf "Hello\nWorld!" "%s\n%s" (fun s1 s2 ->
+   s1 = "Hello" && s2 = "World!") &&
+ sscanf "Hello\n" "%s@\n%s" (fun s1 s2 ->
+   s1 = "Hello" && s2 = "") &&
+ sscanf "Hello \n" "%s@\n%s" (fun s1 s2 ->
+   s1 = "Hello " && s2 = "");;
+
+test (test51 ());;
+
+(* Tests that indeed %s@c works properly.
+   Also tests the difference between \n and @\n.
+   In particular, tests that if no c character can be found in the
+   input, then the token obtained for %s@c spreads to the end of
+   input. *)
+let test52 () =
+ sscanf "Hello\n" "%s@\n" id = "Hello" &&
+ sscanf "Hello" "%s@\n" id = "Hello" &&
+ sscanf "Hello" "%s%s@\n" (fun s1 s2 ->
+   s1 = "Hello" && s2 = "") &&
+ sscanf "Hello\nWorld" "%s@\n%s%!" (fun s1 s2 ->
+   s1 = "Hello" && s2 = "World") &&
+ sscanf "Hello\nWorld!" "%s@\n%s@\n" (fun s1 s2 ->
+   s1 = "Hello" && s2 = "World!") &&
+ sscanf "Hello\n" "%s@\n%s" (fun s1 s2 ->
+   s1 = "Hello" && s2 = "") &&
+ sscanf "Hello \n" "%s%s@\n" (fun s1 s2 ->
+   s1 = "Hello" && s2 = " ");;
+
+test (test52 ());;
 
-print_string "Test number is "; 
-print_int !test_num; print_string ". It should be 42.";
-print_newline();;
+(*******
 
 To be continued.
 
@@ -832,8 +1003,7 @@ let digest () =
   let digest_line s = print_endline (s ^ "#" ^ digest s) in
   try
    while true do scan_line digest_line done
-  with End_of_file -> ()
-;;
+  with End_of_file -> ();;
 
 (* Trying to scan records. *)
 let rec scan_fields ib scan_field accu =
@@ -843,13 +1013,12 @@ let rec scan_fields ib scan_field accu =
       let accu = i :: accu in
       kscanf ib (fun ib exc -> accu)
        " %1[;] "
-       (fun s -> if s = "" then accu else scan_fields ib scan_field accu))
-;;
+       (fun s ->
+          if s = "" then accu else scan_fields ib scan_field accu));;
 
 let scan_record scan_field ib =
   bscanf ib "{ " ();
   let accu = scan_fields ib scan_field [] in
   bscanf ib " }" ();
-  List.rev accu
-;;
+  List.rev accu;;
 ***********)
diff --git a/testlabl/poly.exp b/testlabl/poly.exp
index 2b3faffa58..ac1dca7cbb 100644
--- a/testlabl/poly.exp
+++ b/testlabl/poly.exp
@@ -1,4 +1,4 @@
-        Objective Caml version 3.07+19 (2004-05-26)
+        Objective Caml version 3.09+dev27 (2005-08-13)
 
 #   * * *       #   type 'a t = { t : 'a; }
 # type 'a fold = { fold : 'b. f:('b -> 'a -> 'b) -> init:'b -> 'b; }
@@ -129,7 +129,7 @@ The universal variable 'a would escape its scope
 #         class type id_spec = object method id : 'a -> 'a end
 #       class id_impl : object method id : 'a -> 'a end
 #               class a : object method m : bool end
-class b : object method id : 'a -> 'a end
+and b : object method id : 'a -> 'a end
 #           Characters 72-77:
 This method has type 'a -> 'a which is less general than 'b. 'b -> 'a
 #         Characters 75-80:
@@ -156,9 +156,13 @@ The type abbreviation foo is cyclic
 # val f :
   (< m : 'b. 'a * (< n : 'b; .. > as 'b) > as 'a) ->
   'a * (< n : 'c; .. > as 'c) = <fun>
-#   - : (< p : 'b. < m : 'b; n : 'a; .. > as 'b > as 'a) ->
+# - : (< p : 'b. < m : 'b; n : 'a; .. > as 'b > as 'a) ->
     (< m : 'c; n : 'a; .. > as 'c)
 = <fun>
+# - : (< m : 'b. 'b * < p : 'd. 'd * 'c * 'a > as 'c > as 'a) ->
+    ('f * < p : 'g. 'g * 'e * 'a > as 'e)
+= <fun>
+#   - : < m : 'a. < p : 'a; .. > as 'b > -> 'b = <fun>
 #   type sum = T of < id : 'a. 'a -> 'a >
 # - : sum -> 'a -> 'a = <fun>
 #   type record = { r : < id : 'a. 'a -> 'a >; }
@@ -196,9 +200,9 @@ The type abbreviation foo is cyclic
 #     type 'a t = unit
 #   class o : object method x : [> `A ] t -> unit end
 #   class c : object method m : d end
-class d : ?x:int -> unit -> object  end
+and d : ?x:int -> unit -> object  end
 # class d : ?x:int -> unit -> object  end
-class c : object method m : d end
+and c : object method m : d end
 #           class type numeral = object method fold : ('a -> 'a) -> 'a -> 'a end
 class zero : object method fold : ('a -> 'a) -> 'a -> 'a end
 class next : #numeral -> object method fold : ('a -> 'a) -> 'a -> 'a end
@@ -214,6 +218,10 @@ This field value has type 'a option ref which is less general than
 # Characters 13-28:
 This field value has type 'a option ref option which is less general than
   'b. 'b option ref option
+#       val f : < m : 'a. < p : 'a * 'b > as 'b > -> 'c -> unit = <fun>
+# val f :
+  < m : 'a. 'a * (< p : int * 'b > as 'b) > ->
+  (< p : int * 'c > as 'c) -> unit = <fun>
 #       type 'a t = [ `A of 'a ]
 #       class c : object method m : ([> 'a t ] as 'a) -> unit end
 #         class c : object method m : ([> 'a t ] as 'a) -> unit end
@@ -234,20 +242,20 @@ type t = [ `A of t a ]
 Constraints are not satisfied in this type.
 Type ('a, 'b) t should be an instance of ('c, 'c) t
 #     type 'a t = 'a
-type u = int t
+and u = int t
 #     type 'a t constraint 'a = int
 # Characters 26-32:
 Constraints are not satisfied in this type.
 Type 'a u t should be an instance of int t
 # type 'a u = 'a constraint 'a = int
-type 'a v = 'a u t constraint 'a = int
+and 'a v = 'a u t constraint 'a = int
 #     type g = int
 # type 'a t = unit constraint 'a = g
 # Characters 26-32:
 Constraints are not satisfied in this type.
 Type 'a u t should be an instance of g t
 # type 'a u = 'a constraint 'a = g
-type 'a v = 'a u t constraint 'a = int
+and 'a v = 'a u t constraint 'a = int
 #     Characters 38-58:
 In the definition of v, type 'a list u should be 'a u
 #       type 'a t = 'a
@@ -263,30 +271,30 @@ type 'a u = A of 'a t
 # - : t * [< `A | `B ] -> int = <fun>
 # - : [< `A | `B ] * t -> int = <fun>
 # Characters 0-41:
-Warning: this pattern-matching is not exhaustive.
+Warning P: this pattern-matching is not exhaustive.
 Here is an example of a value that is not matched:
 (`AnyExtraTag, `AnyExtraTag)
 - : [> `A | `B ] * [> `A | `B ] -> int = <fun>
 # Characters 0-29:
-Warning: this pattern-matching is not exhaustive.
+Warning P: this pattern-matching is not exhaustive.
 Here is an example of a value that is not matched:
 (_, 0)
 Characters 21-24:
-Warning: this match case is unused.
-- : [ `B ] * int -> int = <fun>
+Warning U: this match case is unused.
+- : [< `B ] * int -> int = <fun>
 # Characters 0-29:
-Warning: this pattern-matching is not exhaustive.
+Warning P: this pattern-matching is not exhaustive.
 Here is an example of a value that is not matched:
 (0, _)
 Characters 21-24:
-Warning: this match case is unused.
-- : int * [ `B ] -> int = <fun>
+Warning U: this match case is unused.
+- : int * [< `B ] -> int = <fun>
 #       Characters 69-135:
 Constraints are not satisfied in this type.
 Type
 ([> `B of 'a ], 'a) b as 'a
 should be an instance of
-(('b, [> `A of 'b ] as 'c) a as 'b, 'c) b
+(('b, [> `A of ('d, 'c) a as 'd ] as 'c) a as 'b, 'c) b
 #                             class type ['a, 'b] a =
   object
     constraint 'a = ('a, 'b) #a
@@ -294,7 +302,7 @@ should be an instance of
     method as_a : ('a, 'b) a
     method b : 'b
   end
-class type ['a, 'b] b =
+and ['a, 'b] b =
   object
     constraint 'a = ('a, 'b) #a
     constraint 'b = ('a, 'b) #b
@@ -318,8 +326,8 @@ type bt = 'a ca cb as 'a
 # val f : unit -> c = <fun>
 # val f : unit -> c = <fun>
 # Characters 11-60:
-Warning: the following private methods were made public implicitly:
-  n
+Warning X: the following private methods were made public implicitly:
+ n.
 val f : unit -> < m : int; n : int > = <fun>
 # Characters 11-56:
 This object is expected to have type c but has actually type
@@ -347,4 +355,82 @@ Type 'a foo = < m : 'a * 'a foo > is not compatible with type
 Type 'a foo = < m : 'a * 'a foo > is not compatible with type
   < m : 'b. 'b * 'a bar > 
 Types for method m are incompatible
+#     Characters 67-68:
+This expression has type < m : 'a. 'a * ('a * < m : 'c. 'c * 'b > as 'b) >
+but is here used with type
+  < m : 'a. 'a * ('a * < m : 'c. 'c * ('c * 'd) >) > as 'd
+Types for method m are incompatible
+#   Characters 66-67:
+This expression has type < m : 'a. 'a * ('a * < m : 'c. 'c * 'b > as 'b) >
+but is here used with type
+  < m : 'a. 'a * ('a * < m : 'c. 'c * ('a * 'd) >) > as 'd
+Types for method m are incompatible
+#   Characters 51-52:
+This expression has type < m : 'b. 'b * ('b * 'a) > as 'a
+but is here used with type < m : 'b. 'b * ('b * < m : 'd. 'd * 'c > as 'c) >
+Types for method m are incompatible
+#     Characters 14-115:
+Type < m : 'a. 'a -> ('a * (< m : 'd. 'd -> 'b as 'e > as 'c) as 'b) >
+is not a subtype of type < m : 'a. 'a -> ('a * 'f as 'h) as 'g > as 'f 
+#       Characters 88-150:
+Signature mismatch:
+Modules do not match:
+  sig val f : (< m : 'b. 'b * ('b * 'a) > as 'a) -> unit end
+is not included in
+  sig val f : < m : 'a. 'a * ('a * < m : 'c. 'c * 'b > as 'b) > -> unit end
+Values do not match:
+  val f : (< m : 'b. 'b * ('b * 'a) > as 'a) -> unit
+is not included in
+  val f : < m : 'a. 'a * ('a * < m : 'c. 'c * 'b > as 'b) > -> unit
+#     Characters 78-132:
+Signature mismatch:
+Modules do not match:
+  sig type t = < m : 'b. 'b * ('b * 'a) > as 'a end
+is not included in
+  sig type t = < m : 'a. 'a * ('a * < m : 'c. 'c * 'b > as 'b) > end
+Type declarations do not match:
+  type t = < m : 'b. 'b * ('b * 'a) > as 'a
+is not included in
+  type t = < m : 'a. 'a * ('a * < m : 'c. 'c * 'b > as 'b) >
+#     module M : sig type 'a t type u = < m : 'a. 'a t > end
+#   module M : sig type 'a t val f : < m : 'a. 'a t > -> int end
+#     module M : sig type 'a t val f : < m : 'a. 'a t > -> int end
+#         val f :
+  (< m : 'b. 'b -> (< m : 'b. 'b -> 'c * <  > > as 'c) * < .. >; .. > as 'a) ->
+  'a -> bool = <fun>
+#         type t = [ `A | `B ]
+# type v = private [> t ]
+# - : t -> v = <fun>
+# type u = private [< t ]
+# - : u -> v = <fun>
+# Characters 9-21:
+Type v = [> `A | `B ] is not a subtype of type u = [< `A | `B ] 
+These two variant types have no intersection
+# type v = private [< t ]
+# Characters 9-21:
+Type u = [< `A | `B ] is not a subtype of type v = [< `A | `B ] 
+# type p = < x : p >
+# type q = private < x : p; .. >
+# - : q -> p = <fun>
+# Characters 9-21:
+Type p = < x : p > is not a subtype of type q = < x : p; .. > 
+#       Characters 14-100:
+Type < m : 'a. (< p : int; .. > as 'a) -> int > is not a subtype of type
+  < m : 'b. (< p : int; q : int; .. > as 'b) -> int > 
+#     val f2 :
+  < m : 'a. (< p : < a : int >; .. > as 'a) -> int > ->
+  < m : 'a. (< p : < a : int; b : int >; .. > as 'a) -> int > = <fun>
+#     Characters 13-107:
+Type < m : 'a. (< p : < a : int; b : int >; .. > as 'a) -> int >
+is not a subtype of type < m : 'a. (< p : < a : int >; .. > as 'a) -> int > 
+# Characters 11-55:
+Type < p : < a : int; b : int >; .. > is not a subtype of type
+  < p : < a : int >; .. > 
+Only the first object type has a method b
+#   val f5 :
+  < m : 'a. [< `A of < p : int > ] as 'a > ->
+  < m : 'a. [< `A of <  > ] as 'a > = <fun>
+#   Characters 13-83:
+Type < m : 'a. [< `A of <  > ] as 'a > is not a subtype of type
+  < m : 'a. [< `A of < p : int > ] as 'a > 
 # 
diff --git a/testlabl/poly.exp2 b/testlabl/poly.exp2
index dba450e7c5..0e64a2c354 100644
--- a/testlabl/poly.exp2
+++ b/testlabl/poly.exp2
@@ -1,4 +1,4 @@
-        Objective Caml version 3.07+19 (2004-05-26)
+        Objective Caml version 3.09+dev27 (2005-08-13)
 
 #   * * *       #   type 'a t = { t : 'a; }
 # type 'a fold = { fold : 'b. f:('b -> 'a -> 'b) -> init:'b -> 'b; }
@@ -129,7 +129,7 @@ The universal variable 'a would escape its scope
 #         class type id_spec = object method id : 'a -> 'a end
 #       class id_impl : object method id : 'a -> 'a end
 #               class a : object method m : bool end
-class b : object method id : 'a -> 'a end
+and b : object method id : 'a -> 'a end
 #           Characters 72-77:
 This method has type 'a -> 'a which is less general than 'b. 'b -> 'a
 #         Characters 75-80:
@@ -144,9 +144,9 @@ This method has type 'a -> 'a which is less general than 'b. 'b -> 'b
 #   Characters 24-28:
 This expression has type bool but is here used with type int
 #   Characters 27-31:
-Warning: This use of a polymorphic method is not principal
+Warning X: this use of a polymorphic method is not principal.
 Characters 35-39:
-Warning: This use of a polymorphic method is not principal
+Warning X: this use of a polymorphic method is not principal.
 val f4 : id -> int * bool = <fun>
 #           class c : object method m : #id -> int * bool end
 #             class id2 : object method id : 'a -> 'a method mono : int -> int end
@@ -163,9 +163,17 @@ The type abbreviation foo is cyclic
   (< m : 'b. 'a * (< n : 'b; .. > as 'b) > as 'a) ->
   (< m : 'd. 'c * (< n : 'd; .. > as 'd) > as 'c) * (< n : 'e; .. > as 'e) =
   <fun>
-#   - : (< p : 'b. < m : 'b; n : 'a; .. > as 'b > as 'a) ->
+# - : (< p : 'b. < m : 'b; n : 'a; .. > as 'b > as 'a) ->
     (< m : 'c; n : < p : 'e. < m : 'e; n : 'd; .. > as 'e > as 'd; .. > as 'c)
 = <fun>
+# - : (< m : 'b. 'b * < p : 'd. 'd * 'c * 'a > as 'c > as 'a) ->
+    ('f *
+     < p : 'g.
+             'g * 'e *
+             (< m : 'i. 'i * < p : 'k. 'k * 'j * 'h > as 'j > as 'h) >
+     as 'e)
+= <fun>
+#   - : < m : 'a. < p : 'a; .. > as 'b > -> 'b = <fun>
 #   type sum = T of < id : 'a. 'a -> 'a >
 # - : sum -> 'a -> 'a = <fun>
 #   type record = { r : < id : 'a. 'a -> 'a >; }
@@ -203,9 +211,9 @@ The type abbreviation foo is cyclic
 #     type 'a t = unit
 #   class o : object method x : [> `A ] t -> unit end
 #   class c : object method m : d end
-class d : ?x:int -> unit -> object  end
+and d : ?x:int -> unit -> object  end
 # class d : ?x:int -> unit -> object  end
-class c : object method m : d end
+and c : object method m : d end
 #           class type numeral = object method fold : ('a -> 'a) -> 'a -> 'a end
 class zero : object method fold : ('a -> 'a) -> 'a -> 'a end
 class next : #numeral -> object method fold : ('a -> 'a) -> 'a -> 'a end
@@ -221,6 +229,10 @@ This field value has type 'a option ref which is less general than
 # Characters 13-28:
 This field value has type 'a option ref option which is less general than
   'b. 'b option ref option
+#       val f : < m : 'a. < p : 'a * 'b > as 'b > -> 'c -> unit = <fun>
+# val f :
+  < m : 'a. 'a * (< p : int * 'b > as 'b) > ->
+  (< p : int * 'c > as 'c) -> unit = <fun>
 #       type 'a t = [ `A of 'a ]
 #       class c : object method m : ([> 'a t ] as 'a) -> unit end
 #         class c : object method m : ([> 'a t ] as 'a) -> unit end
@@ -241,20 +253,20 @@ type t = [ `A of t a ]
 Constraints are not satisfied in this type.
 Type ('a, 'b) t should be an instance of ('c, 'c) t
 #     type 'a t = 'a
-type u = int t
+and u = int t
 #     type 'a t constraint 'a = int
 # Characters 26-32:
 Constraints are not satisfied in this type.
 Type 'a u t should be an instance of int t
 # type 'a u = 'a constraint 'a = int
-type 'a v = 'a u t constraint 'a = int
+and 'a v = 'a u t constraint 'a = int
 #     type g = int
 # type 'a t = unit constraint 'a = g
 # Characters 26-32:
 Constraints are not satisfied in this type.
 Type 'a u t should be an instance of g t
 # type 'a u = 'a constraint 'a = g
-type 'a v = 'a u t constraint 'a = int
+and 'a v = 'a u t constraint 'a = int
 #     Characters 38-58:
 In the definition of v, type 'a list u should be 'a u
 #       type 'a t = 'a
@@ -270,30 +282,30 @@ type 'a u = A of 'a t
 # - : t * [< `A | `B ] -> int = <fun>
 # - : [< `A | `B ] * t -> int = <fun>
 # Characters 0-41:
-Warning: this pattern-matching is not exhaustive.
+Warning P: this pattern-matching is not exhaustive.
 Here is an example of a value that is not matched:
 (`AnyExtraTag, `AnyExtraTag)
 - : [> `A | `B ] * [> `A | `B ] -> int = <fun>
 # Characters 0-29:
-Warning: this pattern-matching is not exhaustive.
+Warning P: this pattern-matching is not exhaustive.
 Here is an example of a value that is not matched:
 (_, 0)
 Characters 21-24:
-Warning: this match case is unused.
-- : [ `B ] * int -> int = <fun>
+Warning U: this match case is unused.
+- : [< `B ] * int -> int = <fun>
 # Characters 0-29:
-Warning: this pattern-matching is not exhaustive.
+Warning P: this pattern-matching is not exhaustive.
 Here is an example of a value that is not matched:
 (0, _)
 Characters 21-24:
-Warning: this match case is unused.
-- : int * [ `B ] -> int = <fun>
+Warning U: this match case is unused.
+- : int * [< `B ] -> int = <fun>
 #       Characters 69-135:
 Constraints are not satisfied in this type.
 Type
 ([> `B of 'a ], 'a) b as 'a
 should be an instance of
-(('b, [> `A of 'b ] as 'c) a as 'b, 'c) b
+(('b, [> `A of ('d, 'c) a as 'd ] as 'c) a as 'b, 'c) b
 #                             class type ['a, 'b] a =
   object
     constraint 'a = ('a, 'b) #a
@@ -301,7 +313,7 @@ should be an instance of
     method as_a : ('a, 'b) a
     method b : 'b
   end
-class type ['a, 'b] b =
+and ['a, 'b] b =
   object
     constraint 'a = ('a, 'b) #a
     constraint 'b = ('a, 'b) #b
@@ -325,8 +337,8 @@ type bt = 'a ca cb as 'a
 # val f : unit -> c = <fun>
 # val f : unit -> c = <fun>
 # Characters 11-60:
-Warning: the following private methods were made public implicitly:
-  n
+Warning X: the following private methods were made public implicitly:
+ n.
 val f : unit -> < m : int; n : int > = <fun>
 # Characters 11-56:
 This object is expected to have type c but has actually type
@@ -354,4 +366,82 @@ Type 'a foo = < m : 'a * 'a foo > is not compatible with type
 Type 'a foo = < m : 'a * 'a foo > is not compatible with type
   < m : 'b. 'b * 'a bar > 
 Types for method m are incompatible
+#     Characters 67-68:
+This expression has type < m : 'a. 'a * ('a * < m : 'c. 'c * 'b > as 'b) >
+but is here used with type
+  < m : 'a. 'a * ('a * < m : 'c. 'c * ('c * 'd) >) > as 'd
+Types for method m are incompatible
+#   Characters 66-67:
+This expression has type < m : 'a. 'a * ('a * < m : 'c. 'c * 'b > as 'b) >
+but is here used with type
+  < m : 'a. 'a * ('a * < m : 'c. 'c * ('a * 'd) >) > as 'd
+Types for method m are incompatible
+#   Characters 51-52:
+This expression has type < m : 'b. 'b * ('b * 'a) > as 'a
+but is here used with type < m : 'b. 'b * ('b * < m : 'd. 'd * 'c > as 'c) >
+Types for method m are incompatible
+#     Characters 14-115:
+Type < m : 'a. 'a -> ('a * (< m : 'd. 'd -> 'b as 'e > as 'c) as 'b) >
+is not a subtype of type < m : 'a. 'a -> ('a * 'f as 'h) as 'g > as 'f 
+#       Characters 88-150:
+Signature mismatch:
+Modules do not match:
+  sig val f : (< m : 'b. 'b * ('b * 'a) > as 'a) -> unit end
+is not included in
+  sig val f : < m : 'a. 'a * ('a * < m : 'c. 'c * 'b > as 'b) > -> unit end
+Values do not match:
+  val f : (< m : 'b. 'b * ('b * 'a) > as 'a) -> unit
+is not included in
+  val f : < m : 'a. 'a * ('a * < m : 'c. 'c * 'b > as 'b) > -> unit
+#     Characters 78-132:
+Signature mismatch:
+Modules do not match:
+  sig type t = < m : 'b. 'b * ('b * 'a) > as 'a end
+is not included in
+  sig type t = < m : 'a. 'a * ('a * < m : 'c. 'c * 'b > as 'b) > end
+Type declarations do not match:
+  type t = < m : 'b. 'b * ('b * 'a) > as 'a
+is not included in
+  type t = < m : 'a. 'a * ('a * < m : 'c. 'c * 'b > as 'b) >
+#     module M : sig type 'a t type u = < m : 'a. 'a t > end
+#   module M : sig type 'a t val f : < m : 'a. 'a t > -> int end
+#     module M : sig type 'a t val f : < m : 'a. 'a t > -> int end
+#         val f :
+  (< m : 'b. 'b -> (< m : 'b. 'b -> 'c * <  > > as 'c) * < .. >; .. > as 'a) ->
+  'a -> bool = <fun>
+#         type t = [ `A | `B ]
+# type v = private [> t ]
+# - : t -> v = <fun>
+# type u = private [< t ]
+# - : u -> v = <fun>
+# Characters 9-21:
+Type v = [> `A | `B ] is not a subtype of type u = [< `A | `B ] 
+These two variant types have no intersection
+# type v = private [< t ]
+# Characters 9-21:
+Type u = [< `A | `B ] is not a subtype of type v = [< `A | `B ] 
+# type p = < x : p >
+# type q = private < x : p; .. >
+# - : q -> p = <fun>
+# Characters 9-21:
+Type p = < x : p > is not a subtype of type q = < x : p; .. > 
+#       Characters 14-100:
+Type < m : 'a. (< p : int; .. > as 'a) -> int > is not a subtype of type
+  < m : 'b. (< p : int; q : int; .. > as 'b) -> int > 
+#     val f2 :
+  < m : 'a. (< p : < a : int >; .. > as 'a) -> int > ->
+  < m : 'a. (< p : < a : int; b : int >; .. > as 'a) -> int > = <fun>
+#     Characters 13-107:
+Type < m : 'a. (< p : < a : int; b : int >; .. > as 'a) -> int >
+is not a subtype of type < m : 'a. (< p : < a : int >; .. > as 'a) -> int > 
+# Characters 11-55:
+Type < p : < a : int; b : int >; .. > is not a subtype of type
+  < p : < a : int >; .. > 
+Only the first object type has a method b
+#   val f5 :
+  < m : 'a. [< `A of < p : int > ] as 'a > ->
+  < m : 'a. [< `A of <  > ] as 'a > = <fun>
+#   Characters 13-83:
+Type < m : 'a. [< `A of <  > ] as 'a > is not a subtype of type
+  < m : 'a. [< `A of < p : int > ] as 'a > 
 # 
diff --git a/testlabl/poly.ml b/testlabl/poly.ml
index 7ee3fd9dbe..40645cb836 100644
--- a/testlabl/poly.ml
+++ b/testlabl/poly.ml
@@ -265,8 +265,10 @@ type 'a foo = 'a foo bar
 fun x -> (x : < m : 'a. 'a * 'b > as 'b)#m;;
 fun x -> (x : < m : 'a. 'b * 'a list> as 'b)#m;;
 let f x = (x : < m : 'a. 'b * (< n : 'a; .. > as 'a) > as 'b)#m;;
-
 fun (x : < p : 'a. < m : 'a ; n : 'b ; .. > as 'a > as 'b) -> x#p;;
+fun (x : <m:'a. 'a * <p:'b. 'b * 'c * 'd> as 'c> as 'd) -> x#m;;
+(* printer is wrong on the next (no official syntax) *)
+fun (x : <m:'a.<p:'a;..> >) -> x#m;;
 
 type sum = T of < id: 'a. 'a -> 'a > ;;
 fun (T x) -> x#id;;
@@ -356,6 +358,11 @@ type bad2 = {mutable bad2 : 'a. 'a option ref option};;
 let bad2 = {bad2 = None};;
 bad2.bad2 <- Some (ref None);;
 
+(* Type variable scope *)
+
+let f (x: <m:'a.<p: 'a * 'b> as 'b>) (y : 'b) = ();;
+let f (x: <m:'a. 'a * (<p:int*'b> as 'b)>) (y : 'b) = ();;
+
 (* PR#1374 *)
 
 type 'a t= [`A of 'a];;
@@ -486,3 +493,64 @@ type foo' =   <m: 'a. 'a * 'a foo>
 type 'a bar = <m: 'b. 'a * <m: 'c. 'c * 'a bar> >
 type bar' =   <m: 'a. 'a * 'a bar >
 let f (x : foo') = (x : bar');;
+
+fun (x : <m : 'a. 'a * ('a * <m : 'a. 'a * 'foo> as 'foo)>) ->
+  (x : <m : 'b. 'b * ('b * <m : 'c. 'c * ('c * 'bar)>)> as 'bar);;
+fun (x : <m : 'a. 'a * ('a * <m : 'a. 'a * 'foo> as 'foo)>) ->
+  (x : <m : 'b. 'b * ('b * <m : 'c. 'c * ('b * 'bar)>)> as 'bar);;
+fun (x : <m : 'a. 'a * ('a * 'foo)> as 'foo) ->
+  (x : <m : 'b. 'b * ('b * <m:'c. 'c * 'bar> as 'bar)>);;
+let f x =
+    (x : <m : 'a. 'a -> ('a * <m:'c. 'c -> 'bar> as 'bar)>
+       :> <m : 'a. 'a -> ('a * 'foo)> as 'foo);;
+
+module M
+: sig val f : (<m : 'b. 'b * ('b * <m:'c. 'c * 'bar> as 'bar)>) -> unit end
+= struct let f (x : <m : 'a. 'a * ('a * 'foo)> as 'foo) = () end;;
+module M
+: sig type t = <m : 'b. 'b * ('b * <m:'c. 'c * 'bar> as 'bar)> end
+= struct type t = <m : 'a. 'a * ('a * 'foo)> as 'foo end;;
+
+module M : sig type 'a t type u = <m: 'a. 'a t> end
+= struct type 'a t = int type u = <m: int> end;;
+module M : sig type 'a t val f : <m: 'a. 'a t> -> int end
+= struct type 'a t = int let f (x : <m:int>) = x#m end;;
+(* The following should be accepted too! *)
+module M : sig type 'a t val f : <m: 'a. 'a t> -> int end
+= struct type 'a t = int let f x = x#m end;;
+
+let f x y =
+  ignore (x :> <m:'a.'a -> 'c * < > > as 'c);
+  ignore (y :> <m:'b.'b -> 'd * < > > as 'd);
+  x = y;;
+
+
+(* Subtyping *)
+
+type t = [`A|`B];;
+type v = private [> t];;
+fun x -> (x : t :> v);;
+type u = private [< t];;
+fun x -> (x : u :> v);;
+fun x -> (x : v :> u);;
+type v = private [< t];;
+fun x -> (x : u :> v);;
+type p = <x:p>;;
+type q = private <x:p; ..>;;
+fun x -> (x : q :> p);;
+fun x -> (x : p :> q);;
+
+let f1 x =
+  (x : <m:'a. (<p:int;..> as 'a) -> int>
+    :> <m:'b. (<p:int;q:int;..> as 'b) -> int>);;
+let f2 x =
+  (x : <m:'a. (<p:<a:int>;..> as 'a) -> int>
+    :> <m:'b. (<p:<a:int;b:int>;..> as 'b) -> int>);;
+let f3 x =
+  (x : <m:'a. (<p:<a:int;b:int>;..> as 'a) -> int>
+    :> <m:'b. (<p:<a:int>;..> as 'b) -> int>);;
+let f4 x = (x : <p:<a:int;b:int>;..> :> <p:<a:int>;..>);;
+let f5 x =
+  (x : <m:'a. [< `A of <p:int> ] as 'a> :> <m:'a. [< `A of < > ] as 'a>);;
+let f6 x =
+  (x : <m:'a. [< `A of < > ] as 'a> :> <m:'a. [< `A of <p:int> ] as 'a>);;
diff --git a/tools/Makefile b/tools/Makefile
index 810558870c..9bc1646efd 100644
--- a/tools/Makefile
+++ b/tools/Makefile
@@ -112,11 +112,6 @@ beforedepend:: ocamlmklib.ml
 clean::
 	rm -f ocamlmklib.ml
 
-# ocamlopt -pack support for Mac OS X: objcopy emulator
-
-install::
-	$(BINUTILS_INSTALL_OBJCOPY) ocaml-objcopy-macosx $(BINUTILS_OBJCOPY)
-
 # Converter olabl/ocaml 2.99 to ocaml 3
 
 OCAML299TO3= lexer299.cmo ocaml299to3.cmo
diff --git a/tools/depend.ml b/tools/depend.ml
index 9c0973e3a0..6b600432bc 100644
--- a/tools/depend.ml
+++ b/tools/depend.ml
@@ -68,11 +68,11 @@ let add_type_declaration bv td =
     td.ptype_cstrs;
   add_opt add_type bv td.ptype_manifest;
   let rec add_tkind = function
-    Ptype_abstract -> ()
+    Ptype_abstract | Ptype_private -> ()
   | Ptype_variant (cstrs, _) ->
-      List.iter (fun (c, args) -> List.iter (add_type bv) args) cstrs
+      List.iter (fun (c, args, _) -> List.iter (add_type bv) args) cstrs
   | Ptype_record (lbls, _) ->
-      List.iter (fun (l, mut, ty) -> add_type bv ty) lbls in
+      List.iter (fun (l, mut, ty, _) -> add_type bv ty) lbls in
   add_tkind td.ptype_kind
 
 let rec add_class_type bv cty =
diff --git a/tools/dumpobj.ml b/tools/dumpobj.ml
index a362c91a10..c52942a123 100644
--- a/tools/dumpobj.ml
+++ b/tools/dumpobj.ml
@@ -65,7 +65,7 @@ let relocate_event orig ev =
   | _                 -> ()
 
 let record_events orig evl =
-  List.iter 
+  List.iter
     (fun ev ->
       relocate_event orig ev;
       Hashtbl.add event_table ev.ev_pos ev)
@@ -83,6 +83,7 @@ let rec print_struct_const = function
     Const_base(Const_int i) -> printf "%d" i
   | Const_base(Const_float f) -> print_float f
   | Const_base(Const_string s) -> printf "%S" s
+  | Const_immstring s -> printf "%S" s
   | Const_base(Const_char c) -> printf "%C" c
   | Const_base(Const_int32 i) -> printf "%ldl" i
   | Const_base(Const_nativeint i) -> printf "%ndn" i
@@ -441,8 +442,8 @@ let print_instr ic =
         done;
   | Pubmet
      -> let tag = inputs ic in
-        let cache = inputu ic in
-	print_int tag
+        let _cache = inputu ic in
+        print_int tag
   | Nothing -> ()
   with Not_found -> print_string "(unknown arguments)"
   end;
@@ -543,4 +544,4 @@ let main() =
   done;
   exit 0
 
-let _ = Printexc.catch main (); exit 0
+let _ = main ()
diff --git a/tools/lexer299.mll b/tools/lexer299.mll
index fa47e5dae3..03d2d8601b 100644
--- a/tools/lexer299.mll
+++ b/tools/lexer299.mll
@@ -326,9 +326,8 @@ rule token = parse
       { let loc = { Location.loc_start = Lexing.lexeme_start_p lexbuf;
                     Location.loc_end = Lexing.lexeme_end_p lexbuf;
                     Location.loc_ghost = false }
-        and warn = Warnings.Comment "the start of a comment"
         in
-        Location.prerr_warning loc warn;
+        Location.prerr_warning loc (Warnings.Comment_start);
         comment_start_pos := [Lexing.lexeme_start lexbuf];
         comment lexbuf;
         token lexbuf
@@ -337,9 +336,8 @@ rule token = parse
       { let loc = { Location.loc_start = Lexing.lexeme_start_p lexbuf;
                     Location.loc_end = Lexing.lexeme_end_p lexbuf;
                     Location.loc_ghost = false }
-        and warn = Warnings.Comment "not the end of a comment"
         in
-        Location.prerr_warning loc warn;
+        Location.prerr_warning loc Warnings.Comment_not_end;
         lexbuf.Lexing.lex_curr_pos <- lexbuf.Lexing.lex_curr_pos - 1;
         STAR
       }
diff --git a/tools/lexer301.mll b/tools/lexer301.mll
index 38de299de0..1c19f7e524 100644
--- a/tools/lexer301.mll
+++ b/tools/lexer301.mll
@@ -327,7 +327,7 @@ rule token = parse
         token lexbuf }
   | "(*)"
       { let loc = Location.curr lexbuf
-        and warn = Warnings.Comment "the start of a comment"
+        and warn = Warnings.Comment_start
         in
         Location.prerr_warning loc warn;
         comment_start_pos := [Lexing.lexeme_start lexbuf];
@@ -336,7 +336,7 @@ rule token = parse
       }
   | "*)"
       { let loc = Location.curr lexbuf
-        and warn = Warnings.Comment "not the end of a comment"
+        and warn = Warnings.Comment_not_end
         in
         Location.prerr_warning loc warn;
         lexbuf.Lexing.lex_curr_pos <- lexbuf.Lexing.lex_curr_pos - 1;
diff --git a/tools/make-package-macosx b/tools/make-package-macosx
index 97f5d2b20d..8822871d71 100755
--- a/tools/make-package-macosx
+++ b/tools/make-package-macosx
@@ -105,6 +105,12 @@ cat >resources/ReadMe.txt <<EOF
 This package installs Objective Caml version ${VERSION}.
 You need Mac OS X 10.3 (panther), with X11 and the
 XCode tools installed.
+
+Files will be installed in the following directories:
+
+/usr/local/bin - command-line executables
+/usr/local/lib/ocaml - library and support files
+/usr/local/man - manual pages
 EOF
 
 chmod -R g-w root
diff --git a/tools/objinfo.ml b/tools/objinfo.ml
index 09f78b7f33..23f5eab3ae 100644
--- a/tools/objinfo.ml
+++ b/tools/objinfo.ml
@@ -96,6 +96,4 @@ let main() =
   done;
   exit 0
 
-let _ = Printexc.catch main (); exit 0
-
-
+let _ = main ()
diff --git a/tools/ocamlcp.ml b/tools/ocamlcp.ml
index 22f1b6f1a8..088ed3327a 100644
--- a/tools/ocamlcp.ml
+++ b/tools/ocamlcp.ml
@@ -47,6 +47,7 @@ module Options = Main_args.Make_options (struct
   let _cc s = option_with_arg "-cc" s
   let _cclib s = option_with_arg "-cclib" s
   let _ccopt s = option_with_arg "-ccopt" s
+  let _config = option "-config"
   let _custom = option "-custom"
   let _dllib = option_with_arg "-dllib"
   let _dllpath = option_with_arg "-dllpath"
@@ -68,11 +69,9 @@ module Options = Main_args.Make_options (struct
   let _output_obj = option "-output-obj"
   let _pack = option "-pack"
   let _pp s = incompatible "-pp"
-(*> JOCAML *)
-  let _join = incompatible "-join"
-(*< JOCAML *)
   let _principal = option "-principal"
   let _rectypes = option "-rectypes"
+  let _join () = option "-join" ()
   let _thread () = option "-thread" ()
   let _vmthread () = option "-vmthread" ()
   let _unsafe = option "-unsafe"
diff --git a/tools/ocamldep.ml b/tools/ocamldep.ml
index 31c783121d..a89e2b1096 100644
--- a/tools/ocamldep.ml
+++ b/tools/ocamldep.ml
@@ -161,7 +161,7 @@ let is_ast_file ic ast_magic =
 
 let parse_use_file ic =
   if is_ast_file ic Config.ast_impl_magic_number then
-    let source_file = input_value ic in
+    let _source_file = input_value ic in
     [Ptop_def (input_value ic : Parsetree.structure)]
   else begin
     seek_in ic 0;
@@ -171,7 +171,7 @@ let parse_use_file ic =
 
 let parse_interface ic =
   if is_ast_file ic Config.ast_intf_magic_number then
-    let source_file = input_value ic in
+    let _source_file = input_value ic in
     (input_value ic : Parsetree.signature)
   else begin
     seek_in ic 0;
@@ -234,6 +234,11 @@ let file_dependencies source_file =
 
 let usage = "Usage: ocamldep [-I <dir>] [-native] <files>"
 
+let print_version () =
+  printf "ocamldep, version %s@." Sys.ocaml_version;
+  exit 0;
+;;
+
 let _ =
   Clflags.classic := false;
   add_to_load_path Filename.current_dir_name;
@@ -245,9 +250,11 @@ let _ =
      "-native", Arg.Set native_only,
        "  Generate dependencies for a pure native-code project \
        (no .cmo files)";
+     "-pp", Arg.String(fun s -> preprocessor := Some s),
+       "<command>  Pipe sources through preprocessor <command>";
      "-slash", Arg.Set force_slash,
        "  (for Windows) Use forward slash / instead of backslash \\ in file paths";
-     "-pp", Arg.String(fun s -> preprocessor := Some s),
-       "<command>  Pipe sources through preprocessor <command>"
+     "-version", Arg.Unit print_version,
+      " Print version and exit";
     ] file_dependencies usage;
   exit (if !error_occurred then 2 else 0)
diff --git a/tools/ocamlmklib.mlp b/tools/ocamlmklib.mlp
index 352f1da3e2..5a613eefe5 100644
--- a/tools/ocamlmklib.mlp
+++ b/tools/ocamlmklib.mlp
@@ -49,6 +49,11 @@ let chop_suffix = Filename.chop_suffix
 
 exception Bad_argument of string
 
+let print_version () =
+  printf "ocamlmklib, version %s\n" Sys.ocaml_version;
+  exit 0;
+;;
+
 let parse_arguments argv =
   let i = ref 1 in
   let next_arg () =
@@ -111,6 +116,8 @@ let parse_arguments argv =
       rpath := chop_prefix s "-Wl,-R" :: !rpath
     else if s = "-v" || s = "-verbose" then
       verbose := true
+    else if s = "-version" then
+      print_version ()
     else if starts_with s "-F" then
       c_opts := s :: !c_opts
     else if s = "-framework" then
@@ -152,6 +159,7 @@ Options are:
   -Wl,-R<dir>          Same as -dllpath <dir>
   -F<dir>        Specify a framework directory (MacOSX)
   -framework <name>    Use framework <name> (MacOSX)
+  -version       Print version and exit
 "
 
 let command cmd =
diff --git a/tools/ocamlmklib.tpl b/tools/ocamlmklib.tpl
deleted file mode 100644
index 5275c91b09..0000000000
--- a/tools/ocamlmklib.tpl
+++ /dev/null
@@ -1,151 +0,0 @@
-#!/bin/sh
-#########################################################################
-#                                                                       #
-#                            Objective Caml                             #
-#                                                                       #
-#           Xavier Leroy, projet Cristal, INRIA Rocquencourt            #
-#                                                                       #
-#   Copyright 2001 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.                #
-#                                                                       #
-#########################################################################
-
-# $Id$
-
-bytecode_objs=''
-native_objs=''
-c_objs=''
-c_libs=''
-c_libs_caml=''
-c_opts=''
-c_opts_caml=''
-caml_opts=''
-caml_libs=''
-ocamlc='%%BINDIR%%/ocamlc'
-ocamlopt='%%BINDIR%%/ocamlopt'
-output='a'
-output_c=''
-sharedldtype='%%SHAREDLDTYPE%%'
-dynlink='%%SUPPORTS_SHARED_LIBRARIES%%'
-custom_opt='-custom'
-failsafe='false'
-
-while :; do
-    case "$1" in
-    "")
-        break;;
-    *.cmo|*.cma)
-        bytecode_objs="$bytecode_objs $1";;
-    *.cmx|*.cmxa)
-        native_objs="$native_objs $1";;
-    *.ml|*.mli)
-        bytecode_objs="$bytecode_objs $1"
-        native_objs="$native_objs $1";;
-    *.o|*.a)
-        c_objs="$c_objs $1";;
-    -cclib)
-        caml_libs="$caml_libs $1 $2"
-        shift;;
-    -ccopt)
-        caml_opts="$caml_opts $1 $2"
-        shift;;
-    -custom)
-        dynlink=false;;
-    -I)
-        caml_opts="$caml_opts $1 $2"
-        shift;;
-    -failsafe)
-        failsafe=true;;
-    -linkall)
-        caml_opts="$caml_opts $1";;
-    -l*)
-        c_libs="$c_libs $1"
-        c_libs_caml="$c_libs_caml -cclib $1";;
-    -L*)
-        c_opts="$c_opts $1"
-        c_opts_caml="$c_opts_caml -ccopt $1";;
-    -ocamlc)
-        ocamlc="$2"
-        shift;;
-    -ocamlopt)
-        ocamlopt="$2"
-        shift;;
-    -o)
-        output="$2"
-        shift;;
-    -oc)
-        output_c="$2"
-        shift;;
-    -pthread)
-        c_opts_caml="$c_opts_caml -ccopt $1";;
-    -R|-rpath)
-        c_opts="$c_opts $1 $2"
-        c_opts_caml="$c_opts_caml -ccopt $1 -ccopt $2"
-        shift;;
-    -R*)
-        c_opts="$c_opts $1"
-        c_opts_caml="$c_opts_caml -ccopt $1";;
-    -Wl,-rpath)
-        case $2 in
-        -Wl,*)
-            rpatharg=`echo $2 | sed "s/^-Wl,//"`
-            if test "$sharedldtype" = "ld"; then
-                c_opts="$c_opts -rpath $rpatharg"
-            else
-                c_opts="$c_opts $1,$rpatharg"
-            fi
-            c_opts_caml="$c_opts_caml -ccopt $1,$rpatharg"
-            shift;;
-        *)
-            echo "No argument to '$1', ignored" 1>&2;;
-        esac;;
-    -Wl,-rpath,*)
-        if test "$sharedldtype" = "ld"; then
-            rpatharg=`echo $1 | sed "s/^-Wl,-rpath,//"`
-            c_opts="$c_opts -rpath $rpatharg"
-        else
-            c_opts="$c_opts $1"
-        fi
-        c_opts_caml="$c_opts_caml -ccopt $1";;
-    -Wl,-R*)
-        if test "$sharedldtype" = "ld"; then
-            rpatharg=`echo $1 | sed "s/^-Wl,-R//"`
-            c_opts="$c_opts -R$rpatharg"
-        else
-            c_opts="$c_opts $1"
-        fi
-        c_opts_caml="$c_opts_caml -ccopt $1";;
-    -*)
-        echo "Unknown option '$1', ignored" 1>&2;;
-    *)
-        echo "Don't know what to do with '$1', ignored" 1>&2;;
-    esac
-    shift
-done
-
-if test "$output_c" = ""; then output_c="$output"; fi
-
-set -e
-
-if test "$c_objs" != ""; then
-    if $dynlink; then
-        %%MKSHAREDLIB%% lib$output_c.so $c_objs $c_opts $c_libs || $failsafe
-    fi
-    rm -f lib$output_c.a
-    ar rc lib$output_c.a $c_objs
-    %%RANLIB%% lib$output_c.a
-fi
-if $dynlink && test "$failsafe" = "false" || test -f lib$output_c.so; then
-    c_libs_caml=''
-    custom_opt=''
-fi
-if test "$bytecode_objs" != ""; then
-     $ocamlc -a $custom_opt -o $output.cma $caml_opts $bytecode_objs \
-        -cclib -l$output_c $caml_libs $c_opts_caml $c_libs_caml
-fi
-if test "$native_objs" != ""; then
-    $ocamlopt -a -o $output.cmxa $caml_opts $native_objs \
-        -cclib -l$output_c $caml_libs $c_opts_caml $c_libs_caml
-fi
-
diff --git a/tools/primreq.ml b/tools/primreq.ml
index cfd6e9af00..a3d5810b65 100644
--- a/tools/primreq.ml
+++ b/tools/primreq.ml
@@ -82,9 +82,9 @@ let main() =
     "Usage: primreq [options] <.cmo and .cma files>\nOptions are:";
   if String.length !exclude_file > 0 then exclude !exclude_file;
   StringSet.iter
-    (fun s -> 
+    (fun s ->
       if s.[0] <> '%' then begin print_string s; print_newline() end)
     !primitives;
   exit 0
 
-let _ = Printexc.catch main (); exit 0
+let _ = main ()
diff --git a/toplevel/genprintval.ml b/toplevel/genprintval.ml
index 981ba21f55..97c4e02995 100644
--- a/toplevel/genprintval.ml
+++ b/toplevel/genprintval.ml
@@ -293,7 +293,7 @@ module Make(O : OBJ)(EVP : EVALPATH with type value = O.t) = struct
                   | (l, f) :: fields ->
                       if Btype.hash_variant l = tag then
                         match Btype.row_field_repr f with
-                        | Rpresent(Some ty) ->
+                        | Rpresent(Some ty) | Reither(_,[ty],_,_) ->
                             let args =
                               tree_of_val (depth - 1) (O.field obj 1) ty in
                             Oval_variant (l, Some args)
diff --git a/toplevel/topdirs.ml b/toplevel/topdirs.ml
index eac3581f0c..6b12c6a026 100644
--- a/toplevel/topdirs.ml
+++ b/toplevel/topdirs.ml
@@ -179,9 +179,9 @@ let dir_install_printer ppf lid =
     let v = eval_path path in
     let print_function =
       if is_old_style then
-        (fun formatter repr -> (Obj.obj v) (Obj.obj repr))
+        (fun formatter repr -> Obj.obj v (Obj.obj repr))
       else
-        (fun formatter repr -> (Obj.obj v) formatter (Obj.obj repr)) in
+        (fun formatter repr -> Obj.obj v formatter (Obj.obj repr)) in
     install_printer path ty_arg print_function
   with Exit -> ()
 
diff --git a/toplevel/toploop.ml b/toplevel/toploop.ml
index 1e2037d5d1..e0a51ddd2c 100644
--- a/toplevel/toploop.ml
+++ b/toplevel/toploop.ml
@@ -148,7 +148,7 @@ let load_lambda ppf lam =
 
 (* Print the outcome of an evaluation *)
 
-let pr_item env = function
+let rec pr_item env = function
   | Tsig_value(id, decl) :: rem ->
       let tree = Printtyp.tree_of_value_description id decl in
       let valopt =
@@ -162,6 +162,8 @@ let pr_item env = function
             Some v
       in
       Some (tree, valopt, rem)
+  | Tsig_type(id, _, _) :: rem when Btype.is_row_name (Ident.name id) ->
+      pr_item env rem
   | Tsig_type(id, decl, rs) :: rem ->
       let tree = Printtyp.tree_of_type_declaration id decl rs in
       Some (tree, None, rem)
@@ -339,7 +341,8 @@ let read_interactive_input = ref read_input_default
 let refill_lexbuf buffer len =
   if !got_eof then (got_eof := false; 0) else begin
     let prompt =
-      if !first_line then "# "
+      if !Clflags.noprompt then ""
+      else if !first_line then "# "
       else if Lexer.in_comment () then "* "
       else "  "
     in
@@ -367,11 +370,16 @@ let _ =
     crc_intfs
 
 let load_ocamlinit ppf =
-  let home_init = 
-    try Filename.concat (Sys.getenv "HOME") ".ocamlinit"
-    with Not_found -> ".ocamlinit" in
-  if Sys.file_exists ".ocamlinit" then ignore(use_silently ppf ".ocamlinit")
-  else if Sys.file_exists home_init then ignore(use_silently ppf home_init)
+  match !Clflags.init_file with
+  | Some f -> if Sys.file_exists f then ignore (use_silently ppf f)
+              else fprintf ppf "Init file not found: \"%s\".@." f
+  | None ->
+     if Sys.file_exists ".ocamlinit" then ignore (use_silently ppf ".ocamlinit")
+     else try
+       let home_init = Filename.concat (Sys.getenv "HOME") ".ocamlinit" in
+       if Sys.file_exists home_init then ignore (use_silently ppf home_init)
+     with Not_found -> ()
+;;
 
 let set_paths () =
   (* Add whatever -I options have been specified on the command line,
diff --git a/toplevel/topmain.ml b/toplevel/topmain.ml
index 76d571fb78..15e9592f64 100644
--- a/toplevel/topmain.ml
+++ b/toplevel/topmain.ml
@@ -44,6 +44,11 @@ let file_argument name =
       then exit 0
       else exit 2
     end
+
+let print_version () =
+  Printf.printf "The Objective Caml toplevel, version %s\n" Sys.ocaml_version;
+  exit 0;
+;;
 (*> JOCAML *)
 let magic_join () =
   join := true ;
@@ -61,17 +66,21 @@ let main () =
        let dir = Misc.expand_directory Config.standard_library dir in
        include_dirs := dir :: !include_dirs),
            "<dir>  Add <dir> to the list of include directories";
+     "-init", Arg.String (fun s -> init_file := Some s),
+           "<file>  Load <file> instead of default init file";
 (*> JOCAML *)
     "-join", Arg.Unit magic_join, " Be a jocaml toplevel";
 (*< JOCAML *)    
      "-labels", Arg.Clear classic, " Labels commute (default)";
      "-noassert", Arg.Set noassert, " Do not compile assertion checks";
      "-nolabels", Arg.Set classic, " Ignore labels and do not commute";
+     "-noprompt", Arg.Set noprompt, " Suppress all prompts";
      "-nostdlib", Arg.Set no_std_include,
            " do not add default directory to the list of include directories";
      "-principal", Arg.Set principal, " Check principality of type inference";
      "-rectypes", Arg.Set recursive_types, " Allow arbitrary recursive types";
      "-unsafe", Arg.Set fast, " No bound checking on array and string access";
+     "-version", Arg.Unit print_version, " Print version and exit";
      "-w", Arg.String (Warnings.parse_options false),
            "<flags>  Enable or disable warnings according to <flags>:\n\
        \032    A/a enable/disable all warnings\n\
@@ -85,11 +94,12 @@ let main () =
        \032    S/s enable/disable non-unit statement\n\
        \032    U/u enable/disable unused match case\n\
        \032    V/v enable/disable hidden instance variable\n\
+       \032    Y/y enable/disable suspicious unused variables\n\
+       \032    Z/z enable/disable all other unused variables\n\
        \032    X/x enable/disable all other warnings\n\
-       \032    default setting is \"Ale\"\n\
-       \032    (all warnings but labels and fragile match enabled)";
+       \032    default setting is \"Aelz\"";
      "-warn-error" , Arg.String (Warnings.parse_options true),
-       "<flags>  Enable or disable fatal warnings according to <flags>\n\
+       "<flags>  Treat the warnings of <flags> as errors, if they are enabled.\n\
          \032    (see option -w for the list of flags)\n\
          \032    default setting is a (all warnings are non-fatal)";