diff --git a/CHANGES.md b/CHANGES.md index 76027f908e6e..c6996c357f3e 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -40,6 +40,10 @@ unreleased - Fix `.install` files not being generated (#2124, fixes #2123, @rgrinberg) +- In `dune-workspace` files, add the ability to choose the host context and to + create duplicates of the default context with different settings. (#2098, + @TheLortex, review by @diml and @aalekseyev) + 1.9.2 (02/05/2019) ------------------ diff --git a/doc/usage.rst b/doc/usage.rst index 8f9eef7a6016..87416b48ab14 100644 --- a/doc/usage.rst +++ b/doc/usage.rst @@ -528,6 +528,9 @@ context or can be the description of an opam switch, as follows: - ``(toolchain )`` set findlib toolchain for the context. +- ``(host )`` choose a different context to build binaries that + are meant to be executed on the host machine, such as preprocessors. + Both ``(default ...)`` and ``(opam ...)`` accept a ``targets`` field in order to setup cross compilation. See :ref:`advanced-cross-compilation` for more information. diff --git a/src/context.ml b/src/context.ml index d9736b4cf940..90a414114a67 100644 --- a/src/context.ml +++ b/src/context.ml @@ -600,20 +600,79 @@ let create_for_opam ~root ~env ~env_nodes ~targets ~profile create ~kind:(Opam { root; switch }) ~profile ~targets ~path ~env ~env_nodes ~name ~merlin ~host_context ~host_toolchain +(* Enforces that a context cannot be both a host and a target context.*) +let look_for_bad_configurations contexts = + let map = + String.Map.of_list_map_exn + contexts + ~f:(fun ((_, (_, c)) as elt) -> (c.name, elt)) + in + let check (_, (host, elt)) = + match host with + | None -> () + | Some host -> + (match String.Map.find_exn map host with + | _,(None, _) -> () + | loc, ((Some host_of_host),_) -> + Errors.fail + loc + "Context '%s' is both a host (for '%s') and a target (for '%s')." + host + elt.name + host_of_host + ) + in + List.iter + contexts + ~f:check + +(* Resolve the host field of contexts + * (assuming contexts are topologically sorted) +*) +let rec resolve_host_top_contexts acc map contexts = + match contexts with + | [] -> acc + | (_,(None, ctx))::next -> + resolve_host_top_contexts + (ctx::acc) + (String.Map.add map ctx.name ctx) + next + | (_,((Some host), ctx))::next -> + let ctx_resolved = {ctx with for_host=Some (String.Map.find_exn map host)} + in + resolve_host_top_contexts + (ctx_resolved::acc) + (String.Map.add map ctx.name ctx_resolved) + next + +(* Resolve the host field of contexts *) let resolve_host_contexts contexts = - let empty = String.Map.empty in - let map = List.fold_left - ~f:(fun map (_,(_,elem)) -> String.Map.add map elem.name elem) - ~init:empty - contexts in - List.map ~f:(fun (loc, (host, elem)) -> match host with - | None -> elem - | Some host -> ( - match String.Map.find map host with - | None -> Errors.fail loc "Undefined host context '%s' for '%s'." host elem.name - | Some ctx -> {elem with for_host=(Some ctx)} - )) - contexts + let map = + String.Map.of_list_map_exn + contexts + ~f:(fun ((_, (_, c)) as elt) -> c.name, elt) + in + let key (_,(_, ctx)) = ctx.name in + let deps (loc, (host, elem)) = + match host with + | Some host -> + (match String.Map.find map host with + | None -> + Errors.fail + loc + "Undefined host context '%s' for '%s'." + host + elem.name + | Some host_ctx -> [host_ctx]) + | None -> [] + in + match Top_closure.String.top_closure ~key ~deps contexts with + | Ok top_contexts -> + look_for_bad_configurations top_contexts; + resolve_host_top_contexts [] String.Map.empty top_contexts + | Error failed_contexts -> + look_for_bad_configurations (List.tl failed_contexts); + assert false (* Should fail beforehand. *) let create ~env (workspace : Workspace.t) = let env_nodes context = @@ -624,7 +683,8 @@ let create ~env (workspace : Workspace.t) = in Fiber.parallel_map workspace.contexts ~f:(fun def -> match def with - | Default { targets; name; host_context; profile; env = env_node ; toolchain ; loc } -> + | Default { targets; name; host_context; profile; env = env_node ; + toolchain ; loc } -> let merlin = workspace.merlin_context = Some (Workspace.Context.name def) in @@ -633,13 +693,15 @@ let create ~env (workspace : Workspace.t) = | Some t, _ -> Some t | None, default -> default in - (default ~env ~env_nodes:(env_nodes env_node) ~profile ~targets ~name ~merlin - ~host_context ~host_toolchain - >>| fun x -> List.map ~f:(fun x -> (loc,x)) x) - | Opam { base = { targets; name; host_context; profile; env = env_node; toolchain; loc } + (default ~env ~env_nodes:(env_nodes env_node) ~profile ~targets ~name + ~merlin ~host_context ~host_toolchain + >>| fun x -> List.map ~f:(fun x -> (loc,x)) x) + | Opam { base = { targets; name; host_context; profile; env = env_node; + toolchain; loc } ; switch; root; merlin } -> (create_for_opam ~root ~env_nodes:(env_nodes env_node) ~env ~profile - ~switch ~name ~merlin ~targets ~host_context ~host_toolchain:toolchain) + ~switch ~name ~merlin ~targets ~host_context + ~host_toolchain:toolchain) >>| fun x -> List.map ~f:(fun x -> (loc,x)) x) >>| List.concat >>| resolve_host_contexts diff --git a/test/blackbox-tests/dune.inc b/test/blackbox-tests/dune.inc index 068d2d458ad5..f6df91b35dd3 100644 --- a/test/blackbox-tests/dune.inc +++ b/test/blackbox-tests/dune.inc @@ -127,6 +127,14 @@ test-cases/custom-build-dir (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) +(alias + (name custom-cross-compilation) + (deps (package dune) (source_tree test-cases/custom-cross-compilation)) + (action + (chdir + test-cases/custom-cross-compilation + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (alias (name cxx-extension) (deps (package dune) (source_tree test-cases/cxx-extension)) @@ -1460,6 +1468,7 @@ (alias copy_files) (alias cross-compilation) (alias custom-build-dir) + (alias custom-cross-compilation) (alias cxx-extension) (alias default-targets) (alias dep-on-dir-that-does-not-exist) @@ -1636,6 +1645,7 @@ (alias copy-files-non-sub-dir-error) (alias copy_files) (alias custom-build-dir) + (alias custom-cross-compilation) (alias cxx-extension) (alias default-targets) (alias dep-on-dir-that-does-not-exist) diff --git a/test/blackbox-tests/test-cases/custom-cross-compilation/bad-configuration/dune b/test/blackbox-tests/test-cases/custom-cross-compilation/bad-configuration/dune new file mode 100644 index 000000000000..e90108e95790 --- /dev/null +++ b/test/blackbox-tests/test-cases/custom-cross-compilation/bad-configuration/dune @@ -0,0 +1,6 @@ +(executable + (name p) + (public_name p) +) + +(rule (with-stdout-to file (run ./p.exe))) diff --git a/test/blackbox-tests/test-cases/custom-cross-compilation/bad-configuration/dune-project b/test/blackbox-tests/test-cases/custom-cross-compilation/bad-configuration/dune-project new file mode 100644 index 000000000000..42c0c1674315 --- /dev/null +++ b/test/blackbox-tests/test-cases/custom-cross-compilation/bad-configuration/dune-project @@ -0,0 +1 @@ +(lang dune 1.10) diff --git a/test/blackbox-tests/test-cases/custom-cross-compilation/bad-configuration/dune-workspace b/test/blackbox-tests/test-cases/custom-cross-compilation/bad-configuration/dune-workspace new file mode 100644 index 000000000000..799df38e232f --- /dev/null +++ b/test/blackbox-tests/test-cases/custom-cross-compilation/bad-configuration/dune-workspace @@ -0,0 +1,10 @@ +(lang dune 1.10) +(context (default)) +(context (default + (name cross-1) + (host default) +)) +(context (default + (name cross-2) + (host cross-1) +)) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/custom-cross-compilation/bad-configuration/p.ml b/test/blackbox-tests/test-cases/custom-cross-compilation/bad-configuration/p.ml new file mode 100644 index 000000000000..9f2d9df6b2cc --- /dev/null +++ b/test/blackbox-tests/test-cases/custom-cross-compilation/bad-configuration/p.ml @@ -0,0 +1 @@ +let () = Printf.printf "%d\n" 137 diff --git a/test/blackbox-tests/test-cases/custom-cross-compilation/bad-configuration/p.opam b/test/blackbox-tests/test-cases/custom-cross-compilation/bad-configuration/p.opam new file mode 100644 index 000000000000..e69de29bb2d1 diff --git a/test/blackbox-tests/test-cases/custom-cross-compilation/normal/dune b/test/blackbox-tests/test-cases/custom-cross-compilation/normal/dune new file mode 100644 index 000000000000..e90108e95790 --- /dev/null +++ b/test/blackbox-tests/test-cases/custom-cross-compilation/normal/dune @@ -0,0 +1,6 @@ +(executable + (name p) + (public_name p) +) + +(rule (with-stdout-to file (run ./p.exe))) diff --git a/test/blackbox-tests/test-cases/custom-cross-compilation/normal/dune-project b/test/blackbox-tests/test-cases/custom-cross-compilation/normal/dune-project new file mode 100644 index 000000000000..42c0c1674315 --- /dev/null +++ b/test/blackbox-tests/test-cases/custom-cross-compilation/normal/dune-project @@ -0,0 +1 @@ +(lang dune 1.10) diff --git a/test/blackbox-tests/test-cases/custom-cross-compilation/normal/dune-workspace b/test/blackbox-tests/test-cases/custom-cross-compilation/normal/dune-workspace new file mode 100644 index 000000000000..2e87a643fffb --- /dev/null +++ b/test/blackbox-tests/test-cases/custom-cross-compilation/normal/dune-workspace @@ -0,0 +1,6 @@ +(lang dune 1.10) +(context (default)) +(context (default + (name cross) + (host default) +)) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/custom-cross-compilation/normal/p.ml b/test/blackbox-tests/test-cases/custom-cross-compilation/normal/p.ml new file mode 100644 index 000000000000..9f2d9df6b2cc --- /dev/null +++ b/test/blackbox-tests/test-cases/custom-cross-compilation/normal/p.ml @@ -0,0 +1 @@ +let () = Printf.printf "%d\n" 137 diff --git a/test/blackbox-tests/test-cases/custom-cross-compilation/normal/p.opam b/test/blackbox-tests/test-cases/custom-cross-compilation/normal/p.opam new file mode 100644 index 000000000000..e69de29bb2d1 diff --git a/test/blackbox-tests/test-cases/custom-cross-compilation/run.t b/test/blackbox-tests/test-cases/custom-cross-compilation/run.t new file mode 100644 index 000000000000..58faebd5a7a2 --- /dev/null +++ b/test/blackbox-tests/test-cases/custom-cross-compilation/run.t @@ -0,0 +1,35 @@ + $ dune build --root ./normal --display short file @install + Entering directory 'normal' + ocamldep .p.eobjs/p.ml.d [cross] + ocamlc .p.eobjs/byte/p.{cmi,cmo,cmt} [cross] + ocamlopt .p.eobjs/native/p.{cmx,o} [cross] + ocamlopt p.exe [cross] + ocamldep .p.eobjs/p.ml.d + ocamlc .p.eobjs/byte/p.{cmi,cmo,cmt} + ocamlopt .p.eobjs/native/p.{cmx,o} + ocamlopt p.exe + p file [cross] + p file + + $ cat normal/_build/cross/file + 137 + + $ dune build --root ./bad-configuration --display short file @install + Entering directory 'bad-configuration' + File "dune-workspace", line 3, characters 9-53: + 3 | (context (default + 4 | (name cross-1) + 5 | (host default) + 6 | )) + Error: Context 'cross-1' is both a host (for 'cross-2') and a target (for 'default') context. + [1] + + $ dune build --root ./topological-loop --display short file @install + Entering directory 'topological-loop' + File "dune-workspace", line 3, characters 9-53: + 3 | (context (default + 4 | (name cross-1) + 5 | (host cross-3) + 6 | )) + Error: Context 'cross-1' is both a host (for 'cross-2') and a target (for 'cross-3') context. + [1] diff --git a/test/blackbox-tests/test-cases/custom-cross-compilation/topological-loop/dune b/test/blackbox-tests/test-cases/custom-cross-compilation/topological-loop/dune new file mode 100644 index 000000000000..e90108e95790 --- /dev/null +++ b/test/blackbox-tests/test-cases/custom-cross-compilation/topological-loop/dune @@ -0,0 +1,6 @@ +(executable + (name p) + (public_name p) +) + +(rule (with-stdout-to file (run ./p.exe))) diff --git a/test/blackbox-tests/test-cases/custom-cross-compilation/topological-loop/dune-project b/test/blackbox-tests/test-cases/custom-cross-compilation/topological-loop/dune-project new file mode 100644 index 000000000000..42c0c1674315 --- /dev/null +++ b/test/blackbox-tests/test-cases/custom-cross-compilation/topological-loop/dune-project @@ -0,0 +1 @@ +(lang dune 1.10) diff --git a/test/blackbox-tests/test-cases/custom-cross-compilation/topological-loop/dune-workspace b/test/blackbox-tests/test-cases/custom-cross-compilation/topological-loop/dune-workspace new file mode 100644 index 000000000000..589f6b3b1a1a --- /dev/null +++ b/test/blackbox-tests/test-cases/custom-cross-compilation/topological-loop/dune-workspace @@ -0,0 +1,14 @@ +(lang dune 1.10) +(context (default)) +(context (default + (name cross-1) + (host cross-3) +)) +(context (default + (name cross-2) + (host cross-1) +)) +(context (default + (name cross-3) + (host cross-2) +)) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/custom-cross-compilation/topological-loop/p.ml b/test/blackbox-tests/test-cases/custom-cross-compilation/topological-loop/p.ml new file mode 100644 index 000000000000..9f2d9df6b2cc --- /dev/null +++ b/test/blackbox-tests/test-cases/custom-cross-compilation/topological-loop/p.ml @@ -0,0 +1 @@ +let () = Printf.printf "%d\n" 137 diff --git a/test/blackbox-tests/test-cases/custom-cross-compilation/topological-loop/p.opam b/test/blackbox-tests/test-cases/custom-cross-compilation/topological-loop/p.opam new file mode 100644 index 000000000000..e69de29bb2d1