From b22acd0f9f0f67574df7c015fede71b97a77c95b Mon Sep 17 00:00:00 2001
From: Wojciech Meyer <wojciech.meyer@gmail.com>
Date: Mon, 19 Nov 2012 05:37:26 +0000
Subject: [PATCH] PR#5723: Add environment variables to control compiler options.

---
 driver/main.ml        |    4 +++-
 driver/main_args.ml   |   18 +++++++++++++++++-
 driver/main_args.mli  |   19 +++++++++++++++++--
 driver/optmain.ml     |    3 ++-
 tools/Makefile.shared |    4 ++--
 tools/ocamlcp.ml      |    4 +++-
 tools/ocamldep.ml     |    2 +-
 tools/ocamloptp.ml    |    2 ++
 utils/misc.ml         |   22 +++++++++++++++++++++-
 utils/misc.mli        |   10 ++++++++++
 10 files changed, 78 insertions(+), 10 deletions(-)

diff --git a/driver/main.ml b/driver/main.ml
index b3d5842..e11738a 100644
--- a/driver/main.ml
+++ b/driver/main.ml
@@ -88,6 +88,8 @@ let show_config () =
 module Options = Main_args.Make_bytecomp_options (struct
   let set r () = r := true
   let unset r () = r := false
+
+  let env_var = Main_args.Environment_variables._OCAMLCFLAGS
   let _a = set make_archive
   let _absname = set Location.absname
   let _annot = set annotations
@@ -160,7 +162,7 @@ let default_output = function
 
 let main () =
   try
-    Arg.parse Options.list anonymous usage;
+    Options.parse Options.list anonymous usage;
     if
       List.length (List.filter (fun x -> !x)
                       [make_archive;make_package;compile_only;output_c_object])
diff --git a/driver/main_args.ml b/driver/main_args.ml
index 3f3e063..40509c1 100644
--- a/driver/main_args.ml
+++ b/driver/main_args.ml
@@ -10,6 +10,13 @@
 (*                                                                     *)
 (***********************************************************************)
 
+(* Environment variable names controling additional options passed *)
+module Environment_variables = struct
+  let _OCAMLCFLAGS = "OCAMLCFLAGS"
+  let _OCAMLOPTFLAGS = "OCAMLOPTFLAGS"
+end
+
+(* Command line options constructors *)
 let mk_a f =
   "-a", Arg.Unit f, " Build a library"
 ;;
@@ -404,6 +411,7 @@ let mk__ f =
 ;;
 
 module type Bytecomp_options = sig
+  val env_var : string
   val _a : unit -> unit
   val _absname : unit -> unit
   val _annot : unit -> unit
@@ -495,6 +503,7 @@ module type Bytetop_options = sig
 end;;
 
 module type Optcomp_options = sig
+  val env_var : string
   val _a : unit -> unit
   val _absname : unit -> unit
   val _annot : unit -> unit
@@ -615,11 +624,17 @@ module type Opttop_options = sig
 end;;
 
 module type Arg_list = sig
-    val list : (string * Arg.spec * string) list
+  val list : (string * Arg.spec * string) list
+end;;
+
+module type Arg_list_with_env = sig
+  val parse : (Arg.key * Arg.spec * Arg.doc) list ->  Arg.anon_fun -> Arg.usage_msg -> unit
+  include Arg_list
 end;;
 
 module Make_bytecomp_options (F : Bytecomp_options) =
 struct
+  let parse = Misc.parse_arguments ~env_var:F.env_var
   let list = [
     mk_a F._a;
     mk_absname F._absname;
@@ -723,6 +738,7 @@ end;;
 
 module Make_optcomp_options (F : Optcomp_options) =
 struct
+  let parse = Misc.parse_arguments ~env_var:F.env_var
   let list = [
     mk_a F._a;
     mk_absname F._absname;
diff --git a/driver/main_args.mli b/driver/main_args.mli
index 80e659e..a09fee7 100644
--- a/driver/main_args.mli
+++ b/driver/main_args.mli
@@ -10,8 +10,15 @@
 (*                                                                     *)
 (***********************************************************************)
 
+(* Environment variable names controling additional options passed *)
+module Environment_variables : sig
+  val _OCAMLCFLAGS : string
+  val _OCAMLOPTFLAGS : string
+end
+
 module type Bytecomp_options =
   sig
+    val env_var : string
     val _a : unit -> unit
     val _absname : unit -> unit
     val _annot : unit -> unit
@@ -104,6 +111,7 @@ module type Bytetop_options = sig
 end;;
 
 module type Optcomp_options = sig
+  val env_var : string
   val _a : unit -> unit
   val _absname : unit -> unit
   val _annot : unit -> unit
@@ -223,11 +231,18 @@ module type Opttop_options = sig
   val anonymous : string -> unit
 end;;
 
+
 module type Arg_list = sig
     val list : (string * Arg.spec * string) list
 end;;
 
-module Make_bytecomp_options (F : Bytecomp_options) : Arg_list;;
+module type Arg_list_with_env = sig
+  val parse : (Arg.key * Arg.spec * Arg.doc) list -> Arg.anon_fun -> Arg.usage_msg -> unit
+  include Arg_list
+end;;
+
+
+module Make_bytecomp_options (F : Bytecomp_options) : Arg_list_with_env;;
 module Make_bytetop_options (F : Bytetop_options) : Arg_list;;
-module Make_optcomp_options (F : Optcomp_options) : Arg_list;;
+module Make_optcomp_options (F : Optcomp_options) : Arg_list_with_env;;
 module Make_opttop_options (F : Opttop_options) : Arg_list;;
diff --git a/driver/optmain.ml b/driver/optmain.ml
index 84d6fd0..1ece6a4 100644
--- a/driver/optmain.ml
+++ b/driver/optmain.ml
@@ -99,6 +99,7 @@ module Options = Main_args.Make_optcomp_options (struct
   let set r () = r := true
   let clear r () = r := false
 
+  let env_var = Main_args.Environment_variables._OCAMLOPTFLAGS
   let _a = set make_archive
   let _absname = set Location.absname
   let _annot = set annotations
@@ -175,7 +176,7 @@ let main () =
   native_code := true;
   let ppf = Format.err_formatter in
   try
-    Arg.parse (Arch.command_line_options @ Options.list) anonymous usage;
+    Options.parse (Arch.command_line_options @ Options.list) anonymous usage;
     if
       List.length (List.filter (fun x -> !x)
                      [make_package; make_archive; shared;
diff --git a/tools/Makefile.shared b/tools/Makefile.shared
index 5039605..acff962 100644
--- a/tools/Makefile.shared
+++ b/tools/Makefile.shared
@@ -70,10 +70,10 @@ ocamlprof: $(CSLPROF) profiling.cmo
 	$(CAMLC) $(LINKFLAGS) -o ocamlprof $(CSLPROF_IMPORTS) $(CSLPROF)
 
 ocamlcp: ocamlcp.cmo
-	$(CAMLC) $(LINKFLAGS) -o ocamlcp warnings.cmo main_args.cmo ocamlcp.cmo
+	$(CAMLC) $(LINKFLAGS) -o ocamlcp misc.cmo warnings.cmo main_args.cmo ocamlcp.cmo
 
 ocamloptp: ocamloptp.cmo
-	$(CAMLC) $(LINKFLAGS) -o ocamloptp warnings.cmo main_args.cmo \
+	$(CAMLC) $(LINKFLAGS) -o ocamloptp misc.cmo warnings.cmo main_args.cmo \
 	         ocamloptp.cmo
 
 opt:: profiling.cmx
diff --git a/tools/ocamlcp.ml b/tools/ocamlcp.ml
index b611094..e75f2d0 100644
--- a/tools/ocamlcp.ml
+++ b/tools/ocamlcp.ml
@@ -40,6 +40,8 @@ let incompatible o =
   exit 2
 
 module Options = Main_args.Make_bytecomp_options (struct
+  let env_var = Main_args.Environment_variables._OCAMLCFLAGS
+
   let _a () = make_archive := true; option "-a" ()
   let _absname = option "-absname"
   let _annot = option "-annot"
@@ -114,7 +116,7 @@ let optlist =
     :: ("-p", Arg.String add_profarg, "[afilmt]  Same as option -P")
     :: Options.list
 in
-Arg.parse optlist process_file usage;
+Options.parse optlist process_file usage;
 if !with_impl && !with_intf then begin
   fprintf stderr "ocamlcp cannot deal with both \"-impl\" and \"-intf\"\n";
   fprintf stderr "please compile interfaces and implementations separately\n";
diff --git a/tools/ocamldep.ml b/tools/ocamldep.ml
index 8cec34b..d484c1a 100644
--- a/tools/ocamldep.ml
+++ b/tools/ocamldep.ml
@@ -379,7 +379,7 @@ let print_version_num () =
 let _ =
   Clflags.classic := false;
   add_to_load_path Filename.current_dir_name;
-  Arg.parse [
+  Misc.parse_arguments ~env_var:"OCAMLDEPFLAGS" [
      "-absname", Arg.Set Location.absname,
         " Show absolute filenames in error messages";
      "-all", Arg.Set all_dependencies,
diff --git a/tools/ocamloptp.ml b/tools/ocamloptp.ml
index 57f7085..e59bc91 100644
--- a/tools/ocamloptp.ml
+++ b/tools/ocamloptp.ml
@@ -43,6 +43,8 @@ let incompatible o =
   exit 2
 
 module Options = Main_args.Make_optcomp_options (struct
+  let env_var = Main_args.Environment_variables._OCAMLOPTFLAGS
+
   let _a () = make_archive := true; option "-a" ()
   let _absname = option "-absname"
   let _annot = option "-annot"
diff --git a/utils/misc.ml b/utils/misc.ml
index 9dbf2fb..3eaa7fe 100644
--- a/utils/misc.ml
+++ b/utils/misc.ml
@@ -227,7 +227,7 @@ let thd4 (_,_,x,_) = x
 
 let edit_distance a b cutoff =
   let la, lb = String.length a, String.length b in
-  let cutoff = 
+  let cutoff =
     (* using max_int for cutoff would cause overflows in (i + cutoff + 1);
        we bring it back to the (max la lb) worstcase *)
     min (max la lb) cutoff in
@@ -269,3 +269,23 @@ let edit_distance a b cutoff =
     then None
     else Some result
   end
+
+let parse_arguments ?env_var spec anon_fun usage_msg =
+  let options = match env_var with
+  | None -> ""
+  | Some env_var ->
+    try Sys.getenv env_var with Not_found -> "" in
+  let generic_options =
+    try Sys.getenv "OCAMLFLAGS" with Not_found -> "" in
+  let options = String.concat " " [generic_options; options] in
+  let options = String.trim options in
+  let program, args =
+    Array.sub Sys.argv 0 1,
+    Array.sub Sys.argv 1 (Array.length Sys.argv - 1)
+  in
+  let args = Array.append (Array.of_list (List.rev (rev_split_words options))) args in
+  let argv = Array.append program args in
+  try Arg.parse_argv argv spec anon_fun usage_msg
+  with
+  | Arg.Bad msg
+  | Arg.Help msg -> print_string msg
diff --git a/utils/misc.mli b/utils/misc.mli
index 214a1ea..cc09496 100644
--- a/utils/misc.mli
+++ b/utils/misc.mli
@@ -133,3 +133,13 @@ val edit_distance : string -> string -> int -> int option
     letters, or swapping of adjacent letters to go from one word to the
     other. The particular algorithm may change in the future.
 *)
+
+val parse_arguments :
+  ?env_var:string
+  -> (Arg.key * Arg.spec * Arg.doc) list
+  -> Arg.anon_fun -> Arg.usage_msg -> unit
+(** [parse_arguments ~env_var] will return a function with [Arg.parse]
+    signature that takes into account the optional [env_var] parameter
+    that specifies environment variable. If the environment variable
+    is defined it will prepend it's additional arguments to Sys.argv
+    that are specified in the command line. *)
-- 
1.7.4.1