From 621aae3ffe4733a16d9d50f94397f20bd92312a7 Mon Sep 17 00:00:00 2001 From: Marek Kubica Date: Tue, 12 Dec 2023 10:43:41 +0100 Subject: [PATCH] feature(pkg): Support for specifying particular branches/commits (#9241) Signed-off-by: Marek Kubica --- bin/pkg/pkg_common.ml | 8 +- src/dune_pkg/lock_dir.ml | 17 + src/dune_pkg/lock_dir.mli | 4 + src/dune_pkg/opam_repo.ml | 117 ++++- src/dune_pkg/opam_repo.mli | 36 +- src/dune_pkg/rev_store.ml | 79 +++- src/dune_pkg/rev_store.mli | 10 +- .../test-cases/pkg/opam-repository-download.t | 50 ++- .../dune_pkg/dune_pkg_unit_tests.ml | 403 +++++++++++++----- test/expect-tests/dune_pkg/rev_store_tests.ml | 28 +- 10 files changed, 602 insertions(+), 150 deletions(-) diff --git a/bin/pkg/pkg_common.ml b/bin/pkg/pkg_common.ml index 2fb805af75a..f4456030edc 100644 --- a/bin/pkg/pkg_common.ml +++ b/bin/pkg/pkg_common.ml @@ -79,7 +79,7 @@ let location_of_opam_url url = match (url : OpamUrl.t).backend with | `rsync -> `Path (Path.of_string url.path) (* contrary to OPAM we also attempt to load HTTP sources via git *) - | `git | `http -> `Git (OpamUrl.base_url url) + | `git | `http -> `Git | `darcs | `hg -> User_error.raise ~hints:[ Pp.text "Specify either a file path or git repo via SSH/HTTPS" ] @@ -88,6 +88,7 @@ let location_of_opam_url url = ;; let get_repos repos ~repositories ~update_opam_repositories = + let open Fiber.O in let module Repository_id = Dune_pkg.Repository_id in let module Opam_repo = Dune_pkg.Opam_repo in let module Repository = Dune_pkg.Pkg_workspace.Repository in @@ -103,8 +104,9 @@ let get_repos repos ~repositories ~update_opam_repositories = | Some repo -> let opam_url = Dune_pkg.Pkg_workspace.Repository.opam_url repo in (match location_of_opam_url opam_url with - | `Git source -> - Opam_repo.of_git_repo ~repo_id:None ~update:update_opam_repositories ~source + | `Git -> + let* source = Opam_repo.Source.of_opam_url opam_url in + Opam_repo.of_git_repo ~repo_id:None ~update:update_opam_repositories source | `Path path -> let repo_id = Repository_id.of_path path in Fiber.return @@ Opam_repo.of_opam_repo_dir_path ~source:None ~repo_id path)) diff --git a/src/dune_pkg/lock_dir.ml b/src/dune_pkg/lock_dir.ml index 0335bb51535..1b5c729b874 100644 --- a/src/dune_pkg/lock_dir.ml +++ b/src/dune_pkg/lock_dir.ml @@ -876,3 +876,20 @@ let compute_missing_checksums t = in { t with packages } ;; + +module Private = struct + let used_with_commit ~commit xs = + List.map xs ~f:(fun serializable -> + Opam_repo.Serializable.Private.with_commit ~commit serializable) + ;; + + let repos_with_commit ~commit ({ Repositories.used; _ } as repos) = + let used = Option.map used ~f:(used_with_commit ~commit) in + { repos with used } + ;; + + let with_commit ~commit ({ repos; _ } as lock_dir) = + let repos = repos_with_commit ~commit repos in + { lock_dir with repos } + ;; +end diff --git a/src/dune_pkg/lock_dir.mli b/src/dune_pkg/lock_dir.mli index 7fd2487472b..a9e65ca26e7 100644 --- a/src/dune_pkg/lock_dir.mli +++ b/src/dune_pkg/lock_dir.mli @@ -95,6 +95,10 @@ end val read_disk : Path.Source.t -> t +module Private : sig + val with_commit : commit:string -> t -> t +end + module Make_load (Io : sig include Monad.S diff --git a/src/dune_pkg/opam_repo.ml b/src/dune_pkg/opam_repo.ml index e30dfb009e1..b4d3e413ed4 100644 --- a/src/dune_pkg/opam_repo.ml +++ b/src/dune_pkg/opam_repo.ml @@ -34,6 +34,80 @@ module Paths = struct let opam_file package = Path.Local.relative (package_dir package) "opam" end +module Source = struct + type commitish = + | Commit of string + | Branch of string + | Tag of string + + let commitish_to_dyn = function + | Commit c -> Dyn.variant "Commit" [ Dyn.string c ] + | Branch b -> Dyn.variant "Branch" [ Dyn.string b ] + | Tag t -> Dyn.variant "Tag" [ Dyn.string t ] + ;; + + let commitish_equal a b = + match a, b with + | Commit x, Commit x' | Branch x, Branch x' | Tag x, Tag x' -> String.equal x x' + | _, _ -> false + ;; + + type t = + { url : string + ; commit : commitish option + } + + module Private = struct + let of_opam_url rev_store ({ OpamUrl.hash; _ } as opam_url) = + (* fairly ugly to pull the rev-store out of thin air *) + let url = OpamUrl.base_url opam_url in + let+ commit = + match hash with + | None -> Fiber.return None + | Some ref -> + (* OpamUrl doesn't distinguish between branches/tags and commits, so we need to look up *) + let* member = Rev_store.mem rev_store ~rev:ref in + (match member with + | true -> Fiber.return @@ Some (Commit ref) + | false -> + let+ type' = Rev_store.ref_type rev_store ~source:url ~ref in + (match type' with + | Some `Tag -> Some (Tag ref) + | Some `Head -> Some (Branch ref) + | None -> + User_error.raise + ~hints: + [ Pp.text + "Make sure the URL is correct and the repository contains the \ + branch/tag" + ] + [ Pp.textf + "Opam repository at '%s' does not have a reference '%s'" + url + ref + ])) + in + { commit; url } + ;; + end + + let of_opam_url opam_url = + (* fairly ugly to pull the rev-store out of thin air *) + let* rev_store = rev_store in + Private.of_opam_url rev_store opam_url + ;; + + let to_string { url; commit = _ } = url + + let to_dyn { url; commit } = + Dyn.record [ "url", Dyn.string url; "commit", Dyn.option commitish_to_dyn commit ] + ;; + + let equal { url; commit } t = + String.equal url t.url && Option.equal commitish_equal commit t.commit + ;; +end + module Serializable = struct type t = { repo_id : Repository_id.t option @@ -64,6 +138,21 @@ module Serializable = struct and+ repo_id = field_o "repo_id" Repository_id.decode in { repo_id; source }) ;; + + module Private = struct + let with_commit ~commit { repo_id; source } = + let repo_id = + match repo_id with + | None -> None + | Some repo_id as orig -> + let candidate_repo_id = Repository_id.of_git_hash commit in + (match Repository_id.equal repo_id candidate_repo_id with + | true -> Some (Repository_id.of_git_hash "MATCHING") + | false -> orig) + in + { repo_id; source } + ;; + end end module Backend = struct @@ -97,12 +186,6 @@ let repo_id t = serializable.repo_id ;; -let source t = - let open Option.O in - let+ serializable = serializable t in - serializable.source -;; - let of_opam_repo_dir_path ~source ~repo_id opam_repo_dir_path = (match Path.stat opam_repo_dir_path with | Error (Unix.ENOENT, _, _) -> @@ -138,11 +221,16 @@ let of_opam_repo_dir_path ~source ~repo_id opam_repo_dir_path = { source = Directory opam_repo_dir_path; serializable } ;; -let of_git_repo ~repo_id ~update ~source = +let of_git_repo ~repo_id ~update (source : Source.t) = let+ at_rev, computed_repo_id = let* remote = let* repo = rev_store in - let* remote = Rev_store.add_repo repo ~source in + let branch = + match source.commit with + | Some (Branch b) -> Some b + | _ -> None + in + let* remote = Rev_store.add_repo repo ~source:source.url ~branch in match update with | true -> Rev_store.Remote.update remote | false -> Fiber.return @@ Rev_store.Remote.don't_update remote @@ -153,8 +241,11 @@ let of_git_repo ~repo_id ~update ~source = at_rev, Some repo_id | None -> let+ at_rev = - let name = Rev_store.Remote.default_branch remote in - Rev_store.Remote.rev_of_name remote ~name + match source.commit with + | Some (Commit ref) -> Rev_store.Remote.rev_of_ref remote ~ref + | _ -> + let name = Rev_store.Remote.default_branch remote in + Rev_store.Remote.rev_of_name remote ~name in let repo_id = Option.map at_rev ~f:Rev_store.At_rev.repository_id in at_rev, repo_id @@ -163,9 +254,11 @@ let of_git_repo ~repo_id ~update ~source = | None -> User_error.raise ~hints:[ Pp.text "Double check that the revision is included in the repository" ] - [ Pp.textf "Could not find revision in repository %s" source ] + [ Pp.textf "Could not find revision in repository %s" (Source.to_string source) ] | Some at_rev -> - let serializable = Some { Serializable.repo_id = computed_repo_id; source } in + let serializable = + Some { Serializable.repo_id = computed_repo_id; source = source.url } + in { source = Repo at_rev; serializable } ;; diff --git a/src/dune_pkg/opam_repo.mli b/src/dune_pkg/opam_repo.mli index d56955e07f4..c8661286477 100644 --- a/src/dune_pkg/opam_repo.mli +++ b/src/dune_pkg/opam_repo.mli @@ -9,11 +9,36 @@ module Serializable : sig val decode : t Decoder.t val equal : t -> t -> bool val to_dyn : t -> Dyn.t + + module Private : sig + val with_commit : commit:string -> t -> t + end end val equal : t -> t -> bool -(** [of_opam_repo_dir_path opam_repo_dir] creates a repo representedy by a local +module Source : sig + type commitish = + | Commit of string + | Branch of string + | Tag of string + + type t = + { url : string + ; commit : commitish option + } + + val of_opam_url : OpamUrl.t -> t Fiber.t + val to_string : t -> string + val to_dyn : t -> Dyn.t + val equal : t -> t -> bool + + module Private : sig + val of_opam_url : Rev_store.t -> OpamUrl.t -> t Fiber.t + end +end + +(** [of_opam_repo_dir_path opam_repo_dir] creates a repo represented by a local directory in the path given by [opam_repo_dir]. *) val of_opam_repo_dir_path : source:string option @@ -21,19 +46,14 @@ val of_opam_repo_dir_path -> Path.t -> t -(** [of_git_repo git ~repo_id ~update ~source] loads the opam repository located at [source] from git. +(** [of_git_repo git ~repo_id ~update source] loads the opam repository located at [source] from git. [source] can be any URL that [git remote add] supports. Set [update] to true to update the source to the newest revision, otherwise it will use the latest data available in the cache (if any). *) -val of_git_repo - : repo_id:Repository_id.t option - -> update:bool - -> source:string - -> t Fiber.t +val of_git_repo : repo_id:Repository_id.t option -> update:bool -> Source.t -> t Fiber.t val repo_id : t -> Repository_id.t option -val source : t -> string option val serializable : t -> Serializable.t option module With_file : sig diff --git a/src/dune_pkg/rev_store.ml b/src/dune_pkg/rev_store.ml index 72bce9558fa..f31a08e4e7a 100644 --- a/src/dune_pkg/rev_store.ml +++ b/src/dune_pkg/rev_store.ml @@ -115,6 +115,47 @@ let run_capture_zero_separated_lines { dir } = Process.run_capture_zero_separated ~dir ~display ~env failure_mode git ;; +let mem { dir } ~rev = + let git = Lazy.force Vcs.git in + let failure_mode = Vcs.git_accept () in + let stderr_to = make_stderr () in + let stdout_to = make_stdout () in + let command = [ "rev-parse"; rev ] in + let+ res = + Process.run ~dir ~display ~stdout_to ~stderr_to ~env failure_mode git command + in + match res with + | Ok () -> true + | Error _ -> false +;; + +let ref_type = + let hash = Re.(rep1 alnum) in + let re = + Re.( + compile + @@ seq + [ bol + ; hash + ; rep1 space + ; str "refs/" + ; group (alt [ str "heads"; str "tags" ]) + ; str "/" + ]) + in + fun t ~source ~ref -> + let command = [ "ls-remote"; source; ref ] in + let+ hits = run_capture_lines t command in + List.find_map hits ~f:(fun line -> + match Re.exec_opt re line with + | None -> None + | Some m -> + (match Re.Group.get m 1 with + | "heads" -> Some `Head + | "tags" -> Some `Tag + | _ -> None)) +;; + let show = let show { dir } revs_and_paths = let git = Lazy.force Vcs.git in @@ -307,7 +348,13 @@ module Remote = struct let* rev = run_capture_line repo [ "rev-parse"; sprintf "%s/%s" handle name ] in let revision = Rev rev in let+ files_at_rev = files_at_rev repo revision in - Some { At_rev.repo; revision = Rev rev; files_at_rev } + Some { At_rev.repo; revision; files_at_rev } + ;; + + let rev_of_ref { repo; handle = _; default_branch = _ } ~ref = + let revision = Rev ref in + let+ files_at_rev = files_at_rev repo revision in + Some { At_rev.repo; revision; files_at_rev } ;; let rev_of_repository_id { repo; handle = _; default_branch = _ } repo_id = @@ -374,15 +421,24 @@ let read_head_branch = inspect lines ;; -let add_repo ({ dir } as t) ~source = - (* TODO add this directly using .git/config *) - let handle = source |> Dune_digest.string |> Dune_digest.to_string in +let remote_add t ~branch ~handle ~source = + run t [ "remote"; "add"; "--track"; branch; handle; source ] +;; + +let add_repo ({ dir } as t) ~source ~branch = + let decoded_remote = + match branch with + | None -> source + | Some branch -> sprintf "%s %s" source branch + in + let handle = decoded_remote |> Dune_digest.string |> Dune_digest.to_string in let lock = lock_path t in with_flock lock ~f:(fun () -> let* exists = remote_exists dir ~name:handle in let+ default_branch = - match exists with - | true -> + match exists, branch with + | true, Some branch -> Fiber.return branch + | true, None -> let+ head_branch = read_head_branch t handle in (match head_branch with | Some head_branch -> head_branch @@ -391,9 +447,12 @@ let add_repo ({ dir } as t) ~source = Code_error.raise (sprintf "Could not load default branch of repository '%s'" source) [ "source", Dyn.string source; "handle", Dyn.string handle ]) - | false -> + | false, Some branch -> + let+ () = remote_add t ~branch ~handle ~source in + branch + | false, None -> let* head_branch = query_head_branch t source in - let head_branch = + let branch = match head_branch with | Some head_branch -> head_branch | None -> @@ -406,8 +465,8 @@ let add_repo ({ dir } as t) ~source = [ Pp.textf "Could not determine default branch of repository at '%s'" source ] in - let+ () = run t [ "remote"; "add"; "--track"; head_branch; handle; source ] in - head_branch + let+ () = remote_add t ~branch ~handle ~source in + branch in { Remote.repo = t; handle; default_branch }) ;; diff --git a/src/dune_pkg/rev_store.mli b/src/dune_pkg/rev_store.mli index 6172531ea99..a27a2e3b4c7 100644 --- a/src/dune_pkg/rev_store.mli +++ b/src/dune_pkg/rev_store.mli @@ -38,17 +38,23 @@ module Remote : sig val default_branch : t -> string val rev_of_name : t -> name:string -> At_rev.t option Fiber.t + val rev_of_ref : t -> ref:string -> At_rev.t option Fiber.t val rev_of_repository_id : t -> Repository_id.t -> At_rev.t option Fiber.t end val content_of_files : t -> File.t list -> string list Fiber.t val load_or_create : dir:Path.t -> t Fiber.t -(** [add_repo t ~source] idempotently registers a git repo to the rev store. +(** [add_repo t ~source ~branch] idempotently registers a git repo to the rev store. [source] is any URL that is supported by [git remote add]. This only adds the remote metadata, to get a remote you need to either use [Remote.update] if you want to fetch from the remote (thus potentially triggering network IO) or if you are sure the [t] already contains all required revisions (e.g. from a previous run) then use [don't_update]. *) -val add_repo : t -> source:string -> Remote.uninit Fiber.t +val add_repo : t -> source:string -> branch:string option -> Remote.uninit Fiber.t + +(** [mem t ~rev] returns whether the revision [rev] is part of the repository *) +val mem : t -> rev:string -> bool Fiber.t + +val ref_type : t -> source:string -> ref:string -> [ `Head | `Tag ] option Fiber.t diff --git a/test/blackbox-tests/test-cases/pkg/opam-repository-download.t b/test/blackbox-tests/test-cases/pkg/opam-repository-download.t index 70fa8e7d79a..71712c5a1d6 100644 --- a/test/blackbox-tests/test-cases/pkg/opam-repository-download.t +++ b/test/blackbox-tests/test-cases/pkg/opam-repository-download.t @@ -73,8 +73,35 @@ other systems and thus shouldn't be included. $ grep "git_hash $REPO_HASH" dune.lock/lock.dune > /dev/null || echo "not found" not found +We also test that it is possible to specify a specific commit when locking a +repo, in this case the one from an older revision. So we create a new package +in the repo and make sure it locks the older version. -The repository can also be injected via the dune-workspace file + $ mkpkg foo 0.1.0 < EOF + $ cd mock-opam-repository + $ git add -A + $ git commit -m "new release of foo" --quiet + $ NEW_REPO_HASH=$(git rev-parse HEAD) + $ cd .. + + $ rm -r dune.lock + $ cat > dune-workspace < (lang dune 3.10) + > (lock_dir + > (repositories mock)) + > (repository + > (name mock) + > (source "git+file://$(pwd)/mock-opam-repository#${REPO_HASH}")) + > EOF + $ XDG_CACHE_HOME=$(pwd)/fake-xdg-cache dune pkg lock + Solution for dune.lock: + - bar.0.0.1 + - foo.0.0.1 + $ grep "git_hash $REPO_HASH" dune.lock/lock.dune > /dev/null + +If we specify no branch however, it should be using the latest commit in the +repository and thus the new foo package. $ cat > dune-workspace < (lang dune 3.10) @@ -83,17 +110,13 @@ The repository can also be injected via the dune-workspace file > (source "git+file://$(pwd)/mock-opam-repository")) > (lock_dir > (repositories foo)) - > (context - > (default - > (name default))) > EOF $ mkdir dune-workspace-cache $ XDG_CACHE_HOME=$(pwd)/dune-workspace-cache dune pkg lock Solution for dune.lock: - bar.0.0.1 - - foo.0.0.1 - - $ grep "git_hash $REPO_HASH" dune.lock/lock.dune > /dev/null + - foo.0.1.0 + $ grep "git_hash $NEW_REPO_HASH" dune.lock/lock.dune > /dev/null A new package is released in the repo: @@ -108,6 +131,15 @@ A new package is released in the repo: Since we have a working cached copy we get the old version of `bar` if we opt out of the auto update. + $ cat > dune-workspace < (lang dune 3.10) + > (repository + > (name mock) + > (source "git+file://$(pwd)/mock-opam-repository")) + > (lock_dir + > (repositories mock)) + > EOF + To be safe it doesn't access the repo, we make sure to move the mock-repo away $ mv mock-opam-repository elsewhere @@ -118,7 +150,7 @@ So now the test should work as it can't access the repo: $ XDG_CACHE_HOME=$(pwd)/dune-workspace-cache dune pkg lock --skip-update Solution for dune.lock: - bar.0.0.1 - - foo.0.0.1 + - foo.0.1.0 But it will also get the new version of bar if we attempt to lock again (having restored the repo to where it was before) @@ -128,4 +160,4 @@ restored the repo to where it was before) $ XDG_CACHE_HOME=$(pwd)/dune-workspace-cache dune pkg lock Solution for dune.lock: - bar.1.0.0 - - foo.0.0.1 + - foo.0.1.0 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 5da6abc7694..fd6b19bd56f 100644 --- a/test/expect-tests/dune_pkg/dune_pkg_unit_tests.ml +++ b/test/expect-tests/dune_pkg/dune_pkg_unit_tests.ml @@ -1,15 +1,85 @@ open Stdune module Checksum = Dune_pkg.Checksum module Lock_dir = Dune_pkg.Lock_dir +module Opam_repo = Dune_pkg.Opam_repo module Expanded_variable_bindings = Dune_pkg.Solver_stats.Expanded_variable_bindings module Variable_name = Dune_pkg.Variable_name module Variable_value = Dune_pkg.Variable_value +module Rev_store = Dune_pkg.Rev_store module Package_version = Dune_pkg.Package_version module Package_name = Dune_lang.Package_name +module Scheduler = Dune_engine.Scheduler let () = Dune_tests_common.init () -let lock_dir_encode_decode_round_trip_test ~lock_dir_path ~lock_dir = +module Update = struct + open Dyn + + let update_commit ~commit = function + | Option (Some (Variant ("Commit", [ String s ]))) as d -> + (match String.equal commit s with + | true -> Option (Some (Variant ("Commit", [ string "MATCHES EXPECTED" ]))) + | false -> d) + | otherwise -> otherwise + ;; + + let update_source ~commit = function + | Record xs -> + let xs = + List.map xs ~f:(function + | ("commit" as u), dyn -> u, update_commit ~commit dyn + | otherwise -> otherwise) + in + Record xs + | otherwise -> otherwise + ;; + + let update_repo_id ~commit = function + | Option (Some (Variant ("Git_hash", [ String s ]))) as d -> + (match String.equal commit s with + | true -> Option (Some (Variant ("Git_hash", [ string "MATCHES EXPECTED" ]))) + | false -> d) + | otherwise -> otherwise + ;; + + let update_used ~commit = function + | Option (Some (List xs)) -> + let xs = + List.map xs ~f:(function + | Variant (("opam_repo_serializable" as u), [ repo_id; source ]) -> + let repo_id = update_repo_id ~commit repo_id in + let source = update_source ~commit source in + Variant (u, [ repo_id; source ]) + | otherwise -> otherwise) + in + Option (Some (List xs)) + | otherwise -> otherwise + ;; + + let update_repositories ~commit = function + | Record xs -> + let xs = + List.map xs ~f:(function + | ("used" as u), dyn -> u, update_used ~commit dyn + | otherwise -> otherwise) + in + Record xs + | otherwise -> otherwise + ;; + + let update_lock_dir_dyn ~commit = function + | Record xs -> + let xs = + List.map xs ~f:(function + | ("repos" as u), dyn -> u, update_repositories ~commit dyn + | otherwise -> otherwise) + in + Record xs + | otherwise -> otherwise + ;; +end + +let lock_dir_encode_decode_round_trip_test ?commit ~lock_dir_path ~lock_dir () = let lock_dir_path = Path.Source.of_string lock_dir_path in Lock_dir.Write_disk.( prepare ~lock_dir_path ~files:Package_name.Map.empty lock_dir |> commit); @@ -25,12 +95,38 @@ let lock_dir_encode_decode_round_trip_test ~lock_dir_path ~lock_dir = print_endline metadata_file_contents; Exn.raise exn in - if Lock_dir.equal - (Lock_dir.remove_locs lock_dir_round_tripped) - (Lock_dir.remove_locs lock_dir) + let lock_dir_round_tripped', lock_dir' = + match commit with + | None -> Lock_dir.remove_locs lock_dir_round_tripped, Lock_dir.remove_locs lock_dir + | Some commit -> + let lock_dir_round_tripped = Lock_dir.remove_locs lock_dir_round_tripped in + let lock_dir = Lock_dir.remove_locs lock_dir in + ( Lock_dir.Private.with_commit ~commit lock_dir_round_tripped + , Lock_dir.Private.with_commit ~commit lock_dir ) + in + if Lock_dir.equal lock_dir_round_tripped' lock_dir' then print_endline "lockdir matches after roundtrip:" else print_endline "lockdir doesn't match after roundtrip:"; - print_endline (Lock_dir.to_dyn lock_dir_round_tripped |> Dyn.to_string) + let dyn_lock_dir = Lock_dir.to_dyn lock_dir_round_tripped in + let dyn_lock_dir = + match commit with + | None -> dyn_lock_dir + | Some commit -> Update.update_lock_dir_dyn ~commit dyn_lock_dir + in + print_endline (dyn_lock_dir |> Dyn.to_string) +;; + +let run thunk = + let on_event _config _event = () in + let config : Scheduler.Config.t = + { concurrency = 1 + ; stats = None + ; insignificant_changes = `Ignore + ; signal_watcher = `No + ; watch_exclusions = [] + } + in + Scheduler.Run.go config ~on_event thunk ;; let%expect_test "encode/decode round trip test for lockdir with no deps" = @@ -42,7 +138,8 @@ let%expect_test "encode/decode round trip test for lockdir with no deps" = ~local_packages:[] ~ocaml:None ~repos:None - ~expanded_solver_variable_bindings:Expanded_variable_bindings.empty); + ~expanded_solver_variable_bindings:Expanded_variable_bindings.empty) + (); [%expect {| lockdir matches after roundtrip: @@ -86,7 +183,8 @@ let%expect_test "encode/decode round trip test for lockdir with simple deps" = (Package_name.Map.of_list_exn [ mk_pkg_basic ~name:"foo" ~version:(Package_version.of_string "0.1.0") ; mk_pkg_basic ~name:"bar" ~version:(Package_version.of_string "0.2.0") - ])); + ])) + (); [%expect {| lockdir matches after roundtrip: @@ -131,96 +229,102 @@ let%expect_test "encode/decode round trip test for lockdir with simple deps" = ;; let%expect_test "encode/decode round trip test for lockdir with complex deps" = + let open Fiber.O in let module Action = Dune_lang.Action in let module String_with_vars = Dune_lang.String_with_vars in - lock_dir_encode_decode_round_trip_test - ~lock_dir_path:"complex_lock_dir" - ~lock_dir: - (let pkg_a = - let name = Package_name.of_string "a" in - let extra_source : Lock_dir.Source.t = - 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 - { pkg with - build_command = - Some - Action.(Progn [ Echo [ String_with_vars.make_text Loc.none "hello" ] ]) - ; install_command = - Some - (Action.System - (* String_with_vars.t doesn't round trip so we have to set - [quoted] if the string would be quoted *) - (String_with_vars.make_text ~quoted:true Loc.none "echo 'world'")) - ; info = - { pkg.info with - dev = false - ; source = Some extra_source - ; extra_sources = - [ Path.Local.of_string "one", extra_source - ; ( Path.Local.of_string "two" - , Fetch { url = Loc.none, "randomurl"; checksum = None } ) - ] - } - ; exported_env = - [ { Action.Env_update.op = Eq - ; var = "foo" - ; value = String_with_vars.make_text Loc.none "bar" - } - ] - } ) - in - let pkg_b = - let name = Package_name.of_string "b" in - ( name - , let pkg = empty_package name ~version:(Package_version.of_string "dev") in - { pkg with - install_command = None - ; deps = [ Loc.none, fst pkg_a ] - ; info = - { pkg.info with - dev = true - ; source = - Some - (Fetch - { url = Loc.none, "https://github.com/foo/b" - ; checksum = - Some - ( Loc.none - , Checksum.of_string - "sha256=adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3" - ) - }) - } - } ) - in - let pkg_c = - let name = Package_name.of_string "c" in - ( name - , let pkg = empty_package name ~version:(Package_version.of_string "0.2") in - { pkg with - deps = [ Loc.none, fst pkg_a; Loc.none, fst pkg_b ] - ; info = - { pkg.info with - dev = false - ; source = - Some - (Fetch - { url = Loc.none, "https://github.com/foo/c"; checksum = None }) - } - } ) - in - let opam_repo = - let repo_id = Some (Dune_pkg.Repository_id.of_git_hash "95cf548dc") in - Dune_pkg.Opam_repo.Private.create ~source:(Some "well-known-repo") ~repo_id - in - Lock_dir.create_latest_version - ~local_packages:[] - ~ocaml:(Some (Loc.none, Package_name.of_string "ocaml")) - ~repos:(Some [ opam_repo ]) - ~expanded_solver_variable_bindings:Expanded_variable_bindings.empty - (Package_name.Map.of_list_exn [ pkg_a; pkg_b; pkg_c ])); + run (fun () -> + let+ lock_dir = + let pkg_a = + let name = Package_name.of_string "a" in + let extra_source : Lock_dir.Source.t = + 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 + { pkg with + build_command = + Some Action.(Progn [ Echo [ String_with_vars.make_text Loc.none "hello" ] ]) + ; install_command = + Some + (Action.System + (* String_with_vars.t doesn't round trip so we have to set + [quoted] if the string would be quoted *) + (String_with_vars.make_text ~quoted:true Loc.none "echo 'world'")) + ; info = + { pkg.info with + dev = false + ; source = Some extra_source + ; extra_sources = + [ Path.Local.of_string "one", extra_source + ; ( Path.Local.of_string "two" + , Fetch { url = Loc.none, "randomurl"; checksum = None } ) + ] + } + ; exported_env = + [ { Action.Env_update.op = Eq + ; var = "foo" + ; value = String_with_vars.make_text Loc.none "bar" + } + ] + } ) + in + let pkg_b = + let name = Package_name.of_string "b" in + ( name + , let pkg = empty_package name ~version:(Package_version.of_string "dev") in + { pkg with + install_command = None + ; deps = [ Loc.none, fst pkg_a ] + ; info = + { pkg.info with + dev = true + ; source = + Some + (Fetch + { url = Loc.none, "https://github.com/foo/b" + ; checksum = + Some + ( Loc.none + , Checksum.of_string + "sha256=adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3" + ) + }) + } + } ) + in + let pkg_c = + let name = Package_name.of_string "c" in + ( name + , let pkg = empty_package name ~version:(Package_version.of_string "0.2") in + { pkg with + deps = [ Loc.none, fst pkg_a; Loc.none, fst pkg_b ] + ; info = + { pkg.info with + dev = false + ; source = + Some + (Fetch { url = Loc.none, "https://github.com/foo/c"; checksum = None }) + } + } ) + in + let+ opam_repo = + let repo_id = Some (Dune_pkg.Repository_id.of_git_hash "95cf548dc") in + let+ source = + OpamUrl.parse "https://github.com/ocaml/dune" + |> Opam_repo.Source.of_opam_url + >>| (fun (src : Opam_repo.Source.t) -> src.url) + >>| Option.some + in + Opam_repo.Private.create ~source ~repo_id + in + Lock_dir.create_latest_version + ~local_packages:[] + ~ocaml:(Some (Loc.none, Package_name.of_string "ocaml")) + ~repos:(Some [ opam_repo ]) + ~expanded_solver_variable_bindings:Expanded_variable_bindings.empty + (Package_name.Map.of_list_exn [ pkg_a; pkg_b; pkg_c ]) + in + lock_dir_encode_decode_round_trip_test ~lock_dir_path:"complex_lock_dir" ~lock_dir ()); [%expect {| lockdir matches after roundtrip: @@ -286,7 +390,114 @@ let%expect_test "encode/decode round trip test for lockdir with complex deps" = Some [ opam_repo_serializable Some Git_hash "95cf548dc", - "well-known-repo" + "https://github.com/ocaml/dune" + ] + } + ; expanded_solver_variable_bindings = + { variable_values = []; unset_variables = [] } + } |}] +;; + +let%expect_test "encode/decode round trip test with locked repo revision" = + let open Fiber.O in + let module Action = Dune_lang.Action in + let module String_with_vars = Dune_lang.String_with_vars in + run (fun () -> + let cwd = Path.External.cwd () |> Path.external_ in + let dir = Path.relative cwd "git-repo" in + let* git_hash = Rev_store_tests.create_repo_at dir in + let* rev_store = Rev_store.load_or_create ~dir in + let+ lock_dir = + let pkg_a = + let name = Package_name.of_string "a" in + name, empty_package name ~version:(Package_version.of_string "0.1.0") + in + let pkg_b = + let name = Package_name.of_string "b" in + name, empty_package name ~version:(Package_version.of_string "dev") + in + let pkg_c = + let name = Package_name.of_string "c" in + name, empty_package name ~version:(Package_version.of_string "0.2") + in + let+ opam_repo = + let repo_id = Some (Dune_pkg.Repository_id.of_git_hash git_hash) in + let+ source = + sprintf "https://github.com/ocaml/dune#%s" git_hash + |> OpamUrl.parse + |> Opam_repo.Source.Private.of_opam_url rev_store + >>| (fun (src : Opam_repo.Source.t) -> src.url) + >>| Option.some + in + Opam_repo.Private.create ~source ~repo_id + in + Lock_dir.create_latest_version + ~local_packages:[] + ~ocaml:(Some (Loc.none, Package_name.of_string "ocaml")) + ~repos:(Some [ opam_repo ]) + ~expanded_solver_variable_bindings:Expanded_variable_bindings.empty + (Package_name.Map.of_list_exn [ pkg_a; pkg_b; pkg_c ]) + in + lock_dir_encode_decode_round_trip_test + ~commit:git_hash + ~lock_dir_path:"complex_lock_dir" + ~lock_dir + ()); + [%expect + {| + lockdir matches after roundtrip: + { version = (0, 1) + ; dependency_hash = None + ; packages = + map + { "a" : + { build_command = None + ; install_command = None + ; deps = [] + ; info = + { name = "a" + ; version = "0.1.0" + ; dev = false + ; source = None + ; extra_sources = [] + } + ; exported_env = [] + } + ; "b" : + { build_command = None + ; install_command = None + ; deps = [] + ; info = + { name = "b" + ; version = "dev" + ; dev = false + ; source = None + ; extra_sources = [] + } + ; exported_env = [] + } + ; "c" : + { build_command = None + ; install_command = None + ; deps = [] + ; info = + { name = "c" + ; version = "0.2" + ; dev = false + ; source = None + ; extra_sources = [] + } + ; exported_env = [] + } + } + ; ocaml = Some ("complex_lock_dir/lock.dune:3", "ocaml") + ; repos = + { complete = true + ; used = + Some + [ opam_repo_serializable + Some Git_hash "MATCHES EXPECTED", + "https://github.com/ocaml/dune" ] } ; expanded_solver_variable_bindings = diff --git a/test/expect-tests/dune_pkg/rev_store_tests.ml b/test/expect-tests/dune_pkg/rev_store_tests.ml index 4098841e01f..86c95372d71 100644 --- a/test/expect-tests/dune_pkg/rev_store_tests.ml +++ b/test/expect-tests/dune_pkg/rev_store_tests.ml @@ -4,6 +4,7 @@ module Scheduler = Dune_engine.Scheduler module Process = Dune_engine.Process module Display = Dune_engine.Display module Rev_store = Dune_pkg.Rev_store +module Opam_repo = Dune_pkg.Opam_repo module Vcs = Dune_vcs.Vcs let () = Dune_tests_common.init () @@ -27,11 +28,14 @@ let make_stdout () = Process.Io.make_stdout ~output_on_success:Swallow ~output_l let make_stderr () = Process.Io.make_stderr ~output_on_success:Swallow ~output_limit let create_repo_at dir = - let stdout_to = make_stdout () in - let stderr_to = make_stdout () in - let git = + let git, git_out = + let stdout_to = make_stdout () in + let stderr_to = make_stdout () in let git = Lazy.force Vcs.git in - Process.run ~dir ~display ~stdout_to ~stderr_to Process.Failure_mode.Strict git + let failure_mode = Process.Failure_mode.Strict in + ( (fun args -> Process.run ~dir ~display ~stdout_to ~stderr_to failure_mode git args) + , fun args -> Process.run_capture_line ~dir ~display ~stderr_to failure_mode git args + ) in Path.mkdir_p dir; let* () = git [ "init" ] in @@ -39,7 +43,8 @@ let create_repo_at dir = let entry = Path.relative dir entry_name in Io.write_lines entry [ "just some content" ]; let* () = git [ "add"; entry_name ] in - git [ "commit"; "-m 'Initial commit'" ] + let* () = git [ "commit"; "-m 'Initial commit'" ] in + git_out [ "rev-parse"; "HEAD" ] ;; let%expect_test "adding remotes" = @@ -48,20 +53,23 @@ let%expect_test "adding remotes" = run (fun () -> let* rev_store = Rev_store.load_or_create ~dir in let remote_path = Path.relative cwd "git-remote" in - let* () = create_repo_at remote_path in - let source = Path.to_string remote_path in - let* remote = Rev_store.add_repo rev_store ~source in + let* _head = create_repo_at remote_path in + let opam_url = remote_path |> Path.to_string |> OpamUrl.parse in + let* (src : Opam_repo.Source.t) = Opam_repo.Source.of_opam_url opam_url in + let source = src.url in + let* remote = Rev_store.add_repo rev_store ~source ~branch:None in let* (_ : Rev_store.Remote.t) = Rev_store.Remote.update remote in print_endline "Creating first remote succeeded"; [%expect {| Creating first remote succeeded |}]; - let* (_remote' : Rev_store.Remote.uninit) = Rev_store.add_repo rev_store ~source in + let* remote' = Rev_store.add_repo rev_store ~source ~branch:None in + let (_ : Rev_store.Remote.t) = Rev_store.Remote.don't_update remote' in print_endline "Adding same remote without update succeeded"; [%expect {| Adding same remote without update succeeded |}]; - let* remote'' = Rev_store.add_repo rev_store ~source in + let* remote'' = Rev_store.add_repo rev_store ~source ~branch:None in let* (_ : Rev_store.Remote.t) = Rev_store.Remote.update remote'' in print_endline "Adding same remote with update succeeded"; [%expect {|