diff --git a/src/action.ml b/src/action.ml index c1c9571d..8a5c9b87 100644 --- a/src/action.ml +++ b/src/action.ml @@ -1,6 +1,8 @@ open Import open Sexp.Of_sexp +module Env_var_map = Context.Env_var_map + type var_expansion = | Not_found | Path of Path.t @@ -287,7 +289,7 @@ module Mini_shexp = struct exec t ~purpose ~env ~env_extra ~stdout_to ~stderr_to ~dir | Setenv (var, value, t) -> exec t ~purpose ~dir ~env ~stdout_to ~stderr_to - ~env_extra:(String_map.add env_extra ~key:var ~data:value) + ~env_extra:(Env_var_map.add env_extra ~key:var ~data:value) | Redirect (outputs, fn, t) -> redirect ~purpose outputs fn t ~dir ~env ~env_extra ~stdout_to ~stderr_to | Ignore (outputs, t) -> @@ -434,7 +436,7 @@ let exec ~targets { action; dir; context } = in let targets = Path.Set.elements targets in let purpose = Future.Build_job targets in - Mini_shexp.exec action ~purpose ~dir ~env ~env_extra:String_map.empty + Mini_shexp.exec action ~purpose ~dir ~env ~env_extra:Env_var_map.empty ~stdout_to:None ~stderr_to:None let sandbox t ~sandboxed ~deps ~targets = diff --git a/src/context.ml b/src/context.ml index 3d0f4b68..365c0ae4 100644 --- a/src/context.ml +++ b/src/context.ml @@ -18,6 +18,17 @@ module Kind = struct ]) end +module Env_var = struct + type t = string + let compare a b = + if Sys.win32 then + String.compare (String.lowercase a) (String.lowercase b) + else + String.compare a b +end + +module Env_var_map = Map.Make(Env_var) + type t = { name : string ; kind : Kind.t @@ -35,7 +46,7 @@ type t = ; ocamlyacc : Path.t ; ocamlmklib : Path.t ; env : string array - ; env_extra : string String_map.t + ; env_extra : string Env_var_map.t ; findlib : Findlib.t ; arch_sixtyfour : bool ; opam_var_cache : (string, string) Hashtbl.t @@ -94,7 +105,7 @@ let sexp_of_t t = ; "ocamllex", path t.ocamllex ; "ocamlyacc", path t.ocamlyacc ; "ocamlmklib", path t.ocamlmklib - ; "env", string_map string t.env_extra + ; "env", list (pair string string) (Env_var_map.bindings t.env_extra) ; "findlib_path", list path (Findlib.path t.findlib) ; "arch_sixtyfour", bool t.arch_sixtyfour ; "natdynlink_supported", bool t.natdynlink_supported @@ -126,17 +137,15 @@ let opam_config_var ~env ~cache var = Some s let get_env env var = - let prefix = var ^ "=" in let rec loop i = if i = Array.length env then None else let entry = env.(i) in - if String.is_prefix entry ~prefix then - let len_p = String.length prefix in - Some (String.sub entry ~pos:len_p ~len:(String.length entry - len_p)) - else - loop (i + 1) + match String.lsplit2 entry ~on:'=' with + | Some (key, value) when Env_var.compare key var = 0 -> + Some value + | _ -> loop (i + 1) in loop 0 @@ -144,7 +153,7 @@ let which ~cache ~path x = Hashtbl.find_or_add cache x ~f:(Bin.which ~path) let extend_env ~vars ~env = - if String_map.is_empty vars then + if Env_var_map.is_empty vars then env else let imported = @@ -154,10 +163,10 @@ let extend_env ~vars ~env = | None -> true | Some i -> let key = String.sub s ~pos:0 ~len:i in - not (String_map.mem key vars)) + not (Env_var_map.mem key vars)) in List.rev_append - (List.map (String_map.bindings vars) ~f:(fun (k, v) -> sprintf "%s=%s" k v)) + (List.map (Env_var_map.bindings vars) ~f:(fun (k, v) -> sprintf "%s=%s" k v)) imported |> Array.of_list @@ -265,8 +274,8 @@ let create ~(kind : Kind.t) ~path ~base_env ~env_extra ~name ~merlin ~use_findli | None -> "color=always,_" | Some s -> "color=always," ^ s in - extend_env ~env ~vars:((String_map.singleton "OCAMLPARAM" value)), - (String_map.add ~key:"OCAMLPARAM" ~data:value env_extra) + extend_env ~env ~vars:((Env_var_map.singleton "OCAMLPARAM" value)), + (Env_var_map.add ~key:"OCAMLPARAM" ~data:value env_extra) else env,env_extra in @@ -365,17 +374,12 @@ let initial_env = lazy ( let default ?(merlin=true) ?(use_findlib=true) () = let env = Lazy.force initial_env in - let rec find_path i = - if i = Array.length env then - [] - else - match String.lsplit2 env.(i) ~on:'=' with - | Some ("PATH", s) -> - Bin.parse_path s - | _ -> find_path (i + 1) + let path = + match get_env env "PATH" with + | Some s -> Bin.parse_path s + | None -> [] in - let path = find_path 0 in - create ~kind:Default ~path ~base_env:env ~env_extra:String_map.empty + create ~kind:Default ~path ~base_env:env ~env_extra:Env_var_map.empty ~name:"default" ~merlin ~use_findlib let create_for_opam ?root ~switch ~name ?(merlin=false) () = @@ -393,8 +397,8 @@ let create_for_opam ?root ~switch ~name ?(merlin=false) () = let vars = Sexp_lexer.single (Lexing.from_string s) |> Sexp.Of_sexp.(list (pair string string)) - |> String_map.of_alist_multi - |> String_map.mapi ~f:(fun var values -> + |> Env_var_map.of_alist_multi + |> Env_var_map.mapi ~f:(fun var values -> match List.rev values with | [] -> assert false | [x] -> x @@ -410,7 +414,7 @@ let create_for_opam ?root ~switch ~name ?(merlin=false) () = x) in let path = - match String_map.find "PATH" vars with + match Env_var_map.find "PATH" vars with | None -> Bin.path | Some s -> Bin.parse_path s in @@ -447,4 +451,4 @@ let env_for_exec t = ; extend_var "MANPATH" (Config.local_install_man_dir ~context:t.name) ] in - extend_env ~env:t.env ~vars:(String_map.of_alist_exn vars) + extend_env ~env:t.env ~vars:(Env_var_map.of_alist_exn vars) diff --git a/src/context.mli b/src/context.mli index da6a5809..da12d6b9 100644 --- a/src/context.mli +++ b/src/context.mli @@ -30,6 +30,13 @@ module Kind : sig type t = Default | Opam of Opam.t end +module Env_var : sig + type t = string + val compare : t -> t -> int +end + +module Env_var_map : Map.S with type key := Env_var.t + type t = { name : string ; kind : Kind.t @@ -64,7 +71,7 @@ type t = env : string array ; (** Diff between the base environment and [env] *) - env_extra : string String_map.t + env_extra : string Env_var_map.t ; findlib : Findlib.t @@ -134,7 +141,7 @@ val default : ?merlin:bool -> ?use_findlib:bool -> unit -> t Future.t val which : t -> string -> Path.t option -val extend_env : vars:string String_map.t -> env:string array -> string array +val extend_env : vars:string Env_var_map.t -> env:string array -> string array val opam_config_var : t -> string -> string option Future.t diff --git a/src/import.ml b/src/import.ml index 8e89a561..e7b1c47e 100644 --- a/src/import.ml +++ b/src/import.ml @@ -200,6 +200,8 @@ module String = struct [@@@warning "-3"] let capitalize_ascii = String.capitalize let uncapitalize_ascii = String.uncapitalize + let uppercase_ascii = String.uppercase + let lowercase_ascii = String.lowercase end let extract_words s ~is_word_char =