merge changes of version/4.02 from r15121 to r15155

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

5 files changed, 88 insertions, 35 deletions

diff --git a/ocamlbuild/log.ml b/ocamlbuild/log.ml
index 6e3ac15010..d50969e341 100644
--- a/ocamlbuild/log.ml
+++ b/ocamlbuild/log.ml
@@ -49,19 +49,30 @@ let event ?pretend x = Display.event !-internal_display ?pretend x
 let display x = Display.display !-internal_display x
 
 let do_at_end = Queue.create ()
+let already_asked = Hashtbl.create 10
 
-let at_end_always thunk = Queue.add thunk do_at_end
-let at_end thunk = at_end_always (function
+let at_end_always ~name thunk =
+  if not (Hashtbl.mem already_asked name) then begin
+    Hashtbl.add already_asked name ();
+    Queue.add thunk do_at_end;
+  end
+
+let at_end ~name thunk = at_end_always ~name (function
   | `Quiet -> ()
   | `Success | `Error -> thunk `Error)
-let at_failure thunk = at_end_always (function
+let at_failure ~name thunk = at_end_always ~name (function
   | `Success | `Quiet -> ()
   | `Error -> thunk `Error)
 
 let finish ?how () =
-  Queue.iter (fun thunk ->
-    thunk (match how with None -> `Quiet | Some how -> how)
-  ) do_at_end;
+  while not (Queue.is_empty do_at_end) do
+    let actions = Queue.copy do_at_end in
+    Queue.clear do_at_end;
+    (* calling a thunk may add new actions again, hence the loop *)
+    Queue.iter (fun thunk ->
+      thunk (match how with None -> `Quiet | Some how -> how)
+    ) actions;
+  done;
   match !internal_display with
   | None -> ()
   | Some d -> Display.finish ?how d
diff --git a/ocamlbuild/log.mli b/ocamlbuild/log.mli
index f174a19791..413a476dd5 100644
--- a/ocamlbuild/log.mli
+++ b/ocamlbuild/log.mli
@@ -34,6 +34,11 @@ val update : unit -> unit
 val mode : string -> bool
 
 (** Wrap logging event so that only fire at the end of the compilation
-    process, possibly depending on the termination status. *)
-val at_end : ([> `Error | `Quiet ] -> unit) -> unit
-val at_failure : ([> `Error ] -> unit) -> unit
+    process, possibly depending on the termination status.
+
+    The name is used to avoid printing the same hint/warning twice,
+    even if [at_end] is called several times. Use different names for
+    distinct events.
+*)
+val at_end : name:string -> ([> `Error | `Quiet ] -> unit) -> unit
+val at_failure : name:string -> ([> `Error ] -> unit) -> unit
diff --git a/ocamlbuild/ocaml_compiler.ml b/ocamlbuild/ocaml_compiler.ml
index 99186ad37e..c270a7f637 100644
--- a/ocamlbuild/ocaml_compiler.ml
+++ b/ocamlbuild/ocaml_compiler.ml
@@ -116,25 +116,30 @@ let prepare_compile build ml =
     match mandatory, res with
     | _, Good _ -> ()
     | `mandatory, Bad exn ->
-        if not !Options.ignore_auto then raise exn
-        else dprintf 3
+        if not !Options.ignore_auto then raise exn;
+        dprintf 3
           "Warning: Failed to build the module %s requested by ocamldep."
           name;
-        Log.at_failure (fun `Error ->
-          eprintf "Hint:@ Recursive@ traversal@ of@ subdirectories@ \
-            was@ not@ enabled@ for@ this@ build,@ as@ the@ working@ \
-            directory does@ not@ look@ like@ an@ ocamlbuild@ project@ \
-            (no@ '_tags'@ or@ 'myocamlbuild.ml'@ file).@ \
-            If@ you@ have@ modules@ in@ subdirectories,@ you@ should@ add@ \
-            the@ option@ \"-r\"@ or@ create@ an@ empty@ '_tags'@ file.@\n\
-            @\n\
-            To@ enable@ recursive@ traversal@ for@ some@ subdirectories@ \
-            only,@ you@ can@ use@ the@ following@ '_tags'@ file:@\n\
-            @[<v 4>@,\
-              true: -traverse@,\
-              <dir1> or <dir2>: traverse@,\
-            @]"
-        );
+        if not (!Options.recursive || Options.ocamlbuild_project_heuristic ())
+        then Log.at_failure ~name:"a module failed to build,
+           while recursive traversal was disabled by fragile heuristic;
+           hint that having a _tags or myocamlbuild.ml would maybe solve
+           the build error"
+          (fun `Error ->
+            eprintf "Hint:@ Recursive@ traversal@ of@ subdirectories@ \
+              was@ not@ enabled@ for@ this@ build,@ as@ the@ working@ \
+              directory does@ not@ look@ like@ an@ ocamlbuild@ project@ \
+              (no@ '_tags'@ or@ 'myocamlbuild.ml'@ file).@ \
+              If@ you@ have@ modules@ in@ subdirectories,@ you@ should@ add@ \
+              the@ option@ \"-r\"@ or@ create@ an@ empty@ '_tags'@ file.@\n\
+              @\n\
+              To@ enable@ recursive@ traversal@ for@ some@ subdirectories@ \
+              only,@ you@ can@ use@ the@ following@ '_tags'@ file:@\n\
+              @[<v 4>@,\
+                true: -traverse@,\
+                <dir1> or <dir2>: traverse@,\
+              @]"
+          );
     | `just_try, Bad _ -> ()
   end modules results
 
diff --git a/ocamlbuild/ocaml_specific.ml b/ocamlbuild/ocaml_specific.ml
index 43605d361e..134a153325 100644
--- a/ocamlbuild/ocaml_specific.ml
+++ b/ocamlbuild/ocaml_specific.ml
@@ -598,18 +598,22 @@ let () =
     (fun param -> S [A "-for-pack"; A param]);
   pflag ["ocaml"; "native"; "compile"] "inline"
     (fun param -> S [A "-inline"; A param]);
-  pflag ["ocaml"; "compile"] "pp"
-    (fun param -> S [A "-pp"; A param]);
-  pflag ["ocaml"; "ocamldep"] "pp"
-    (fun param -> S [A "-pp"; A param]);
-  pflag ["ocaml"; "doc"] "pp"
-    (fun param -> S [A "-pp"; A param]);
-  pflag ["ocaml"; "infer_interface"] "pp"
-    (fun param -> S [A "-pp"; A param]);
+  List.iter (fun pp ->
+    pflag ["ocaml"; "compile"] pp
+      (fun param -> S [A ("-" ^ pp); A param]);
+    pflag ["ocaml"; "ocamldep"] pp
+      (fun param -> S [A ("-" ^ pp); A param]);
+    pflag ["ocaml"; "doc"] pp
+      (fun param -> S [A ("-" ^ pp); A param]);
+    pflag ["ocaml"; "infer_interface"] pp
+      (fun param -> S [A ("-" ^ pp); A param])
+  ) ["pp"; "ppx"];
   pflag ["ocaml";"compile";] "warn"
     (fun param -> S [A "-w"; A param]);
   pflag ["ocaml";"compile";] "warn_error"
     (fun param -> S [A "-warn-error"; A param]);
+  pflag ["ocaml"; "compile"] "open"
+    (fun param -> S [A "-open"; A param]);
   ()
 
 let camlp4_flags camlp4s =
@@ -683,6 +687,14 @@ flag ["ocaml"; "link"; "program"; "custom"; "byte"] (A "-custom");;
 flag ["ocaml"; "link"; "library"; "custom"; "byte"] (A "-custom");;
 flag ["ocaml"; "compile"; "profile"; "native"] (A "-p");;
 flag ["ocaml"; "compile"; "no_alias_deps";] (A "-no-alias-deps");;
+flag ["ocaml"; "compile"; "strict_formats";] (A "-strict-formats");;
+flag ["ocaml"; "native"; "compile"; "opaque";] (A "-opaque");;
+flag ["ocaml"; "native"; "compile"; "no_float_const_prop";] (A "-no-float-const-prop");
+flag ["ocaml"; "compile"; "keep_locs";] (A "-keep-locs");
+flag ["ocaml"; "absname"; "compile"] (A "-absname");;
+flag ["ocaml"; "absname"; "infer_interface"] (A "-absname");;
+flag ["ocaml"; "byte"; "compile"; "compat_32";] (A "-compat-32");
+
 
 (* threads, with or without findlib *)
 flag ["ocaml"; "compile"; "thread"] (A "-thread");;
diff --git a/ocamlbuild/testsuite/internal.ml b/ocamlbuild/testsuite/internal.ml
index fec20c7465..fc7ff98dd3 100644
--- a/ocamlbuild/testsuite/internal.ml
+++ b/ocamlbuild/testsuite/internal.ml
@@ -162,7 +162,7 @@ let () = test "OutputObj"
 
 let () = test "StrictSequenceFlag"
   ~options:[`no_ocamlfind; `quiet]
-  ~description:"-strict_sequence tag"
+  ~description:"strict_sequence tag"
   ~tree:[T.f "hello.ml" ~content:"let () = 1; ()";
          T.f "_tags" ~content:"true: strict_sequence\n"]
   ~failing_msg:"File \"hello.ml\", line 1, characters 9-10:
@@ -170,6 +170,17 @@ Error: This expression has type int but an expression was expected of type
          unit\nCommand exited with code 2."
   ~targets:("hello.byte",[]) ();;
 
+let () = test "StrictFormatsFlag"
+  ~options:[`no_ocamlfind; `quiet]
+  ~description:"strict_format tag"
+  ~tree:[T.f "hello.ml" ~content:"let _ = Printf.printf \"%.10s\"";
+         T.f "_tags" ~content:"true: strict_formats\n"]
+  ~failing_msg:"File \"hello.ml\", line 1, characters 22-29:
+Error: invalid format \"%.10s\": at character number 0, \
+`precision' is incompatible with 's' in sub-format \"%.10s\"
+Command exited with code 2."
+  ~targets:("hello.byte",[]) ();;
+
 let () = test "PrincipalFlag"
   ~options:[`no_ocamlfind; `quiet]
   ~description:"-principal tag"
@@ -282,5 +293,14 @@ debug, rectypes
   ~matching:[M.f "main.byte"]
   ~targets:("main.byte",[]) ();;
 
+let () = test "OpenTag"
+  ~description:"Test the parametrized tag for the new -open feature"
+  ~options:[`no_ocamlfind]
+  ~tree:[
+    T.f "test.ml" ~content:"let _ = map rev [ []; [3;2] ]";
+    T.f "_tags" ~content: "<test.*>: open(List)";
+  ]
+  ~matching:[M.f "test.byte"]
+  ~targets:("test.byte",[]) ();;
 
 run ~root:"_test_internal";;