From aa8810d5da873831df38c8d2b33d16f40df62839 Mon Sep 17 00:00:00 2001 From: Stephen Sherratt Date: Mon, 9 Sep 2024 14:54:12 +1000 Subject: [PATCH 1/2] Generalize dev tool fetching Remove references to ocamlformat from the fetch rules and create fetch rules for all dev tools. Signed-off-by: Stephen Sherratt --- src/dune_pkg/dev_tool.ml | 2 ++ src/dune_pkg/dev_tool.mli | 1 + src/dune_rules/fetch_rules.ml | 15 +++++++++------ 3 files changed, 12 insertions(+), 6 deletions(-) diff --git a/src/dune_pkg/dev_tool.ml b/src/dune_pkg/dev_tool.ml index 0d2f26ad45f..9d927d36469 100644 --- a/src/dune_pkg/dev_tool.ml +++ b/src/dune_pkg/dev_tool.ml @@ -2,6 +2,8 @@ open! Import type t = Ocamlformat +let all = [ Ocamlformat ] + let equal a b = match a, b with | Ocamlformat, Ocamlformat -> true diff --git a/src/dune_pkg/dev_tool.mli b/src/dune_pkg/dev_tool.mli index dc8c0dfe626..a59e0adf40d 100644 --- a/src/dune_pkg/dev_tool.mli +++ b/src/dune_pkg/dev_tool.mli @@ -2,6 +2,7 @@ open! Import type t = Ocamlformat +val all : t list val equal : t -> t -> bool val package_name : t -> Package_name.t val of_package_name : Package_name.t -> t diff --git a/src/dune_rules/fetch_rules.ml b/src/dune_rules/fetch_rules.ml index 545c5386bf2..8a66ce73c31 100644 --- a/src/dune_rules/fetch_rules.ml +++ b/src/dune_rules/fetch_rules.ml @@ -162,12 +162,15 @@ let find_checksum, find_url = let all = Memo.lazy_ (fun () -> let* init = - let init = Checksum.Map.empty, Digest.Map.empty in - Fs_memo.dir_exists - (In_source_dir (Dune_pkg.Lock_dir.dev_tool_lock_dir_path Ocamlformat)) - >>= function - | false -> Memo.return init - | true -> Lock_dir.of_dev_tool Ocamlformat >>| add_checksums_and_urls init + Memo.List.fold_left + Dune_pkg.Dev_tool.all + ~init:(Checksum.Map.empty, Digest.Map.empty) + ~f:(fun acc dev_tool -> + Fs_memo.dir_exists + (In_source_dir (Dune_pkg.Lock_dir.dev_tool_lock_dir_path dev_tool)) + >>= function + | false -> Memo.return acc + | true -> Lock_dir.of_dev_tool dev_tool >>| add_checksums_and_urls acc) in Per_context.list () >>= Memo.parallel_map ~f:Lock_dir.get From 67dc7d367aff09e396940474e86cce0c920502b2 Mon Sep 17 00:00:00 2001 From: Stephen Sherratt Date: Tue, 10 Sep 2024 15:22:10 +1000 Subject: [PATCH 2/2] Add odoc dev tool The command `dune ocaml doc` will now lock, build, and run odoc as a dev tool if the dev tools feature is enabled. Signed-off-by: Stephen Sherratt --- bin/build_cmd.ml | 3 +- bin/lock_dev_tool.ml | 180 +++++++++++++++--- bin/lock_dev_tool.mli | 5 +- bin/ocaml/doc.ml | 7 + src/dune_pkg/dev_tool.ml | 17 +- src/dune_pkg/dev_tool.mli | 6 +- src/dune_rules/dune_rules.ml | 1 + src/dune_rules/odoc.ml | 33 +++- .../test-cases/pkg/odoc/dev-tool-odoc-basic.t | 38 ++++ .../pkg/odoc/dev-tool-odoc-no-lock-dir.t | 15 ++ .../odoc/dev-tool-odoc-no-ocaml-lockfile.t | 20 ++ ...tool-odoc-relock-on-ocaml-version-change.t | 78 ++++++++ test/blackbox-tests/test-cases/pkg/odoc/dune | 3 + .../test-cases/pkg/odoc/helpers.sh | 27 +++ 14 files changed, 394 insertions(+), 39 deletions(-) create mode 100644 test/blackbox-tests/test-cases/pkg/odoc/dev-tool-odoc-basic.t create mode 100644 test/blackbox-tests/test-cases/pkg/odoc/dev-tool-odoc-no-lock-dir.t create mode 100644 test/blackbox-tests/test-cases/pkg/odoc/dev-tool-odoc-no-ocaml-lockfile.t create mode 100644 test/blackbox-tests/test-cases/pkg/odoc/dev-tool-odoc-relock-on-ocaml-version-change.t create mode 100644 test/blackbox-tests/test-cases/pkg/odoc/dune create mode 100644 test/blackbox-tests/test-cases/pkg/odoc/helpers.sh diff --git a/bin/build_cmd.ml b/bin/build_cmd.ml index 66c636c72ae..fec6191252a 100644 --- a/bin/build_cmd.ml +++ b/bin/build_cmd.ml @@ -241,8 +241,7 @@ let fmt = this logic remain outside of `dune build`, as `dune build` is intended to only build targets, and generating a lockdir is not building a target. *) - Action_builder.of_memo - (Lock_dev_tool.lock_ocamlformat () |> Memo.of_non_reproducible_fiber) + Action_builder.of_memo (Lock_dev_tool.lock_ocamlformat ()) else Action_builder.return () in let dir = Path.(relative root) (Common.prefix_target common ".") in diff --git a/bin/lock_dev_tool.ml b/bin/lock_dev_tool.ml index bcf676e1b49..1bfc6593983 100644 --- a/bin/lock_dev_tool.ml +++ b/bin/lock_dev_tool.ml @@ -1,5 +1,6 @@ open Dune_config open Import +module Lock_dir = Dune_pkg.Lock_dir let enabled = Config.make_toggle ~name:"lock_dev_tool" ~default:Dune_rules.Setup.lock_dev_tool @@ -15,7 +16,7 @@ let is_enabled = (* The solver satisfies dependencies for local packages, but dev tools are not local packages. As a workaround, create an empty local package which depends on the dev tool package. *) -let make_local_package_wrapping_dev_tool ~dev_tool ~dev_tool_version +let make_local_package_wrapping_dev_tool ~dev_tool ~dev_tool_version ~extra_dependencies : Dune_pkg.Local_package.t = let dev_tool_pkg_name = Dune_pkg.Dev_tool.package_name dev_tool in @@ -35,7 +36,7 @@ let make_local_package_wrapping_dev_tool ~dev_tool ~dev_tool_version in { Dune_pkg.Local_package.name = local_package_name ; version = None - ; dependencies = [ dependency ] + ; dependencies = dependency :: extra_dependencies ; conflicts = [] ; depopts = [] ; pins = Package_name.Map.empty @@ -44,39 +45,166 @@ let make_local_package_wrapping_dev_tool ~dev_tool ~dev_tool_version } ;; -let solve ~local_packages ~lock_dirs = - let open Fiber.O in +let solve ~dev_tool ~local_packages = + let open Memo.O in let* solver_env_from_current_system = Dune_pkg.Sys_poll.make ~path:(Env_path.path Stdune.Env.initial) |> Dune_pkg.Sys_poll.solver_env_from_current_system + |> Memo.of_reproducible_fiber >>| Option.some - and* workspace = - Memo.run - @@ - let open Memo.O in - let+ workspace = Workspace.workspace () in - workspace + and* workspace = Workspace.workspace () in + let lock_dir = Lock_dir.dev_tool_lock_dir_path dev_tool in + Memo.of_reproducible_fiber + @@ Lock.solve + workspace + ~local_packages + ~project_sources:Dune_pkg.Pin_stanza.DB.empty + ~solver_env_from_current_system + ~version_preference:None + ~lock_dirs:[ lock_dir ] +;; + +let compiler_package_name = Package_name.of_string "ocaml" + +(* Some dev tools must be built with the same version of the ocaml + compiler as the project. This function returns the version of the + "ocaml" package used to compile the project in the default build + context. + + TODO: This only makes sure that the version of compiler used to + build the dev tool matches the version of the compiler used to + build this project. This will fail if the project is built with a + custom compiler (e.g. ocaml-variants) since the version of the + compiler will be the same between the project and dev tool while + they still use different compilers. A more robust solution would be + to ensure that the exact compiler package used to build the dev + tool matches the package used to build the compiler. *) +let locked_ocaml_compiler_version () = + let open Memo.O in + let context = + (* Dev tools are only ever built with the default context. *) + Context_name.default in - Lock.solve - workspace - ~local_packages - ~project_sources:Dune_pkg.Pin_stanza.DB.empty - ~solver_env_from_current_system - ~version_preference:None - ~lock_dirs + let* result = Dune_rules.Lock_dir.get context in + match result with + | Error _ -> + User_error.raise + [ Pp.text "Unable to load the lockdir for the default build context." ] + ~hints: + [ Pp.concat + ~sep:Pp.space + [ Pp.text "Try running"; User_message.command "dune pkg lock" ] + ] + | Ok { packages; _ } -> + (match Package_name.Map.find packages compiler_package_name with + | None -> + User_error.raise + [ Pp.textf + "The lockdir doesn't contain a lockfile for the package %S." + (Package_name.to_string compiler_package_name) + ] + ~hints: + [ Pp.concat + ~sep:Pp.space + [ Pp.textf + "Add a dependency on %S to one of the packages in dune-project and \ + then run" + (Package_name.to_string compiler_package_name) + ; User_message.command "dune pkg lock" + ] + ] + | Some pkg -> Memo.return pkg.info.version) ;; -let lock_ocamlformat () : unit Fiber.t = - let version = Dune_pkg.Ocamlformat.version_of_current_project's_ocamlformat_config () in - let ocamlformat_dev_tool_lock_dir = - Dune_pkg.Lock_dir.dev_tool_lock_dir_path Ocamlformat +(* Returns a dependency constraint on the version of the ocaml + compiler in the lockdir associated with the default context. *) +let locked_ocaml_compiler_constraint () = + let open Dune_lang in + let open Memo.O in + let+ ocaml_compiler_version = locked_ocaml_compiler_version () in + let constraint_ = + Some + (Package_constraint.Uop + (Eq, String_literal (Package_version.to_string ocaml_compiler_version))) + in + { Package_dependency.name = compiler_package_name; constraint_ } +;; + +let extra_dependencies dev_tool = + let open Memo.O in + match Dune_pkg.Dev_tool.needs_to_build_with_same_compiler_as_project dev_tool with + | false -> Memo.return [] + | true -> + let+ constraint_ = locked_ocaml_compiler_constraint () in + [ constraint_ ] +;; + +let lockdir_status dev_tool = + let open Memo.O in + let dev_tool_lock_dir = Lock_dir.dev_tool_lock_dir_path dev_tool in + match Lock_dir.read_disk dev_tool_lock_dir with + | Error _ -> Memo.return `No_lockdir + | Ok { packages; _ } -> + (match Dune_pkg.Dev_tool.needs_to_build_with_same_compiler_as_project dev_tool with + | false -> Memo.return `Lockdir_ok + | true -> + (match Package_name.Map.find packages compiler_package_name with + | None -> Memo.return `No_compiler_lockfile_in_lockdir + | Some { info; _ } -> + let+ ocaml_compiler_version = locked_ocaml_compiler_version () in + (match Package_version.equal info.version ocaml_compiler_version with + | true -> `Lockdir_ok + | false -> + `Dev_tool_needs_to_be_relocked_because_project_compiler_version_changed + (User_message.make + [ Pp.textf + "The version of the compiler package (%S) in this project's \ + lockdir has changed to %s (formerly the compiler version was %s). \ + The dev-tool %S will be re-locked and rebuilt with this version \ + of the compiler." + (Package_name.to_string compiler_package_name) + (Package_version.to_string ocaml_compiler_version) + (Package_version.to_string info.version) + (Dune_pkg.Dev_tool.package_name dev_tool |> Package_name.to_string) + ])))) +;; + +let lock_dev_tool dev_tool version = + let open Memo.O in + let* need_to_solve = + lockdir_status dev_tool + >>| function + | `Lockdir_ok -> false + | `No_lockdir -> true + | `No_compiler_lockfile_in_lockdir -> + Console.print + [ Pp.textf + "The lockdir for %s lacks a lockfile for %s. Regenerating..." + (Dune_pkg.Dev_tool.package_name dev_tool |> Package_name.to_string) + (Package_name.to_string compiler_package_name) + ]; + true + | `Dev_tool_needs_to_be_relocked_because_project_compiler_version_changed message -> + Console.print_user_message message; + true in - if not (Path.exists @@ Path.source ocamlformat_dev_tool_lock_dir) - then ( + if need_to_solve + then + let* extra_dependencies = extra_dependencies dev_tool in let local_pkg = - make_local_package_wrapping_dev_tool ~dev_tool:Ocamlformat ~dev_tool_version:version + make_local_package_wrapping_dev_tool + ~dev_tool + ~dev_tool_version:version + ~extra_dependencies in let local_packages = Package_name.Map.singleton local_pkg.name local_pkg in - solve ~local_packages ~lock_dirs:[ ocamlformat_dev_tool_lock_dir ]) - else Fiber.return () + solve ~dev_tool ~local_packages + else Memo.return () ;; + +let lock_ocamlformat () = + let version = Dune_pkg.Ocamlformat.version_of_current_project's_ocamlformat_config () in + lock_dev_tool Ocamlformat version +;; + +let lock_odoc () = lock_dev_tool Odoc None diff --git a/bin/lock_dev_tool.mli b/bin/lock_dev_tool.mli index 85f185ff83f..82b4f41e665 100644 --- a/bin/lock_dev_tool.mli +++ b/bin/lock_dev_tool.mli @@ -1,2 +1,5 @@ +open! Import + val is_enabled : bool Lazy.t -val lock_ocamlformat : unit -> unit Fiber.t +val lock_ocamlformat : unit -> unit Memo.t +val lock_odoc : unit -> unit Memo.t diff --git a/bin/ocaml/doc.ml b/bin/ocaml/doc.ml index 584438b2f99..c2be6924d15 100644 --- a/bin/ocaml/doc.ml +++ b/bin/ocaml/doc.ml @@ -13,12 +13,19 @@ let man = let info = Cmd.info "doc" ~doc ~man +let lock_odoc_if_dev_tool_enabled () = + match Lazy.force Lock_dev_tool.is_enabled with + | false -> Action_builder.return () + | true -> Action_builder.of_memo (Lock_dev_tool.lock_odoc ()) +;; + let term = let+ builder = Common.Builder.term in let common, config = Common.init builder in let request (setup : Main.build_system) = let dir = Path.(relative root) (Common.prefix_target common ".") in let open Action_builder.O in + let* () = lock_odoc_if_dev_tool_enabled () in let+ () = Alias.in_dir ~name:Dune_rules.Alias.doc ~recursive:true ~contexts:setup.contexts dir |> Alias.request diff --git a/src/dune_pkg/dev_tool.ml b/src/dune_pkg/dev_tool.ml index 9d927d36469..b2fbda64ec6 100644 --- a/src/dune_pkg/dev_tool.ml +++ b/src/dune_pkg/dev_tool.ml @@ -1,29 +1,42 @@ open! Import -type t = Ocamlformat +type t = + | Ocamlformat + | Odoc -let all = [ Ocamlformat ] +let all = [ Ocamlformat; Odoc ] let equal a b = match a, b with | Ocamlformat, Ocamlformat -> true + | Odoc, Odoc -> true + | _ -> false ;; let package_name = function | Ocamlformat -> Package_name.of_string "ocamlformat" + | Odoc -> Package_name.of_string "odoc" ;; let of_package_name package_name = match Package_name.to_string package_name with | "ocamlformat" -> Ocamlformat + | "odoc" -> Odoc | other -> User_error.raise [ Pp.textf "No such dev tool: %s" other ] ;; let exe_name = function | Ocamlformat -> "ocamlformat" + | Odoc -> "odoc" ;; let exe_path_components_within_package t = match t with | Ocamlformat -> [ "bin"; exe_name t ] + | Odoc -> [ "bin"; exe_name t ] +;; + +let needs_to_build_with_same_compiler_as_project = function + | Ocamlformat -> false + | Odoc -> true ;; diff --git a/src/dune_pkg/dev_tool.mli b/src/dune_pkg/dev_tool.mli index a59e0adf40d..66c1e474c4a 100644 --- a/src/dune_pkg/dev_tool.mli +++ b/src/dune_pkg/dev_tool.mli @@ -1,6 +1,8 @@ open! Import -type t = Ocamlformat +type t = + | Ocamlformat + | Odoc val all : t list val equal : t -> t -> bool @@ -11,3 +13,5 @@ val exe_name : t -> string (** Returns the path to this tool's executable relative to the root of this tool's package directory *) val exe_path_components_within_package : t -> string list + +val needs_to_build_with_same_compiler_as_project : t -> bool diff --git a/src/dune_rules/dune_rules.ml b/src/dune_rules/dune_rules.ml index dc1d7855020..9c71a562ff8 100644 --- a/src/dune_rules/dune_rules.ml +++ b/src/dune_rules/dune_rules.ml @@ -69,6 +69,7 @@ module Melange_stanzas = Melange_stanzas module Executables = Executables module Tests = Tests module Stanzas = Stanzas +module Lock_dir = Lock_dir module Install_rules = struct let install_file = Install_rules.install_file diff --git a/src/dune_rules/odoc.ml b/src/dune_rules/odoc.ml index 9a8304c8d0b..3adc7d0635b 100644 --- a/src/dune_rules/odoc.ml +++ b/src/dune_rules/odoc.ml @@ -245,14 +245,33 @@ let odoc_base_flags quiet build_dir = | Nonfatal -> S [] ;; +let odoc_dev_tool_lock_dir_exists () = + let path = Dune_pkg.Lock_dir.dev_tool_lock_dir_path Odoc in + Fs_memo.dir_exists (Path.Outside_build_dir.In_source_dir path) +;; + +let odoc_dev_tool_exe_path_building_if_necessary () = + let open Action_builder.O in + let path = Path.build (Pkg_dev_tool.exe_path Odoc) in + let+ () = Action_builder.path path in + Ok path +;; + let odoc_program sctx dir = - Super_context.resolve_program - sctx - ~dir - ~where:Original_path - "odoc" - ~loc:None - ~hint:"opam install odoc" + let open Action_builder.O in + let* odoc_dev_tool_lock_dir_exists = + Action_builder.of_memo (odoc_dev_tool_lock_dir_exists ()) + in + match odoc_dev_tool_lock_dir_exists with + | true -> odoc_dev_tool_exe_path_building_if_necessary () + | false -> + Super_context.resolve_program + sctx + ~dir + ~where:Original_path + "odoc" + ~loc:None + ~hint:"opam install odoc" ;; let run_odoc sctx ~dir command ~quiet ~flags_for args = diff --git a/test/blackbox-tests/test-cases/pkg/odoc/dev-tool-odoc-basic.t b/test/blackbox-tests/test-cases/pkg/odoc/dev-tool-odoc-basic.t new file mode 100644 index 00000000000..52fa0501a2c --- /dev/null +++ b/test/blackbox-tests/test-cases/pkg/odoc/dev-tool-odoc-basic.t @@ -0,0 +1,38 @@ +Test that the "dune ocaml doc" command causes odoc to be +locked, built and run when the command is run from a dune project with +a lockdir containing an "ocaml" lockfile. + + $ . ../helpers.sh + $ . ./helpers.sh + + $ mkrepo + $ make_mock_odoc_package + $ mkpkg ocaml 5.2.0 + + $ setup_odoc_workspace + + $ cat > dune-project < (lang dune 3.16) + > + > (package + > (name foo) + > (allow_empty)) + > EOF + + $ make_lockdir + $ cat > dune.lock/ocaml.pkg < (version 5.2.0) + > EOF + + $ DUNE_CONFIG__LOCK_DEV_TOOL=enabled dune ocaml doc + Solution for dev-tools.locks/odoc: + - ocaml.5.2.0 + - odoc.0.0.1 + hello from fake odoc + hello from fake odoc + File "_doc/_html/_unknown_", line 1, characters 0-0: + Error: Rule failed to produce directory "_doc/_html/odoc.support" + File "_doc/_odoc/pkg/foo/_unknown_", line 1, characters 0-0: + Error: Rule failed to generate the following targets: + - _doc/_odoc/pkg/foo/page-index.odoc + [1] diff --git a/test/blackbox-tests/test-cases/pkg/odoc/dev-tool-odoc-no-lock-dir.t b/test/blackbox-tests/test-cases/pkg/odoc/dev-tool-odoc-no-lock-dir.t new file mode 100644 index 00000000000..f50aad50db6 --- /dev/null +++ b/test/blackbox-tests/test-cases/pkg/odoc/dev-tool-odoc-no-lock-dir.t @@ -0,0 +1,15 @@ +Exercise the behaviour of "dune ocaml doc" when run in a +dune project with no lockdir. + + $ cat > dune-project < (lang dune 3.16) + > + > (package + > (name foo) + > (allow_empty)) + > EOF + + $ DUNE_CONFIG__LOCK_DEV_TOOL=enabled dune ocaml doc + Error: Unable to load the lockdir for the default build context. + Hint: Try running 'dune pkg lock' + [1] diff --git a/test/blackbox-tests/test-cases/pkg/odoc/dev-tool-odoc-no-ocaml-lockfile.t b/test/blackbox-tests/test-cases/pkg/odoc/dev-tool-odoc-no-ocaml-lockfile.t new file mode 100644 index 00000000000..6a673dad47f --- /dev/null +++ b/test/blackbox-tests/test-cases/pkg/odoc/dev-tool-odoc-no-ocaml-lockfile.t @@ -0,0 +1,20 @@ +Exercise the behaviour of "dune ocaml doc" when the lockdir +doesn't contain a lockfile for the "ocaml" package. + + $ . ../helpers.sh + + $ cat > dune-project < (lang dune 3.16) + > + > (package + > (name foo) + > (allow_empty)) + > EOF + + $ make_lockdir + + $ DUNE_CONFIG__LOCK_DEV_TOOL=enabled dune ocaml doc + Error: The lockdir doesn't contain a lockfile for the package "ocaml". + Hint: Add a dependency on "ocaml" to one of the packages in dune-project and + then run 'dune pkg lock' + [1] diff --git a/test/blackbox-tests/test-cases/pkg/odoc/dev-tool-odoc-relock-on-ocaml-version-change.t b/test/blackbox-tests/test-cases/pkg/odoc/dev-tool-odoc-relock-on-ocaml-version-change.t new file mode 100644 index 00000000000..ae7376a39d5 --- /dev/null +++ b/test/blackbox-tests/test-cases/pkg/odoc/dev-tool-odoc-relock-on-ocaml-version-change.t @@ -0,0 +1,78 @@ +Test that if the version of the "ocaml" package in the project's +lockdir changes then the odoc dev tool is re-locked to be built +with the version of the ocaml compiler now in the project's +lockdir. This is necessary because odoc must be compiled with the +same version of the ocaml compiler as the code that it's analyzing. + + $ . ../helpers.sh + $ . ./helpers.sh + + $ mkrepo + $ make_mock_odoc_package + $ mkpkg ocaml 5.2.0 + $ mkpkg ocaml 5.1.0 + + $ setup_odoc_workspace + + $ cat > dune-project < (lang dune 3.16) + > + > (package + > (name foo) + > (allow_empty)) + > EOF + + $ make_lockdir + $ cat > dune.lock/ocaml.pkg < (version 5.2.0) + > EOF + +Initially odoc will be depend on ocaml.5.2.0 to match the project. + $ DUNE_CONFIG__LOCK_DEV_TOOL=enabled dune ocaml doc + Solution for dev-tools.locks/odoc: + - ocaml.5.2.0 + - odoc.0.0.1 + hello from fake odoc + hello from fake odoc + File "_doc/_html/_unknown_", line 1, characters 0-0: + Error: Rule failed to produce directory "_doc/_html/odoc.support" + File "_doc/_odoc/pkg/foo/_unknown_", line 1, characters 0-0: + Error: Rule failed to generate the following targets: + - _doc/_odoc/pkg/foo/page-index.odoc + [1] + $ cat dev-tools.locks/odoc/ocaml.pkg + (version 5.2.0) + +We can re-run "dune ocaml doc" without relocking or rebuilding. + $ DUNE_CONFIG__LOCK_DEV_TOOL=enabled dune ocaml doc + hello from fake odoc + hello from fake odoc + File "_doc/_html/_unknown_", line 1, characters 0-0: + Error: Rule failed to produce directory "_doc/_html/odoc.support" + File "_doc/_odoc/pkg/foo/_unknown_", line 1, characters 0-0: + Error: Rule failed to generate the following targets: + - _doc/_odoc/pkg/foo/page-index.odoc + [1] + +Change the version of ocaml that the project depends on. + $ cat > dune.lock/ocaml.pkg < (version 5.1.0) + > EOF + +Running "dune ocaml doc" causes odoc to be relocked and rebuilt +before running. Odoc now depends on ocaml.5.1.0. + $ DUNE_CONFIG__LOCK_DEV_TOOL=enabled dune ocaml doc + The version of the compiler package ("ocaml") in this project's lockdir has + changed to 5.1.0 (formerly the compiler version was 5.2.0). The dev-tool + "odoc" will be re-locked and rebuilt with this version of the compiler. + Solution for dev-tools.locks/odoc: + - ocaml.5.1.0 + - odoc.0.0.1 + hello from fake odoc + hello from fake odoc + File "_doc/_html/_unknown_", line 1, characters 0-0: + Error: Rule failed to produce directory "_doc/_html/odoc.support" + File "_doc/_odoc/pkg/foo/_unknown_", line 1, characters 0-0: + Error: Rule failed to generate the following targets: + - _doc/_odoc/pkg/foo/page-index.odoc + [1] diff --git a/test/blackbox-tests/test-cases/pkg/odoc/dune b/test/blackbox-tests/test-cases/pkg/odoc/dune new file mode 100644 index 00000000000..552dd6cf4a9 --- /dev/null +++ b/test/blackbox-tests/test-cases/pkg/odoc/dune @@ -0,0 +1,3 @@ +(cram + (deps helpers.sh) + (applies_to :whole_subtree)) diff --git a/test/blackbox-tests/test-cases/pkg/odoc/helpers.sh b/test/blackbox-tests/test-cases/pkg/odoc/helpers.sh new file mode 100644 index 00000000000..bfc2ba3ddd6 --- /dev/null +++ b/test/blackbox-tests/test-cases/pkg/odoc/helpers.sh @@ -0,0 +1,27 @@ +# Create a dune-workspace file with mock repos set up for the main +# project and the odoc lockdir. +setup_odoc_workspace() { + cat > dune-workspace < %{bin}%/odoc" ] + [ "sh" "-c" "echo 'echo hello from fake odoc' >> %{bin}%/odoc" ] + [ "sh" "-c" "chmod a+x %{bin}%/odoc" ] +] +EOF +}