diff --git a/CHANGES.md b/CHANGES.md index 5ade6848b7e..937dce31a18 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -7,6 +7,8 @@ next - Let `Configurator.V1.C_define.import` handle negative integers (#1334, @Chris00) +- Pass `--set-switch` to opam (#1341, fix #1337, @diml) + 1.3.0 (23/09/2018) ------------------ diff --git a/bin/main.ml b/bin/main.ml index fe89a1cafa9..f969c5833a9 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -80,13 +80,15 @@ let installed_libraries = Common.set_common common ~targets:[]; let env = Main.setup_env ~capture_outputs:common.capture_outputs in Scheduler.go ~log:(Log.create common) ~common - (Context.create - (Default { loc = Loc.of_pos __POS__ - ; targets = [Native] - ; profile = Config.default_build_profile - ; env = None - }) - ~env + (Context.create ~env + { merlin_context = Some "default" + ; contexts = [Default { loc = Loc.of_pos __POS__ + ; targets = [Native] + ; profile = Config.default_build_profile + ; env = None + }] + ; env = None + } >>= fun ctxs -> let ctx = List.hd ctxs in let findlib = ctx.findlib in diff --git a/src/bin.ml b/src/bin.ml index 871c4fb7a0b..174ee5ade54 100644 --- a/src/bin.ml +++ b/src/bin.ml @@ -37,8 +37,6 @@ let which ?(path=path) prog = in search path -let opam = which "opam" - let make = match which "gmake" with | None -> which "make" diff --git a/src/bin.mli b/src/bin.mli index c73a4ed112e..d9d74ce3ee0 100644 --- a/src/bin.mli +++ b/src/bin.mli @@ -12,9 +12,6 @@ val path : Path.t list (** Parse a [PATH] like variable *) val parse_path : ?sep:char -> string -> Path.t list -(** The opam tool *) -val opam : Path.t option - (** Extension to append to executable filenames *) val exe : string diff --git a/src/context.ml b/src/context.ml index 61f958917a9..f3259917155 100644 --- a/src/context.ml +++ b/src/context.ml @@ -5,7 +5,7 @@ open Fiber.O module Kind = struct module Opam = struct type t = - { root : string + { root : string option ; switch : string } end @@ -14,7 +14,7 @@ module Kind = struct let to_sexp : t -> Sexp.t = function | Default -> Sexp.Encoder.string "default" | Opam o -> - Sexp.Encoder.(record [ "root" , string o.root + Sexp.Encoder.(record [ "root" , option string o.root ; "switch", string o.switch ]) end @@ -117,11 +117,13 @@ let to_sexp t = let compare a b = compare a.name b.name +let opam = lazy (Bin.which "opam") + let opam_config_var ~env ~cache var = match Hashtbl.find cache var with | Some _ as x -> Fiber.return x | None -> - match Bin.opam with + match Lazy.force opam with | None -> Fiber.return None | Some fn -> Process.run_capture (Accept All) fn ~env @@ -188,9 +190,9 @@ let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets ~profile () = let opam_var_cache = Hashtbl.create 128 in (match kind with - | Opam { root; _ } -> + | Opam { root = Some root; _ } -> Hashtbl.add opam_var_cache "root" root - | Default -> ()); + | _ -> ()); let prog_not_found_in_path prog = Utils.program_not_found prog ~context:name ~loc:None in @@ -498,61 +500,93 @@ let default ?(merlin=true) ~env_nodes ~env ~targets () = create ~kind:Default ~path:Bin.path ~env ~env_nodes ~name:"default" ~merlin ~targets () -let create_for_opam ?root ~env ~env_nodes ~targets ~profile ~switch ~name - ?(merlin=false) () = - match Bin.opam with - | None -> Utils.program_not_found "opam" ~loc:None - | Some fn -> - (match root with - | Some root -> Fiber.return root - | None -> - Process.run_capture_line Strict ~env fn ["config"; "var"; "root"]) - >>= fun root -> - Process.run_capture ~env Strict fn - ["config"; "env"; "--root"; root; "--switch"; switch; "--sexp"] - >>= fun s -> - let vars = - Dune_lang.parse_string ~fname:"" ~mode:Single s - |> Dune_lang.Decoder.(parse (list (pair string string)) Univ_map.empty) - |> Env.Map.of_list_multi - |> Env.Map.mapi ~f:(fun var values -> - match List.rev values with - | [] -> assert false - | [x] -> x - | x :: _ -> - Format.eprintf - "@{Warning@}: variable %S present multiple times in the output of:\n\ - @{
%s@}@." - var - (String.concat ~sep:" " - (List.map ~f:quote_for_shell - [Path.to_string fn; "config"; "env"; "--root"; root; - "--switch"; switch; "--sexp"])); - x) - in - let path = - match Env.Map.find vars "PATH" with - | None -> Bin.path - | Some s -> Bin.parse_path s - in - let env = Env.extend env ~vars in - create ~kind:(Opam { root; switch }) ~profile ~targets ~path ~env ~env_nodes - ~name ~merlin () +let opam_version = + let res = ref None in + fun opam env -> + match !res with + | Some future -> Fiber.Future.wait future + | None -> + Fiber.fork (fun () -> + Process.run_capture_line Strict ~env opam ["--version"] + >>| fun s -> + try + Scanf.sscanf s "%d.%d.%d" (fun a b c -> a, b, c) + with _ -> + die "@{Error@}: `%a config --version' \ + returned invalid output:\n%s" + Path.pp opam s) + >>= fun future -> + res := Some future; + Fiber.Future.wait future + +let create_for_opam ~root ~env ~env_nodes ~targets ~profile + ~switch ~name ~merlin () = + let opam = + match Lazy.force opam with + | None -> Utils.program_not_found "opam" ~loc:None + | Some fn -> fn + in + opam_version opam env + >>= fun version -> + let args = + List.concat + [ [ "config"; "env" ] + ; (match root with + | None -> [] + | Some root -> [ "--root"; root ]) + ; [ "--switch"; switch; "--sexp" ] + ; if version < (2, 0, 0) then [] else ["--set-switch"] + ] + in + Process.run_capture ~env Strict opam args + >>= fun s -> + let vars = + Dune_lang.parse_string ~fname:"" ~mode:Single s + |> Dune_lang.Decoder.(parse (list (pair string string)) Univ_map.empty) + |> Env.Map.of_list_multi + |> Env.Map.mapi ~f:(fun var values -> + match List.rev values with + | [] -> assert false + | [x] -> x + | x :: _ -> + Format.eprintf + "@{Warning@}: variable %S present multiple times in the \ + output of:\n\ + @{
%s@}@." + var + (String.concat ~sep:" " + (List.map ~f:quote_for_shell + (Path.to_string opam :: args))); + x) + in + let path = + match Env.Map.find vars "PATH" with + | None -> Bin.path + | Some s -> Bin.parse_path s + in + let env = Env.extend env ~vars in + create ~kind:(Opam { root; switch }) ~profile ~targets ~path ~env ~env_nodes + ~name ~merlin () -let create ?merlin ?workspace_env ~env def = +let create ~env (workspace : Workspace.t) = let env_nodes context = { Env_nodes. context - ; workspace = workspace_env + ; workspace = workspace.env } in - match (def : Workspace.Context.t) with - | Default { targets; profile; env = env_node ; loc = _ } -> - default ~env ~env_nodes:(env_nodes env_node) ~profile ~targets ?merlin () - | Opam { base = { targets ; profile ; env = env_node ; loc = _ } - ; name; switch; root; merlin = _ } -> - create_for_opam ?root ~env_nodes:(env_nodes env_node) ~env ~profile - ~switch ~name ?merlin ~targets () + Fiber.parallel_map workspace.contexts ~f:(fun def -> + match def with + | Default { targets; profile; env = env_node ; loc = _ } -> + let merlin = + workspace.merlin_context = Some (Workspace.Context.name def) + in + default ~env ~env_nodes:(env_nodes env_node) ~profile ~targets ~merlin () + | Opam { base = { targets; profile; env = env_node; loc = _ } + ; name; switch; root; merlin } -> + create_for_opam ~root ~env_nodes:(env_nodes env_node) ~env ~profile + ~switch ~name ~merlin ~targets ()) + >>| List.concat let which t s = which ~cache:t.which_cache ~path:t.path s diff --git a/src/context.mli b/src/context.mli index efab295aa54..15cfc7dce2f 100644 --- a/src/context.mli +++ b/src/context.mli @@ -24,7 +24,7 @@ open! Import module Kind : sig module Opam : sig type t = - { root : string + { root : string option ; switch : string } end @@ -133,12 +133,7 @@ val to_sexp : t -> Sexp.t (** Compare the context names *) val compare : t -> t -> Ordering.t -val create - : ?merlin:bool - -> ?workspace_env:Dune_env.Stanza.t - -> env:Env.t - -> Workspace.Context.t - -> t list Fiber.t +val create : env:Env.t -> Workspace.t -> t list Fiber.t val which : t -> string -> Path.t option diff --git a/src/main.ml b/src/main.ml index e460963f882..e93125d79af 100644 --- a/src/main.ml +++ b/src/main.ml @@ -72,12 +72,8 @@ let setup ?(log=Log.no_log) | None -> Workspace.default ?x ?profile () in - Fiber.parallel_map workspace.contexts ~f:(fun ctx_def -> - let name = Workspace.Context.name ctx_def in - Context.create ?workspace_env:workspace.env - ctx_def ~env ~merlin:(workspace.merlin_context = Some name)) + Context.create ~env workspace >>= fun contexts -> - let contexts = List.concat contexts in List.iter contexts ~f:(fun (ctx : Context.t) -> Log.infof log "@[<1>Dune context:@,%a@]@." Sexp.pp (Context.to_sexp ctx));