From 79b7df50249c52f66c257ff2d43964aa07e0259a Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 9 May 2024 18:56:43 -0600 Subject: [PATCH] fix(pkg): remove External_copy Make it the same as file://. Both of these constructors mean the same thing, so let's keep one of them. Signed-off-by: Rudi Grinberg --- src/dune_pkg/opam_solver.ml | 4 +- src/dune_pkg/source.ml | 97 ++++++++----------- src/dune_pkg/source.mli | 8 +- src/dune_rules/fetch_rules.ml | 49 ++++++---- src/dune_rules/fetch_rules.mli | 3 +- src/dune_rules/lock_dir.ml | 29 ++++++ src/dune_rules/lock_dir.mli | 4 + src/dune_rules/pkg_rules.ml | 80 +++++++++------ .../pin-stanza/update-non-dune-local-pin.t | 19 +--- .../pkg/unavailable-package-source.t | 4 +- .../dune_pkg/dune_pkg_unit_tests.ml | 51 +++++----- 11 files changed, 193 insertions(+), 155 deletions(-) diff --git a/src/dune_pkg/opam_solver.ml b/src/dune_pkg/opam_solver.ml index 57c35bcff2d..005494fd1cf 100644 --- a/src/dune_pkg/opam_solver.ml +++ b/src/dune_pkg/opam_solver.ml @@ -569,7 +569,7 @@ let opam_package_to_lock_file_pkg (* opam discards the later checksums, so we only take the first one *) | checksum :: _ -> Some (Loc.none, Checksum.of_opam_hash checksum) in - Source.Fetch { Source.url; checksum } )) + { Source.url; checksum } )) in let info = let url = OpamFile.OPAM.url opam_file in @@ -581,7 +581,7 @@ let opam_package_to_lock_file_pkg |> Option.map ~f:(fun hash -> Loc.none, Checksum.of_opam_hash hash) in let url = Loc.none, OpamFile.URL.url url in - Source.Fetch { url; checksum }) + { Source.url; checksum }) in let dev = Package_name.Set.mem pinned_package_names name diff --git a/src/dune_pkg/source.ml b/src/dune_pkg/source.ml index a1fb738fb73..26e9326be05 100644 --- a/src/dune_pkg/source.ml +++ b/src/dune_pkg/source.ml @@ -1,48 +1,34 @@ open Import -type fetch = +type t = { url : Loc.t * OpamUrl.t ; checksum : (Loc.t * Checksum.t) option } -type t = - | External_copy of Loc.t * Path.External.t - | Fetch of fetch - -let remove_locs = function - | External_copy (_loc, path) -> External_copy (Loc.none, path) - | Fetch { url = _loc, url; checksum } -> - Fetch - { url = Loc.none, url - ; checksum = Option.map checksum ~f:(fun (_loc, checksum) -> Loc.none, checksum) - } +let remove_locs { url = _loc, url; checksum } = + { url = Loc.none, url + ; checksum = Option.map checksum ~f:(fun (_loc, checksum) -> Loc.none, checksum) + } ;; -let equal a b = - match a, b with - | External_copy (loc, path), External_copy (other_loc, other_path) -> - Loc.equal loc other_loc && Path.External.equal path other_path - | ( Fetch { url = loc, url; checksum } - , Fetch { url = other_loc, other_url; checksum = other_checksum } ) -> - Loc.equal loc other_loc - && OpamUrl.equal url other_url - && Option.equal - (fun (loc, checksum) (other_loc, other_checksum) -> - Loc.equal loc other_loc && Checksum.equal checksum other_checksum) - checksum - other_checksum - | _ -> false +let equal + { url = loc, url; checksum } + { url = other_loc, other_url; checksum = other_checksum } + = + Loc.equal loc other_loc + && OpamUrl.equal url other_url + && Option.equal + (fun (loc, checksum) (other_loc, other_checksum) -> + Loc.equal loc other_loc && Checksum.equal checksum other_checksum) + checksum + other_checksum ;; -let to_dyn = function - | External_copy (_loc, path) -> - Dyn.variant "External_copy" [ Path.External.to_dyn path ] - | Fetch { url = _loc, url; checksum } -> - Dyn.variant - "Fetch" - [ Dyn.string (OpamUrl.to_string url) - ; Dyn.option (fun (_loc, checksum) -> Checksum.to_dyn checksum) checksum - ] +let to_dyn { url = _loc, url; checksum } = + Dyn.record + [ "url", Dyn.string (OpamUrl.to_string url) + ; "checksum", Dyn.option (fun (_loc, checksum) -> Checksum.to_dyn checksum) checksum + ] ;; let fetch_and_hash_archive_cached = @@ -68,7 +54,7 @@ let fetch_and_hash_archive_cached = None ;; -let compute_missing_checksum_of_fetch +let compute_missing_checksum ({ url = url_loc, url; checksum } as fetch) package_name ~pinned @@ -98,15 +84,6 @@ let compute_missing_checksum_of_fetch >>| Option.value ~default:fetch ;; -let compute_missing_checksum t package_name ~pinned = - let open Fiber.O in - match t with - | External_copy _ -> Fiber.return t - | Fetch fetch -> - let+ fetch = compute_missing_checksum_of_fetch fetch package_name ~pinned in - Fetch fetch -;; - module Fields = struct let copy = "copy" let fetch = "fetch" @@ -128,20 +105,27 @@ let decode_fetch = { url = url_loc, url; checksum } ;; +let external_copy (loc, path) = + let path = Path.External.to_string path in + let url : OpamUrl.t = { transport = "file"; path; hash = None; backend = `rsync } in + { url = loc, url; checksum = None } +;; + let decode = let open Decoder in sum [ ( Fields.copy , located string >>| fun (loc, source) path -> - External_copy - ( loc - , if Filename.is_relative source - then Path.External.relative path source - else Path.External.of_string source ) ) + let path = + if Filename.is_relative source + then Path.External.relative path source + else Path.External.of_string source + in + external_copy (loc, path) ) ; ( Fields.fetch , let+ fetch = fields decode_fetch in - fun _ -> Fetch fetch ) + fun _ -> fetch ) ] ;; @@ -154,7 +138,12 @@ let encode_fetch_field { url = _loc, url; checksum } = let encode t = let open Encoder in - match t with - | External_copy (_loc, path) -> constr Fields.copy string (Path.External.to_string path) - | Fetch fetch -> named_record_fields Fields.fetch (encode_fetch_field fetch) + named_record_fields Fields.fetch (encode_fetch_field t) +;; + +let kind t = + let _, url = t.url in + if OpamUrl0.is_local url && url.backend = `rsync + then `Directory_or_archive (Path.External.of_string url.path) + else `Fetch ;; diff --git a/src/dune_pkg/source.mli b/src/dune_pkg/source.mli index 3c8eb9ea4b4..990bdbdb487 100644 --- a/src/dune_pkg/source.mli +++ b/src/dune_pkg/source.mli @@ -1,17 +1,15 @@ open Import -type fetch = +type t = { url : Loc.t * OpamUrl.t ; checksum : (Loc.t * Checksum.t) option } -type t = - | External_copy of Loc.t * Path.External.t - | Fetch of fetch - val equal : t -> t -> bool val decode : (Path.External.t -> t) Dune_sexp.Decoder.t val encode : t -> Dune_sexp.t val to_dyn : t -> Dyn.t val remove_locs : t -> t val compute_missing_checksum : t -> Package_name.t -> pinned:bool -> t Fiber.t +val external_copy : Loc.t * Path.External.t -> t +val kind : t -> [ `Directory_or_archive of Path.External.t | `Fetch ] diff --git a/src/dune_rules/fetch_rules.ml b/src/dune_rules/fetch_rules.ml index 823a1024abd..5064644a610 100644 --- a/src/dune_rules/fetch_rules.ml +++ b/src/dune_rules/fetch_rules.ml @@ -8,6 +8,7 @@ include struct module Rev_store = Rev_store module Pkg = Lock_dir.Pkg module OpamUrl = OpamUrl + module Source = Source end let context_name = Context_name.of_string "_fetch" @@ -152,16 +153,15 @@ let extract_checksums_and_urls (lockdir : Dune_pkg.Lock_dir.t) = | None -> sources | Some source -> source :: sources in - List.fold_left - sources - ~init:acc - ~f:(fun (checksums, urls) (source : Dune_pkg.Source.t) -> - match source with - | Fetch { url; checksum = Some ((_, checksum) as checksum_with_loc) } -> - Checksum.Map.set checksums checksum (url, checksum_with_loc), urls - | Fetch { url; checksum = None } -> - checksums, Digest.Map.set urls (digest_of_url (snd url)) url - | _ -> checksums, urls)) + List.fold_left sources ~init:acc ~f:(fun (checksums, urls) (source : Source.t) -> + match Source.kind source with + | `Directory_or_archive _ -> checksums, urls + | `Fetch -> + let url = source.url in + (match source.checksum with + | Some ((_, checksum) as checksum_with_loc) -> + Checksum.Map.set checksums checksum (url, checksum_with_loc), urls + | None -> checksums, Digest.Map.set urls (digest_of_url (snd url)) url))) ;; let find_checksum, find_url = @@ -316,14 +316,18 @@ module Copy = struct ;; end -let fetch ~target kind url checksum = +let fetch ~target kind (source : Source.t) = + let source_kind = Source.kind source in let src = - let url_or_checksum = - match checksum with - | Some (_, checksum) -> `Checksum checksum - | None -> `Url (snd url) - in - Path.build (make_target ~kind url_or_checksum) + match source_kind with + | `Directory_or_archive p -> Path.external_ p + | `Fetch -> + let url_or_checksum = + match source.checksum with + | Some (_, checksum) -> `Checksum checksum + | None -> `Url (snd source.url) + in + Path.build (make_target ~kind url_or_checksum) in let open Action_builder.With_targets.O in (* [Action_builder.copy] already adds this dependency for us, @@ -335,8 +339,15 @@ let fetch ~target kind url checksum = match kind with | `File -> Action_builder.copy ~src ~dst:target | `Directory -> - Copy.action ~src_dir:src ~dst_dir:target - |> Action.Full.make + let action = + match source_kind with + | `Fetch -> Copy.action ~src_dir:src ~dst_dir:target + | `Directory_or_archive _ -> + (* For local sources, we don't need an intermediate step copying to the + .fetch context. This would just add pointless additional overhead. *) + action ~url:source.url ~checksum:source.checksum ~target ~kind + in + Action.Full.make action |> Action_builder.With_targets.return |> Action_builder.With_targets.add_directories ~directory_targets:[ target ] ;; diff --git a/src/dune_rules/fetch_rules.mli b/src/dune_rules/fetch_rules.mli index 0c782df6ac7..8616193b622 100644 --- a/src/dune_rules/fetch_rules.mli +++ b/src/dune_rules/fetch_rules.mli @@ -8,8 +8,7 @@ val context : Build_context.t val fetch : target:Path.Build.t -> [ `File | `Directory ] - -> Loc.t * OpamUrl.t - -> (Loc.t * Dune_pkg.Checksum.t) option + -> Dune_pkg.Source.t -> Action.Full.t With_targets.t val gen_rules diff --git a/src/dune_rules/lock_dir.ml b/src/dune_rules/lock_dir.ml index 9493d352591..0863390f087 100644 --- a/src/dune_rules/lock_dir.ml +++ b/src/dune_rules/lock_dir.ml @@ -149,3 +149,32 @@ let lock_dir_active ctx = | None -> Memo.return false | Some path -> Fs_memo.dir_exists (In_source_dir path) ;; + +let source_kind (source : Dune_pkg.Source.t) = + let loc, url = source.url in + if OpamUrl.is_local url && url.backend = `rsync + then ( + let path = Path.External.of_string url.path in + Fs_memo.path_kind (External path) + >>| function + | Error (ENOENT, _, _) -> + User_error.raise + ~loc + [ Pp.textf "%s does not exist" (Path.External.to_string_maybe_quoted path) ] + | Error exn -> + User_error.raise + ~loc + [ Pp.textf "unable to read %s" (Path.External.to_string_maybe_quoted path) + ; Unix_error.Detailed.pp exn + ] + | Ok S_REG -> `Local (`File, path) + | Ok S_DIR -> `Local (`Directory, path) + | Ok _kind -> + User_error.raise + ~loc + [ Pp.textf + "path %s is not a directory or a file" + (Path.External.to_string_maybe_quoted path) + ]) + else Memo.return `Fetch +;; diff --git a/src/dune_rules/lock_dir.mli b/src/dune_rules/lock_dir.mli index db28a0cd128..cf0e60caf93 100644 --- a/src/dune_rules/lock_dir.mli +++ b/src/dune_rules/lock_dir.mli @@ -19,3 +19,7 @@ module Sys_vars : sig val poll : t end + +val source_kind + : Dune_pkg.Source.t + -> [ `Local of [ `Directory | `File ] * Path.External.t | `Fetch ] Memo.t diff --git a/src/dune_rules/pkg_rules.ml b/src/dune_rules/pkg_rules.ml index 7751c753ba0..cf5c71eb357 100644 --- a/src/dune_rules/pkg_rules.ml +++ b/src/dune_rules/pkg_rules.ml @@ -314,10 +314,16 @@ module Pkg = struct in Path.Local.Set.union_all (acc :: dirs) in - match t.info.source with + (match t.info.source with + | None -> Memo.return None + | Some source -> + Lock_dir.source_kind source + >>| (function + | `Local (`File, _) | `Fetch -> None + | `Local (`Directory, root) -> Some root)) + >>= function | None -> Memo.return Path.Local.Set.empty - | Some (External_copy (_, root)) -> loop root Path.Local.Set.empty Path.Local.root - | Some (Fetch _) -> assert false + | Some root -> loop root Path.Local.Set.empty Path.Local.root ;; let dep t = Dep.file (Path.build t.paths.target_dir) @@ -1482,32 +1488,37 @@ let source_rules (pkg : Pkg.t) = let+ source_deps, copy_rules = match pkg.info.source with | None -> Memo.return (Dep.Set.empty, []) - | Some (Fetch { url = (loc, _) as url; checksum }) -> - let fetch = - Fetch_rules.fetch ~target:pkg.paths.source_dir `Directory url checksum - in - Memo.return (Dep.Set.of_files [ Path.build pkg.paths.source_dir ], [ loc, fetch ]) - | Some (External_copy (loc, source_root)) -> - let+ source_files, rules = - let source_root = Path.external_ source_root in - Pkg.source_files pkg ~loc - >>| Path.Local.Set.fold ~init:([], []) ~f:(fun file (source_files, rules) -> - let src = Path.append_local source_root file in - let dst = Path.Build.append_local pkg.paths.source_dir file in - let copy = loc, Action_builder.copy ~src ~dst in - Path.build dst :: source_files, copy :: rules) - in - Dep.Set.of_files source_files, rules + | Some source -> + let loc = fst source.url in + Lock_dir.source_kind source + >>= (function + | `Local (`File, _) | `Fetch -> + let fetch = Fetch_rules.fetch ~target:pkg.paths.source_dir `Directory source in + Memo.return (Dep.Set.of_files [ Path.build pkg.paths.source_dir ], [ loc, fetch ]) + | `Local (`Directory, source_root) -> + let+ source_files, rules = + let source_root = Path.external_ source_root in + Pkg.source_files pkg ~loc + >>| Path.Local.Set.fold ~init:([], []) ~f:(fun file (source_files, rules) -> + let src = Path.append_local source_root file in + let dst = Path.Build.append_local pkg.paths.source_dir file in + let copy = loc, Action_builder.copy ~src ~dst in + Path.build dst :: source_files, copy :: rules) + in + Dep.Set.of_files source_files, rules) in let extra_source_deps, extra_copy_rules = - List.map pkg.info.extra_sources ~f:(fun (local, fetch) -> + List.map pkg.info.extra_sources ~f:(fun (local, (fetch : Source.t)) -> let extra_source = Paths.extra_source pkg.paths local in let rule = - match (fetch : Source.t) with - | External_copy (loc, src) -> + let loc = fst fetch.url in + (* We assume that [fetch] is always a file. Would be good + to give a decent error message if it's not *) + match Source.kind fetch with + | `Directory_or_archive src -> loc, Action_builder.copy ~src:(Path.external_ src) ~dst:extra_source - | Fetch { url = (loc, _) as url; checksum } -> - let rule = Fetch_rules.fetch ~target:pkg.paths.source_dir `File url checksum in + | `Fetch -> + let rule = Fetch_rules.fetch ~target:pkg.paths.source_dir `File fetch in loc, rule in Path.build extra_source, rule) @@ -1608,8 +1619,8 @@ module Gen_rules = Build_config.Gen_rules let setup_package_rules context ~dir ~pkg_name : Gen_rules.result Memo.t = let name = User_error.ok_exn (Package.Name.of_string_user_error (Loc.none, pkg_name)) in - let* db = DB.get context in - let+ pkg = + let* pkg = + let* db = DB.get context in Resolve.resolve db context (Loc.none, name) >>| function | `Inside_lock_dir pkg -> pkg @@ -1622,12 +1633,19 @@ let setup_package_rules context ~dir ~pkg_name : Gen_rules.result Memo.t = ] in let paths = Paths.make name context in - let directory_targets = - let target_dir = paths.target_dir in - let map = Path.Build.Map.singleton target_dir Loc.none in + let+ directory_targets = + let map = + let target_dir = paths.target_dir in + Path.Build.Map.singleton target_dir Loc.none + in match pkg.info.source with - | Some (Fetch f) -> Path.Build.Map.add_exn map paths.source_dir (fst f.url) - | _ -> map + | None -> Memo.return map + | Some source -> + Lock_dir.source_kind source + >>| (function + | `Local (`Directory, _) -> map + | `Local (`File, _) | `Fetch -> + Path.Build.Map.add_exn map paths.source_dir (fst source.url)) in let build_dir_only_sub_dirs = Gen_rules.Build_only_sub_dirs.singleton ~dir Subdir_set.empty diff --git a/test/blackbox-tests/test-cases/pkg/pin-stanza/update-non-dune-local-pin.t b/test/blackbox-tests/test-cases/pkg/pin-stanza/update-non-dune-local-pin.t index d72f04286ae..6fbbecae7bf 100644 --- a/test/blackbox-tests/test-cases/pkg/pin-stanza/update-non-dune-local-pin.t +++ b/test/blackbox-tests/test-cases/pkg/pin-stanza/update-non-dune-local-pin.t @@ -1,6 +1,6 @@ -This demonstrates an issue when pinning a non-opam package. After attempting to -build the package, changes to the package are only picked up by dune after -running `dune clean`, even if building the package failed. +This demonstrates pinning a non-opam package and then modifying its sources. +Whenever the sources are modified, dune should rebuild the package in the +workspace where it's locked. $ . ../helpers.sh @@ -35,7 +35,7 @@ Make a package "foo" whose build will fail after printing a message: Solution for dune.lock: - foo.dev -Attempt to build the packgage the first time: +Attempt to build the package the first time: (the error from make is grep'd out because it is not consistant across different systems) $ dune build 2>&1 | grep -v make echo aaa @@ -50,16 +50,7 @@ Update the message that gets printed while building foo: > false > EOF -The change to the package is ignored: - $ dune build 2>&1 | grep -v make - echo aaa - aaa - false - -> required by _build/_private/default/.pkg/foo/target/cookie - - $ dune clean - -The change to the package is picked up now that we've run `dune clean`: +The change to the package is picked up: $ dune build 2>&1 | grep -v make echo bbb bbb diff --git a/test/blackbox-tests/test-cases/pkg/unavailable-package-source.t b/test/blackbox-tests/test-cases/pkg/unavailable-package-source.t index 4fbe2d09cc9..7ce0ca8bb8e 100644 --- a/test/blackbox-tests/test-cases/pkg/unavailable-package-source.t +++ b/test/blackbox-tests/test-cases/pkg/unavailable-package-source.t @@ -16,9 +16,9 @@ Demonstrate what happens when we try to fetch from a source that doesn't exist: Local file system $ runtest "(copy \"$PWD/dummy\")" 2>&1 | sed "s#$(pwd)#PWD#" | sed '/ *^\^*$/d' | sed '\#^File "dune.lock/foo.pkg", line 2, characters#d' 2 | (source (copy "PWD/dummy")) - Error: Unable to read + Error: PWD/dummy - opendir(PWD/dummy): No such file or directory + does not exist Git $ runtest "(fetch (url \"git+file://$PWD/dummy\"))" 2>&1 | sed "s#$(pwd)#PWD#" diff --git a/test/expect-tests/dune_pkg/dune_pkg_unit_tests.ml b/test/expect-tests/dune_pkg/dune_pkg_unit_tests.ml index 1a76f962a6e..40a5b1c1733 100644 --- a/test/expect-tests/dune_pkg/dune_pkg_unit_tests.ml +++ b/test/expect-tests/dune_pkg/dune_pkg_unit_tests.ml @@ -208,7 +208,7 @@ let%expect_test "encode/decode round trip test for lockdir with complex deps" = let pkg_a = let name = Package_name.of_string "a" in let extra_source : Source.t = - External_copy (Loc.none, Path.External.of_string "/tmp/a") + Source.external_copy (Loc.none, Path.External.of_string "/tmp/a") in ( name , let pkg = empty_package name ~version:(Package_version.of_string "0.1.0") in @@ -230,10 +230,9 @@ let%expect_test "encode/decode round trip test for lockdir with complex deps" = ; extra_sources = [ Path.Local.of_string "one", extra_source ; ( Path.Local.of_string "two" - , Fetch - { url = Loc.none, OpamUrl.of_string "file://randomurl" - ; checksum = None - } ) + , { url = Loc.none, OpamUrl.of_string "file://randomurl" + ; checksum = None + } ) ] } ; exported_env = @@ -256,15 +255,14 @@ let%expect_test "encode/decode round trip test for lockdir with complex deps" = dev = true ; source = Some - (Fetch - { url = Loc.none, OpamUrl.of_string "https://github.com/foo/b" - ; checksum = - Some - ( Loc.none - , Checksum.of_string - "sha256=adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3" - ) - }) + { url = Loc.none, OpamUrl.of_string "https://github.com/foo/b" + ; checksum = + Some + ( Loc.none + , Checksum.of_string + "sha256=adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3" + ) + } } } ) in @@ -279,10 +277,9 @@ let%expect_test "encode/decode round trip test for lockdir with complex deps" = dev = false ; source = Some - (Fetch - { url = Loc.none, OpamUrl.of_string "https://github.com/foo/c" - ; checksum = None - }) + { url = Loc.none, OpamUrl.of_string "https://github.com/foo/c" + ; checksum = None + } } } ) in @@ -313,10 +310,10 @@ let%expect_test "encode/decode round trip test for lockdir with complex deps" = { name = "a" ; version = "0.1.0" ; dev = false - ; source = Some External_copy External "/tmp/a" + ; source = Some { url = "file:///tmp/a"; checksum = None } ; extra_sources = - [ ("one", External_copy External "/tmp/a") - ; ("two", Fetch "file://randomurl", None) + [ ("one", { url = "file:///tmp/a"; checksum = None }) + ; ("two", { url = "file://randomurl"; checksum = None }) ] } ; exported_env = [ { op = "="; var = "foo"; value = "bar" } ] @@ -331,10 +328,11 @@ let%expect_test "encode/decode round trip test for lockdir with complex deps" = ; dev = true ; source = Some - Fetch - "https://github.com/foo/b", - Some - "sha256=adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3" + { url = "https://github.com/foo/b" + ; checksum = + Some + "sha256=adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3" + } ; extra_sources = [] } ; exported_env = [] @@ -350,7 +348,8 @@ let%expect_test "encode/decode round trip test for lockdir with complex deps" = { name = "c" ; version = "0.2" ; dev = false - ; source = Some Fetch "https://github.com/foo/c", None + ; source = + Some { url = "https://github.com/foo/c"; checksum = None } ; extra_sources = [] } ; exported_env = []