Fix OCAMLPARAM problems

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

driver/compenv.ml

@@ -45,12 +45,6 @@ let default_output = function
   | Some s -> s
   | None -> Config.default_executable_name
 
-(* Initialize the search path.
-   The current directory is always searched first,
-   then the directories specified with the -I option (in command-line order),
-   then the standard library directory (unless the -nostdlib option is given).
- *)
-
 let implicit_modules = ref []
 let first_include_dirs = ref []
 let last_include_dirs = ref []
@@ -91,75 +85,9 @@ let check_unit_name ppf filename name =
 type readenv_position =
   Before_args | Before_compile | Before_link
 
-(* Syntax of OCAMLCOMPPARAM: (name=VALUE)(,name=VALUE)* where
-   VALUE=expression without ,
-*)
+(* Syntax of OCAMLPARAM: [name=VALUE,]*_[,name=VALUE] where VALUE should not contain ',' *)
 exception SyntaxError of string
 
-(*
-let parse_args s =
-  let len = String.length s in
-  let rec iter0 i pos0 =
-    if i = len then
-      if i = pos0 then []
-      else raise (SyntaxError "End of line while expecting char '='")
-    else
-    let c = s.[i] in
-    let pos1 = i+1 in
-    if c = '=' then
-      iter1 pos1 pos1 (String.sub s pos0 (i-pos0))
-    else iter0 pos1 pos0
-
-  and iter1 i pos0 name =
-    if i = len then [name, ""]
-    else
-      let c = s.[i] in
-      let pos1 = i+1 in
-      match c with
-        '"' ->
-        iter3 pos1 (Buffer.create 50) name
-      | ',' ->
-        (name, "") :: iter0 pos1 pos1
-      | _ ->
-        iter2 pos1 pos0 name
-
-  and iter2 i pos0 name =
-    if i = len then [name, String.sub s pos0 (len-pos0)]
-    else
-      let pos1 = i+1 in
-      match s.[i] with
-      | ',' ->
-        (name, String.sub s pos0 (i-pos0)) :: iter0 pos1 pos1
-      | _ -> iter2 pos1 pos0 name
-
-  and iter3 i b name =
-    if i = len then
-      raise (SyntaxError "End of line while expecting '\"'")
-    else
-      let pos1 = i+1 in
-      match s.[i] with
-      | '"' ->
-        if pos1 = len then
-          [name, Buffer.contents b]
-        else begin
-          let pos2 = pos1+1 in
-          match s.[pos1] with
-          | '"' ->
-            Buffer.add_char b '"';
-            iter3 pos2 b name
-          | ',' ->
-            (name, Buffer.contents b) :: iter0 pos2 pos2
-          | _ ->
-            raise (SyntaxError "Syntax error while expecting ',' after '\"'")
-        end
-      | c ->
-        Buffer.add_char b c;
-        iter3 pos1 b name
-
-  in
-  iter0 0 0
-*)
-
 let parse_args s =
   let args = Misc.split s ',' in
   let rec iter is_after args before after =
@@ -184,7 +112,7 @@ let parse_args s =
   in
   iter false args [] []
 
-let setter f name options s =
+let setter ppf f name options s =
   try
     let bool = match s with
       | "0" -> false
@@ -193,26 +121,25 @@ let setter f name options s =
     in
     List.iter (fun b -> b := f bool) options
   with Not_found ->
-    Printf.eprintf "Warning: bad value for %S in OCAMLPARAM\n%!" name
-
-let set name options s =
-  setter (fun b -> b) name options s
-
-let clear name options s =
-  setter (fun b -> not b) name options s
+    Location.print_warning Location.none ppf
+      (Warnings.Bad_env_variable ("OCAMLPARAM", Printf.sprintf "bad value for %s" name))
 
-let read_OCAMLPARAM position =
+let read_OCAMLPARAM ppf position =
   try
     let s = Sys.getenv "OCAMLPARAM" in
     let (before, after) =
       try
         parse_args s
       with SyntaxError s ->
-        fatal (Printf.sprintf "Illegal syntax of OCAMLPARAM: %s" s)
+         Location.print_warning Location.none ppf
+           (Warnings.Bad_env_variable ("OCAMLPARAM", s));
+         [],[]
     in
+
+    let set name options s =  setter ppf (fun b -> b) name options s in
+    let clear name options s = setter ppf (fun b -> not b) name options s in
     List.iter (fun (name, v) ->
       match name with
-
       | "g" -> set "g" [ Clflags.debug ] v
       | "p" -> set "p" [ Clflags.gprofile ] v
       | "bin-annot" -> set "bin-annot" [ Clflags.binary_annotations ] v
@@ -240,7 +167,6 @@ let read_OCAMLPARAM position =
 
       | "pp" -> preprocessor := Some v
       | "runtime-variant" -> runtime_variant := v
-      | "open" -> implicit_modules := Misc.split v ','
       | "cc" -> c_compiler := Some v
 
       (* assembly sources *)
@@ -260,8 +186,8 @@ let read_OCAMLPARAM position =
       | "inline" -> begin try
           inline_threshold := 8 * int_of_string v
         with _ ->
-          Printf.eprintf
-            "Warning: discarding non integer value of inline from OCAMLCOMPPARAM\n%!"
+          Location.print_warning Location.none ppf
+            (Warnings.Bad_env_variable ("OCAMLPARAM", "value for inline should be an interger"))
         end
 
       | "intf-suffix" -> Config.interface_suffix := v
@@ -322,19 +248,19 @@ let read_OCAMLPARAM position =
 
       | _ ->
         Printf.eprintf
-            "Warning: discarding value of variable %S in OCAMLCOMPPARAM\n%!"
+            "Warning: discarding value of variable %S in OCAMLPARAM\n%!"
             name
     ) (match position with
         Before_args -> before
       | Before_compile | Before_link -> after)
   with Not_found -> ()
 
-let readenv position =
+let readenv ppf position =
   last_include_dirs := [];
   last_ccopts := [];
   last_ppx := [];
   last_objfiles := [];
-  read_OCAMLPARAM position;
+  read_OCAMLPARAM ppf position;
   all_ccopts := !last_ccopts @ !first_ccopts;
   all_ppx := !last_ppx @ !first_ppx
 

driver/compenv.mli

@@ -33,4 +33,4 @@ val get_objfiles : unit -> string list
 type readenv_position =
   Before_args | Before_compile | Before_link
 
-val readenv : readenv_position -> unit
+val readenv : Format.formatter -> readenv_position -> unit

driver/main.ml

@@ -58,11 +58,11 @@ let ppf = Format.err_formatter
 
 (* Error messages to standard error formatter *)
 let anonymous filename =
-  readenv Before_compile; process_file ppf filename;;
+  readenv ppf Before_compile; process_file ppf filename;;
 let impl filename =
-  readenv Before_compile; process_implementation_file ppf filename;;
+  readenv ppf Before_compile; process_implementation_file ppf filename;;
 let intf filename =
-  readenv Before_compile; process_interface_file ppf filename;;
+  readenv ppf Before_compile; process_interface_file ppf filename;;
 
 let show_config () =
   Config.print_config stdout;
@@ -135,9 +135,9 @@ end)
 
 let main () =
   try
-    readenv Before_args;
+    readenv ppf Before_args;
     Arg.parse Options.list anonymous usage;
-    readenv Before_link;
+    readenv ppf Before_link;
     if
       List.length (List.filter (fun x -> !x)
                       [make_archive;make_package;compile_only;output_c_object])

driver/optmain.ml

@@ -57,11 +57,11 @@ let ppf = Format.err_formatter
 
 (* Error messages to standard error formatter *)
 let anonymous filename =
-  readenv Before_compile; process_file ppf filename;;
+  readenv ppf Before_compile; process_file ppf filename;;
 let impl filename =
-  readenv Before_compile; process_implementation_file ppf filename;;
+  readenv ppf Before_compile; process_implementation_file ppf filename;;
 let intf filename =
-  readenv Before_compile; process_interface_file ppf filename;;
+  readenv ppf Before_compile; process_interface_file ppf filename;;
 
 let show_config () =
   Config.print_config stdout;
@@ -150,9 +150,9 @@ let main () =
   native_code := true;
   let ppf = Format.err_formatter in
   try
-    readenv Before_args;
+    readenv ppf Before_args;
     Arg.parse (Arch.command_line_options @ Options.list) anonymous usage;
-    readenv Before_link;
+    readenv ppf Before_link;
     if
       List.length (List.filter (fun x -> !x)
                      [make_package; make_archive; shared;

tools/ocamldep.ml

@@ -13,7 +13,7 @@
 open Compenv
 open Parsetree
 
-
+let ppf = Format.err_formatter
 (* Print the dependencies *)
 
 type file_kind = ML | MLI;;
@@ -300,7 +300,7 @@ let mli_file_dependencies source_file =
     end
 
 let file_dependencies_as kind source_file =
-  Compenv.readenv Before_compile;
+  Compenv.readenv ppf Before_compile;
   load_path := [];
   List.iter add_to_load_path (
       (!Compenv.last_include_dirs @
@@ -413,7 +413,7 @@ let print_version_num () =
 let _ =
   Clflags.classic := false;
   first_include_dirs := Filename.current_dir_name :: !first_include_dirs;
-  Compenv.readenv Before_args;
+  Compenv.readenv ppf Before_args;
   Arg.parse [
      "-absname", Arg.Set Location.absname,
         " Show absolute filenames in error messages";
@@ -448,6 +448,6 @@ let _ =
      "-vnum", Arg.Unit print_version_num,
          " Print version number and exit";
     ] file_dependencies usage;
-  Compenv.readenv Before_link;
+  Compenv.readenv ppf Before_link;
   if !sort_files then sort_files_by_dependencies !files;
   exit (if !error_occurred then 2 else 0)

toplevel/topmain.ml

@@ -96,8 +96,9 @@ end);;
 
 
 let main () =
-  Compenv.readenv Before_args;
+  let ppf = Format.err_formatter in
+  Compenv.readenv ppf Before_args;
   Arg.parse Options.list file_argument usage;
-  Compenv.readenv Before_link;
-  if not (prepare Format.err_formatter) then exit 2;
+  Compenv.readenv ppf Before_link;
+  if not (prepare ppf) then exit 2;
   Toploop.loop Format.std_formatter

utils/warnings.ml

@@ -63,6 +63,7 @@ type t =
   | Nonoptional_label of string             (* 43 *)
   | Open_shadow_identifier of string * string (* 44 *)
   | Open_shadow_label_constructor of string * string (* 45 *)
+  | Bad_env_variable of string * string     (* 46 *)
 ;;
 
 (* If you remove a warning, leave a hole in the numbering.  NEVER change
@@ -117,10 +118,10 @@ let number = function
   | Nonoptional_label _ -> 43
   | Open_shadow_identifier _ -> 44
   | Open_shadow_label_constructor _ -> 45
-
+  | Bad_env_variable _ -> 46
 ;;
 
-let last_warning_number = 45
+let last_warning_number = 46
 (* Must be the max number returned by the [number] function. *)
 
 let letter = function
@@ -345,6 +346,8 @@ let message = function
       Printf.sprintf
         "this open statement shadows the %s %s (which is later used)"
         kind s
+  | Bad_env_variable (var, s) ->
+    Printf.sprintf "illegal environment variable %s : %s" var s
 ;;
 
 let nerrors = ref 0;;

utils/warnings.mli

@@ -58,6 +58,7 @@ type t =
   | Nonoptional_label of string             (* 43 *)
   | Open_shadow_identifier of string * string (* 44 *)
   | Open_shadow_label_constructor of string * string (* 45 *)
+  | Bad_env_variable of string * string
 ;;
 
 val parse_options : bool -> string -> unit;;