diff --git a/CHANGES.md b/CHANGES.md index 80da99ac858..562e78fae45 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,6 +1,9 @@ Unreleased ---------- +- Load the host context `findlib.conf` when cross-compiling (#7428, fixes + #1701, @rgrinberg, @anmonteiro) + - Resolve `ppx_runtime_libraries` in the target context when cross compiling (#7450, fixes #2794, @anmonteiro) diff --git a/src/dune_rules/context.ml b/src/dune_rules/context.ml index 59a4b514253..c92fa9857a8 100644 --- a/src/dune_rules/context.ml +++ b/src/dune_rules/context.ml @@ -266,11 +266,6 @@ end = struct fun ~env ~root ~switch -> Memo.exec memo (env, root, switch) end -let ocamlpath_sep = - if Sys.cygwin then (* because that's what ocamlfind expects *) - ';' - else Bin.path_sep - module Build_environment_kind = struct (* Heuristics to detect the current environment *) @@ -302,20 +297,36 @@ module Build_environment_kind = struct match opam_prefix with | Some s -> Opam2_environment s | None -> Unknown))) -end -let ocamlfind_printconf_path ~env ~ocamlfind ~toolchain = - let args = - let args = [ "printconf"; "path" ] in - match toolchain with - | None -> args - | Some s -> "-toolchain" :: Context_name.to_string s :: args - in - let+ l = - Memo.of_reproducible_fiber - (Process.run_capture_lines ~display:Quiet ~env Strict ocamlfind args) - in - List.map l ~f:Path.of_filename_relative_to_initial_cwd + let findlib_paths t ~findlib ~ocamlc_dir = + match (findlib, t) with + | ( Some findlib + , ( Cross_compilation_using_findlib_toolchain _ + | Opam2_environment _ + | Unknown ) ) -> Findlib.Config.path findlib + | None, Cross_compilation_using_findlib_toolchain toolchain -> + User_error.raise + [ Pp.textf + "Could not find `ocamlfind' in PATH or an environment variable \ + `OCAMLFIND_CONF' while cross-compiling with toolchain `%s'" + (Context_name.to_string toolchain) + ] + ~hints: + [ Pp.enumerate + [ "`opam install ocamlfind' and/or:" + ; "Point `OCAMLFIND_CONF' to the findlib configuration that \ + defines this toolchain" + ] + ~f:Pp.text + ] + | _, Hardcoded_path l -> + List.map l ~f:Path.of_filename_relative_to_initial_cwd + | None, Opam2_environment opam_prefix -> + let p = Path.of_filename_relative_to_initial_cwd opam_prefix in + let p = Path.relative p "lib" in + [ p ] + | None, Unknown -> [ Path.relative (Path.parent_exn ocamlc_dir) "lib" ] +end let check_fdo_support has_native ocfg ~name = let version = Ocaml.Version.of_ocaml_config ocfg in @@ -355,67 +366,56 @@ type instance = let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets ~host_context ~host_toolchain ~profile ~fdo_target_exe ~dynamically_linked_foreign_archives ~instrument_with = - let prog_not_found_in_path prog = - Utils.program_not_found prog ~context:name ~loc:None - in let which = Program.which ~path in - let which_exn x = - which x >>| function - | None -> prog_not_found_in_path x - | Some x -> x - in - let findlib_config_path = - Memo.lazy_ ~cutoff:Path.External.equal (fun () -> - let* fn = which_exn "ocamlfind" in - (* When OCAMLFIND_CONF is set, "ocamlfind printconf" does print the - contents of the variable, but "ocamlfind printconf conf" still prints - the configuration file set at the configuration time of ocamlfind, - sigh... *) - (match Env.get env "OCAMLFIND_CONF" with - | Some s -> Memo.return s - | None -> - Memo.of_reproducible_fiber - (Process.run_capture_line ~display:Quiet ~env Strict fn - [ "printconf"; "conf" ])) - >>| Path.External.of_filename_relative_to_initial_cwd) - in + let env_ocamlpath = Findlib.Config.ocamlpath env in + let initial_ocamlpath = Findlib.Config.ocamlpath Env.initial in let create_one ~(name : Context_name.t) ~implicit ~findlib_toolchain ~host ~merlin = - let* findlib_config = - match findlib_toolchain with - | None -> Memo.return None - | Some toolchain -> - let* path = Memo.Lazy.force findlib_config_path in - let toolchain = Context_name.to_string toolchain in - let context = Context_name.to_string name in - let+ config = Findlib.Config.load (External path) ~toolchain ~context in - Some config + let ocamlpath = + match (kind, findlib_toolchain) with + | Default, None -> Option.value env_ocamlpath ~default:[] + | _, _ -> ( + (* If we are not in the default context, we can only use the OCAMLPATH + variable if it is specific to this build context *) + (* CR-someday diml: maybe we should actually clear OCAMLPATH in other + build contexts *) + match (env_ocamlpath, initial_ocamlpath) with + | None, None -> [] + | Some s, None -> + (* [OCAMLPATH] set for the target context, unset in the + [initial_env]. This means it's the [OCAMLPATH] specific to this + build context. *) + s + | None, Some _ -> + (* Clear [OCAMLPATH] for this build context if it's defined + initially but not for this build context. *) + [] + | Some env_ocamlpath, Some initial_ocamlpath -> ( + (* Clear [OCAMLPATH] for this build context Unless it's different + from the initial [OCAMLPATH] variable. *) + match + List.compare ~compare:Path.compare env_ocamlpath initial_ocamlpath + with + | Eq -> [] + | _ -> env_ocamlpath)) + in + let* findlib = + let findlib_toolchain = + Option.map findlib_toolchain ~f:Context_name.to_string + in + Findlib.Config.discover_from_env ~env ~which ~ocamlpath ~findlib_toolchain in let get_tool_using_findlib_config prog = - match - Option.bind findlib_config ~f:(fun conf -> Findlib.Config.get conf prog) - with - | None -> Memo.return None - | Some s -> ( - match Filename.analyze_program_name s with - | In_path -> which s - | Relative_to_current_dir -> - User_error.raise - [ Pp.textf - "The effective Findlib configuration specifies the relative \ - path %S for the program %S. This is currently not supported." - s prog - ] - | Absolute -> - Memo.return (Some (Path.of_filename_relative_to_initial_cwd s))) + Memo.Option.bind findlib ~f:(Findlib.Config.tool ~prog) in let* ocamlc = - get_tool_using_findlib_config "ocamlc" >>= function + let ocamlc = "ocamlc" in + get_tool_using_findlib_config ocamlc >>= function | Some x -> Memo.return x | None -> ( - which "ocamlc" >>| function + which ocamlc >>| function | Some x -> x - | None -> prog_not_found_in_path "ocamlc") + | None -> Utils.program_not_found ocamlc ~context:name ~loc:None) in let dir = Path.parent_exn ocamlc in let get_ocaml_tool prog = @@ -435,38 +435,12 @@ let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets ~hint ())) in let build_dir = Context_name.build_dir name in - let ocamlpath = - match - let var = "OCAMLPATH" in - match (kind, findlib_toolchain) with - | Default, None -> Env.get env var - | _ -> ( - (* If we are not in the default context, we can only use the OCAMLPATH - variable if it is specific to this build context *) - (* CR-someday diml: maybe we should actually clear OCAMLPATH in other - build contexts *) - match (Env.get env var, Env.get Env.initial var) with - | None, None -> None - | Some s, None -> Some s - | None, Some _ -> None - | Some x, Some y -> Option.some_if (x <> y) x) - with - | None -> [] - | Some s -> Bin.parse_path s ~sep:ocamlpath_sep - in - let default_library_search_path () = - match Build_environment_kind.query ~kind ~findlib_toolchain ~env with - | Cross_compilation_using_findlib_toolchain toolchain -> - let* ocamlfind = which_exn "ocamlfind" in - let env = Env.remove env ~var:"OCAMLPATH" in - ocamlfind_printconf_path ~env ~ocamlfind ~toolchain:(Some toolchain) - | Hardcoded_path l -> - Memo.return (List.map l ~f:Path.of_filename_relative_to_initial_cwd) - | Opam2_environment opam_prefix -> - let p = Path.of_filename_relative_to_initial_cwd opam_prefix in - let p = Path.relative p "lib" in - Memo.return [ p ] - | Unknown -> Memo.return [ Path.relative (Path.parent_exn dir) "lib" ] + let default_ocamlpath = + let build_env_kind = + Build_environment_kind.query ~kind ~findlib_toolchain ~env + in + Build_environment_kind.findlib_paths build_env_kind ~findlib + ~ocamlc_dir:dir in let ocaml_config_ok_exn = function | Ok x -> x @@ -479,20 +453,19 @@ let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets | Error (Makefile_config file, msg) -> User_error.raise ~loc:(Loc.in_file file) [ Pp.text msg ] in - let* default_ocamlpath, (ocaml_config_vars, ocfg) = - Memo.fork_and_join default_library_search_path (fun () -> - let+ lines = - Memo.of_reproducible_fiber - (Process.run_capture_lines ~display:Quiet ~env Strict ocamlc - [ "-config" ]) - in - ocaml_config_ok_exn - (match Ocaml_config.Vars.of_lines lines with - | Ok vars -> - let open Result.O in - let+ ocfg = Ocaml_config.make vars in - (vars, ocfg) - | Error msg -> Error (Ocamlc_config, msg))) + let* ocaml_config_vars, ocfg = + let+ lines = + Memo.of_reproducible_fiber + (Process.run_capture_lines ~display:Quiet ~env Strict ocamlc + [ "-config" ]) + in + ocaml_config_ok_exn + (match Ocaml_config.Vars.of_lines lines with + | Ok vars -> + let open Result.O in + let+ ocfg = Ocaml_config.make vars in + (vars, ocfg) + | Error msg -> Error (Ocamlc_config, msg)) in let stdlib_dir = Path.of_string (Ocaml_config.standard_library ocfg) in let version = Ocaml.Version.of_ocaml_config ocfg in @@ -534,16 +507,17 @@ let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets (Path.Build.relative (Local_install_path.dir ~context:name) "lib/stublibs") - ; extend_var "OCAMLPATH" ~path_sep:ocamlpath_sep local_lib_root + ; extend_var "OCAMLPATH" ~path_sep:Findlib.Config.ocamlpath_sep + local_lib_root ; ("DUNE_OCAML_STDLIB", Ocaml_config.standard_library ocfg) ; ( "DUNE_OCAML_HARDCODED" , String.concat - ~sep:(Char.escaped ocamlpath_sep) + ~sep:(Char.escaped Findlib.Config.ocamlpath_sep) (List.map ~f:Path.to_string default_ocamlpath) ) ; extend_var "OCAMLTOP_INCLUDE_PATH" (Path.Build.relative local_lib_root "toplevel") - ; extend_var "OCAMLFIND_IGNORE_DUPS_IN" ~path_sep:ocamlpath_sep - local_lib_root + ; extend_var "OCAMLFIND_IGNORE_DUPS_IN" + ~path_sep:Findlib.Config.ocamlpath_sep local_lib_root ; extend_var "MANPATH" (Local_install_path.man_dir ~context:name) ; ("INSIDE_DUNE", Path.to_absolute_filename (Path.build build_dir)) ; ( "DUNE_SOURCEROOT" @@ -561,7 +535,7 @@ let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets | Some host -> Env.get host.env "PATH") |> Env.extend_env (Option.value ~default:Env.empty - (Option.map findlib_config ~f:Findlib.Config.env)) + (Option.map findlib ~f:Findlib.Config.env)) |> Env.extend_env (Env_nodes.extra_env ~profile env_nodes) in let natdynlink_supported = Ocaml_config.natdynlink_supported ocfg in diff --git a/src/dune_rules/findlib/findlib.ml b/src/dune_rules/findlib/findlib.ml index 8b62b61dc2b..904b7132be8 100644 --- a/src/dune_rules/findlib/findlib.ml +++ b/src/dune_rules/findlib/findlib.ml @@ -74,16 +74,23 @@ module Rules = struct Some (Option.value ~default:"" v ^ " " ^ rule.value) else v) + let sort = + let compare a b = + Int.compare + (Rule.formal_predicates_count b) + (Rule.formal_predicates_count a) + in + fun r -> List.stable_sort r ~compare + let of_meta_rules (rules : Meta.Simplified.Rules.t) = let add_rules = List.map rules.add_rules ~f:Rule.make in - let set_rules = - List.map rules.set_rules ~f:Rule.make - |> List.stable_sort ~compare:(fun a b -> - Int.compare - (Rule.formal_predicates_count b) - (Rule.formal_predicates_count a)) - in + let set_rules = List.map rules.set_rules ~f:Rule.make |> sort in { add_rules; set_rules } + + let union a b = + { set_rules = a.set_rules @ b.set_rules |> sort + ; add_rules = a.add_rules @ b.add_rules + } end module Vars = struct @@ -97,44 +104,168 @@ module Vars = struct match get t var preds with | None -> [] | Some s -> String.extract_comma_space_separated_words s + + let empty = String.Map.empty + + let union = String.Map.union end module Config = struct + module File = struct + type t = + { vars : Vars.t + ; preds : Ps.t + } + + let to_dyn { vars; preds } = + let open Dyn in + record + [ ("vars", String.Map.to_dyn Rules.to_dyn vars) + ; ("preds", Ps.to_dyn preds) + ] + + let load config_file = + let load p = + let+ meta = Meta.load ~name:None p in + meta.vars |> String.Map.map ~f:Rules.of_meta_rules + in + let+ vars = + let* vars = + Fs_memo.file_exists config_file >>= function + | true -> load config_file + | false -> Memo.return Vars.empty + in + let config_dir = + Path.Outside_build_dir.extend_basename config_file ~suffix:".d" + in + Fs_memo.is_directory config_dir >>= function + | Ok false | Error _ -> Memo.return vars + | Ok true -> ( + Fs_memo.dir_contents config_dir >>= function + | Ok dir_contents -> + let+ all_vars = + Memo.parallel_map (Fs_cache.Dir_contents.to_list dir_contents) + ~f:(fun (p, _kind) -> + let p = Path.Outside_build_dir.relative config_dir p in + load p) + in + List.fold_left all_vars ~init:vars ~f:(fun acc vars -> + Vars.union acc vars ~f:(fun _ x y -> Some (Rules.union x y))) + | Error _ -> Memo.return vars) + in + { vars; preds = Ps.empty } + + let get { vars; preds } var = Vars.get vars var preds + + let toolchain t ~toolchain = + { t with preds = Ps.singleton (P.make toolchain) } + end + type t = - { vars : Vars.t - ; preds : Ps.t + { config : File.t + ; ocamlpath : Path.t list + ; which : string -> Path.t option Memo.t + ; toolchain : string option } - let to_dyn { vars; preds } = + let to_dyn { config; ocamlpath; toolchain; which = _ } = let open Dyn in record - [ ("vars", String.Map.to_dyn Rules.to_dyn vars) - ; ("preds", Ps.to_dyn preds) + [ ("config", File.to_dyn config) + ; ("ocamlpath", Dyn.list Path.to_dyn ocamlpath) + ; ("toolchain", option string toolchain) ] - let load path ~toolchain ~context = - let path = Path.Outside_build_dir.extend_basename path ~suffix:".d" in - let conf_file = - Path.Outside_build_dir.relative path (toolchain ^ ".conf") - in - let* conf_file_exists = Fs_memo.file_exists conf_file in - if not conf_file_exists then - User_error.raise - [ Pp.textf "ocamlfind toolchain %s isn't defined in %s (context: %s)" - toolchain - (Path.Outside_build_dir.to_string_maybe_quoted path) - context - ]; - let+ meta = Meta.load ~name:None conf_file in - { vars = String.Map.map meta.vars ~f:Rules.of_meta_rules - ; preds = Ps.of_list [ P.make toolchain ] - } + let ocamlpath_sep = + if Sys.cygwin then (* because that's what ocamlfind expects *) + ';' + else Bin.path_sep + + let path_var = Bin.parse_path ~sep:ocamlpath_sep - let get { vars; preds } var = Vars.get vars var preds + let ocamlpath env = Env.get env "OCAMLPATH" |> Option.map ~f:path_var + + let set_toolchain t ~toolchain = + match t.toolchain with + | None -> + { t with + config = File.toolchain t.config ~toolchain + ; toolchain = Some toolchain + } + | Some old_toolchain -> + Code_error.raise + "Findlib.Config.set_toolchain: cannot set toolchain twice" + [ ("old_toolchain", Dyn.string old_toolchain) + ; ("toolchain", Dyn.string toolchain) + ] + + let path t = + match File.get t.config "path" with + | None -> t.ocamlpath + | Some p -> t.ocamlpath @ path_var p + + let tool t ~prog = + match File.get t.config prog with + | None -> Memo.return None + | Some s -> ( + match Filename.analyze_program_name s with + | In_path -> t.which s + | Relative_to_current_dir -> + User_error.raise + [ Pp.textf + "The effective Findlib configuration specifies the relative path \ + %S for the program %S. This is currently not supported." + s prog + ] + | Absolute -> + Memo.return (Some (Path.of_filename_relative_to_initial_cwd s))) + + let ocamlfind_config_path ~env ~which ~findlib_toolchain = + let open Memo.O in + let+ path = + (* How dune finds the [findlib.conf] file: + + - if [$OCAMLFIND_CONF] is set, prefer its value + - if the [ocamlfind] binary is in [$PATH], run + [ocamlfind printconf conf] to get its value + + dune attempts to find [ocaml], [ocamlopt], etc. in the findlib + configuration for the toolchain first to account for + cross-compilation use cases. It then falls back to searching in + [$PATH] *) + match Env.get env "OCAMLFIND_CONF" with + | Some s -> Memo.return (Some s) + | None -> ( + match findlib_toolchain with + | None -> Memo.return None + | Some _ -> ( + which "ocamlfind" >>= function + | None -> Memo.return None + | Some fn -> + Process.run_capture_line ~display:Quiet ~env Strict fn + [ "printconf"; "conf" ] + |> Memo.of_reproducible_fiber |> Memo.map ~f:Option.some)) + in + (* From http://projects.camlcity.org/projects/dl/findlib-1.9.6/doc/ref-html/r865.html + This variable overrides the location of the configuration file + findlib.conf. It must contain the absolute path name of this file. *) + Option.map path ~f:Path.External.of_string + + let discover_from_env ~env ~which ~ocamlpath ~findlib_toolchain = + let open Memo.O in + ocamlfind_config_path ~env ~which ~findlib_toolchain >>= function + | None -> Memo.return None + | Some config -> + let+ config = File.load (External config) in + let base = { config; ocamlpath; which; toolchain = None } in + Some + (match findlib_toolchain with + | None -> base + | Some toolchain -> set_toolchain base ~toolchain) let env t = - let preds = Ps.add t.preds (P.make "env") in - String.Map.filter_map ~f:(Rules.interpret ~preds) t.vars + let preds = Ps.add t.config.preds (P.make "env") in + String.Map.filter_map ~f:(Rules.interpret ~preds) t.config.vars |> Env.of_string_map end diff --git a/src/dune_rules/findlib/findlib.mli b/src/dune_rules/findlib/findlib.mli index 14c948c1ca0..82f1519c5fc 100644 --- a/src/dune_rules/findlib/findlib.mli +++ b/src/dune_rules/findlib/findlib.mli @@ -51,10 +51,26 @@ module Config : sig val to_dyn : t -> Dyn.t - val load : - Path.Outside_build_dir.t -> toolchain:string -> context:string -> t Memo.t + (** Finds the library search paths for this configuration, prepending + [OCAMLPATH] if set *) + val path : t -> Path.t list - val get : t -> string -> string option + (** Finds program [prog] for this configuration, if it exists *) + val tool : t -> prog:string -> Path.t option Memo.t + val ocamlpath_sep : char + + (** Read and parse the [OCAMLPATH] environment variable *) + val ocamlpath : Env.t -> Path.t list option + + (** Interpret [env] findlib predicates in findlib configuration files. *) val env : t -> Env.t + + (** Load the findlib configuration for this [findlib_toolchain], if any. *) + val discover_from_env : + env:Env.t + -> which:(Filename.t -> Path.t option Memo.t) + -> ocamlpath:Path.t list + -> findlib_toolchain:string option + -> t option Memo.t end diff --git a/test/blackbox-tests/test-cases/custom-cross-compilation/cross-compilation-ocamlfind.t b/test/blackbox-tests/test-cases/custom-cross-compilation/cross-compilation-ocamlfind.t index 95824b47321..8d6baa8cca6 100644 --- a/test/blackbox-tests/test-cases/custom-cross-compilation/cross-compilation-ocamlfind.t +++ b/test/blackbox-tests/test-cases/custom-cross-compilation/cross-compilation-ocamlfind.t @@ -5,11 +5,23 @@ in the default findlib.conf $ export OCAMLFIND_CONF=$PWD/etc/findlib.conf $ cat >etc/findlib.conf < path="$PWD/prefix/lib" + > ocamldep="$PWD/notocamldep" > EOF $ cat >etc/findlib.conf.d/foo.conf < path(foo)="" + > ocamldep(foo)="$PWD/notocamldep-foo" > EOF + $ cat >notocamldep < #!/usr/bin/env sh + > ocamldep "\$@" + > EOF + $ cat >notocamldep-foo < #!/usr/bin/env sh + > ocamldep "\$@" + > EOF + $ chmod +x notocamldep notocamldep-foo + $ mkdir lib $ cat > lib/dune-project < (lang dune 3.7) @@ -61,19 +73,27 @@ ocamlfind can find it Dune should be able to find it too - $ dune build --root=app @install -x foo - Entering directory 'app' - File "dune", line 6, characters 12-18: - 6 | (libraries libdep)) - ^^^^^^ - Error: Library "libdep" not found. - -> required by _build/default/.gen.eobjs/byte/dune__exe__Gen.cmi - -> required by _build/default/.gen.eobjs/native/dune__exe__Gen.cmx - -> required by _build/default/gen.exe - -> required by _build/default.foo/foo.ml - -> required by _build/install/default.foo/lib/repro/foo.ml - -> required by _build/default.foo/repro-foo.install - -> required by alias install (context default.foo) - Leaving directory 'app' - [1] + $ dune build --root=app @install -x foo --verbose 2>&1 | grep notocamldep-foo + "$TESTCASE_ROOT/notocamldep-foo" + "$TESTCASE_ROOT/notocamldep-foo" + Running[8]: (cd _build/default.foo && $TESTCASE_ROOT/notocamldep-foo -modules -impl foo.ml) > _build/default.foo/.repro.objs/repro__Foo.impl.d + +Library is built in the target context + + $ ls app/_build/default.foo + META.repro + foo.ml + repro-foo.install + repro.a + repro.cma + repro.cmxa + repro.cmxs + repro.dune-package + repro.ml-gen + +Executable was built in the host context + $ ls app/_build/default + gen.exe + gen.ml + gen.mli diff --git a/test/blackbox-tests/test-cases/custom-cross-compilation/no-ocamlfind-in-path.t b/test/blackbox-tests/test-cases/custom-cross-compilation/no-ocamlfind-in-path.t new file mode 100644 index 00000000000..d116a399b57 --- /dev/null +++ b/test/blackbox-tests/test-cases/custom-cross-compilation/no-ocamlfind-in-path.t @@ -0,0 +1,43 @@ +Dune shows an error message when ocamlfind isn't in PATH and OCAMLFIND_CONF +isn't set + + $ cat > dune-project < (lang dune 3.7) + > (package (name repro)) + > EOF + $ cat > dune < (executable + > (name gen) + > (modules gen) + > (enabled_if + > (= %{context_name} "default")) + > (libraries libdep)) + > (rule + > (with-stdout-to + > gen.ml + > (echo "let () = Format.printf \"let x = 1\""))) + > (library + > (name repro) + > (public_name repro) + > (modules foo)) + > EOF + + $ mkdir ocaml-bin + $ cat > ocaml-bin/ocamlc < #!/usr/bin/env sh + > export PATH="\$ORIG_PATH" + > exec ocamlc "\$@" + > EOF + $ chmod +x ocaml-bin/ocamlc + + $ DUNE_PATH=$(dirname `which dune`) + $ SH_PATH=$(dirname `which sh`) + $ env ORIG_PATH="$PATH" PATH="$SH_PATH:$DUNE_PATH:$PWD/ocaml-bin" dune build @install -x foo + Error: Could not find `ocamlfind' in PATH or an environment variable + `OCAMLFIND_CONF' while cross-compiling with toolchain `foo' + Hint: + - `opam install ocamlfind' and/or: + - Point `OCAMLFIND_CONF' to the findlib configuration that defines this + toolchain + [1] + diff --git a/test/expect-tests/findlib_tests.ml b/test/expect-tests/findlib_tests.ml index 40d1ef5f840..214b2aaa17b 100644 --- a/test/expect-tests/findlib_tests.ml +++ b/test/expect-tests/findlib_tests.ml @@ -128,30 +128,44 @@ let%expect_test _ = } |}] let conf () = - Findlib.Config.load - (Path.Outside_build_dir.relative db_path "../toolchain") - ~toolchain:"tlc" ~context:"" - |> Memo.run - |> Test_scheduler.(run (create ())) + let memo = + let open Memo.O in + Findlib.Config.discover_from_env + ~which:(fun _ -> assert false) + ~ocamlpath:[] + ~env: + (Env.initial + |> Env.add ~var:"OCAMLFIND_CONF" + ~value: + (Path.Outside_build_dir.relative db_path "../toolchain" + |> Path.Outside_build_dir.to_string)) + ~findlib_toolchain:(Some "tlc") + >>| Option.value_exn + in + Memo.run memo |> Test_scheduler.(run (create ())) let%expect_test _ = let conf = conf () in print_dyn (Findlib.Config.to_dyn conf); [%expect {| - { vars = - map - { "FOO_BAR" : - { set_rules = - [ { preds_required = set { "env"; "tlc" } - ; preds_forbidden = set {} - ; value = "my variable" - } - ] - ; add_rules = [] + { config = + { vars = + map + { "FOO_BAR" : + { set_rules = + [ { preds_required = set { "env"; "tlc" } + ; preds_forbidden = set {} + ; value = "my variable" + } + ] + ; add_rules = [] + } } - } - ; preds = set { "tlc" } + ; preds = set { "tlc" } + } + ; ocamlpath = [] + ; toolchain = Some "tlc" } |}]; print_dyn (Env.to_dyn (Findlib.Config.env conf)); [%expect {| map { "FOO_BAR" : "my variable" } |}]