From 08e89b17d5a9c89e192ac99b5ec143c79a29d99d Mon Sep 17 00:00:00 2001 From: Mathieu Barbin Date: Sun, 5 Jan 2025 10:23:50 +0100 Subject: [PATCH 1/3] Add experimental support for Miou --- dune-project | 40 +++++++++++++++ headache.sh | 2 + lib/vcs_git_miou/src/dune | 30 +++++++++++ lib/vcs_git_miou/src/runtime.ml | 37 ++++++++++++++ lib/vcs_git_miou/src/runtime.mli | 26 ++++++++++ lib/vcs_git_miou/src/vcs_git_miou.ml | 34 +++++++++++++ lib/vcs_git_miou/src/vcs_git_miou.mli | 73 +++++++++++++++++++++++++++ vcs-git-miou.opam | 57 +++++++++++++++++++++ vcs-git-miou.opam.template | 16 ++++++ vcs-tests.opam | 2 + 10 files changed, 317 insertions(+) create mode 100644 lib/vcs_git_miou/src/dune create mode 100644 lib/vcs_git_miou/src/runtime.ml create mode 100644 lib/vcs_git_miou/src/runtime.mli create mode 100644 lib/vcs_git_miou/src/vcs_git_miou.ml create mode 100644 lib/vcs_git_miou/src/vcs_git_miou.mli create mode 100644 vcs-git-miou.opam create mode 100644 vcs-git-miou.opam.template diff --git a/dune-project b/dune-project index 0e8e68e..383dac2 100644 --- a/dune-project +++ b/dune-project @@ -235,6 +235,42 @@ (vcs-git-provider (= :version)))) +(package + (name vcs-git-miou) + (synopsis + "A Git provider for Vcs based on Vcs_git_provider for Miou programs") + (depends + (ocaml + (>= 5.2)) + (miou + (>= 0.3.0)) + (fpath + (>= 0.7.3)) + (fpath-sexp0 + (>= 0.2.2)) + (ppx_sexp_conv + (and + (>= v0.17) + (< v0.18))) + (ppx_sexp_value + (and + (>= v0.17) + (< v0.18))) + (ppxlib + (>= 0.33)) + (provider + (>= 0.0.11)) + (sexplib0 + (and + (>= v0.17) + (< v0.18))) + (vcs + (= :version)) + (vcs-git-blocking + (= :version)) + (vcs-git-provider + (= :version)))) + (package (name vcs-tests) (synopsis "Tests & Examples for [Vcs]") @@ -289,6 +325,8 @@ (and :with-doc (>= 2.4))) + (miou + (>= 0.3.0)) (pp-log (>= 0.0.8)) (ppx_compare @@ -356,6 +394,8 @@ (= :version)) (vcs-git-eio (= :version)) + (vcs-git-miou + (= :version)) (vcs-git-provider (= :version)) (vcs-test-helpers diff --git a/headache.sh b/headache.sh index 02e4fdf..7c06498 100755 --- a/headache.sh +++ b/headache.sh @@ -13,6 +13,8 @@ dirs=( "lib/vcs_git_blocking/test" "lib/vcs_git_eio/src" "lib/vcs_git_eio/test" + "lib/vcs_git_miou/src" + "lib/vcs_git_miou/test" "lib/vcs_git_provider/src" "lib/vcs_git_provider/test" "lib/vcs_test_helpers/src" diff --git a/lib/vcs_git_miou/src/dune b/lib/vcs_git_miou/src/dune new file mode 100644 index 0000000..e40224f --- /dev/null +++ b/lib/vcs_git_miou/src/dune @@ -0,0 +1,30 @@ +(library + (name vcs_git_miou) + (public_name vcs-git-miou) + (flags + :standard + -w + +a-4-40-41-42-44-45-48-66 + -warn-error + +a + -open + Fpath_sexp0 + -open + Sexplib0 + -open + Sexplib0.Sexp_conv) + (libraries + fpath + fpath-sexp0 + miou + provider + sexplib0 + vcs + vcs-git-blocking + vcs-git-provider) + (instrumentation + (backend bisect_ppx)) + (lint + (pps ppx_js_style -allow-let-operators -check-doc-comments)) + (preprocess + (pps -unused-code-warnings=force ppx_sexp_conv ppx_sexp_value))) diff --git a/lib/vcs_git_miou/src/runtime.ml b/lib/vcs_git_miou/src/runtime.ml new file mode 100644 index 0000000..6edd49e --- /dev/null +++ b/lib/vcs_git_miou/src/runtime.ml @@ -0,0 +1,37 @@ +(*******************************************************************************) +(* Vcs - a Versatile OCaml Library for Git Operations *) +(* Copyright (C) 2024 Mathieu Barbin *) +(* *) +(* This file is part of Vcs. *) +(* *) +(* Vcs is free software; you can redistribute it and/or modify it under *) +(* the terms of the GNU Lesser General Public License as published by the *) +(* Free Software Foundation either version 3 of the License, or any later *) +(* version, with the LGPL-3.0 Linking Exception. *) +(* *) +(* Vcs is distributed in the hope that it will be useful, but WITHOUT ANY *) +(* WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS *) +(* FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License and *) +(* the file `NOTICE.md` at the root of this repository for more details. *) +(* *) +(* You should have received a copy of the GNU Lesser General Public License *) +(* and the LGPL-3.0 Linking Exception along with this library. If not, see *) +(* and , respectively. *) +(*******************************************************************************) + +module Impl = Vcs_git_blocking.Runtime + +type t = Impl.t + +let create () = Impl.create () +let load_file t ~path = Miou.call (fun () -> Impl.load_file t ~path) |> Miou.await_exn + +let save_file ?perms t ~path ~file_contents = + Miou.call (fun () -> Impl.save_file ?perms t ~path ~file_contents) |> Miou.await_exn +;; + +let read_dir t ~dir = Miou.call (fun () -> Impl.read_dir t ~dir) |> Miou.await_exn + +let git ?env t ~cwd ~args ~f = + Miou.call (fun () -> Impl.git ?env t ~cwd ~args ~f) |> Miou.await_exn +;; diff --git a/lib/vcs_git_miou/src/runtime.mli b/lib/vcs_git_miou/src/runtime.mli new file mode 100644 index 0000000..3a0144f --- /dev/null +++ b/lib/vcs_git_miou/src/runtime.mli @@ -0,0 +1,26 @@ +(*_******************************************************************************) +(*_ Vcs - a Versatile OCaml Library for Git Operations *) +(*_ Copyright (C) 2024 Mathieu Barbin *) +(*_ *) +(*_ This file is part of Vcs. *) +(*_ *) +(*_ Vcs is free software; you can redistribute it and/or modify it under *) +(*_ the terms of the GNU Lesser General Public License as published by the *) +(*_ Free Software Foundation either version 3 of the License, or any later *) +(*_ version, with the LGPL-3.0 Linking Exception. *) +(*_ *) +(*_ Vcs is distributed in the hope that it will be useful, but WITHOUT ANY *) +(*_ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS *) +(*_ FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License and *) +(*_ the file `NOTICE.md` at the root of this repository for more details. *) +(*_ *) +(*_ You should have received a copy of the GNU Lesser General Public License *) +(*_ and the LGPL-3.0 Linking Exception along with this library. If not, see *) +(*_ and , respectively. *) +(*_******************************************************************************) + +type t + +include Vcs_git_provider.Runtime.S with type t := t + +val create : unit -> t diff --git a/lib/vcs_git_miou/src/vcs_git_miou.ml b/lib/vcs_git_miou/src/vcs_git_miou.ml new file mode 100644 index 0000000..22b97a5 --- /dev/null +++ b/lib/vcs_git_miou/src/vcs_git_miou.ml @@ -0,0 +1,34 @@ +(*******************************************************************************) +(* Vcs - a Versatile OCaml Library for Git Operations *) +(* Copyright (C) 2024 Mathieu Barbin *) +(* *) +(* This file is part of Vcs. *) +(* *) +(* Vcs is free software; you can redistribute it and/or modify it under *) +(* the terms of the GNU Lesser General Public License as published by the *) +(* Free Software Foundation either version 3 of the License, or any later *) +(* version, with the LGPL-3.0 Linking Exception. *) +(* *) +(* Vcs is distributed in the hope that it will be useful, but WITHOUT ANY *) +(* WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS *) +(* FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License and *) +(* the file `NOTICE.md` at the root of this repository for more details. *) +(* *) +(* You should have received a copy of the GNU Lesser General Public License *) +(* and the LGPL-3.0 Linking Exception along with this library. If not, see *) +(* and , respectively. *) +(*******************************************************************************) + +type 'a t = ([> Vcs_git_provider.Trait.t ] as 'a) Vcs.t +type t' = Vcs_git_provider.Trait.t t + +module Impl = struct + include Runtime + include Vcs_git_provider.Make (Runtime) +end + +let create () = + Vcs.create (Provider.T { t = Impl.create (); provider = Impl.provider () }) +;; + +module Runtime = Runtime diff --git a/lib/vcs_git_miou/src/vcs_git_miou.mli b/lib/vcs_git_miou/src/vcs_git_miou.mli new file mode 100644 index 0000000..2314f62 --- /dev/null +++ b/lib/vcs_git_miou/src/vcs_git_miou.mli @@ -0,0 +1,73 @@ +(*_******************************************************************************) +(*_ Vcs - a Versatile OCaml Library for Git Operations *) +(*_ Copyright (C) 2024 Mathieu Barbin *) +(*_ *) +(*_ This file is part of Vcs. *) +(*_ *) +(*_ Vcs is free software; you can redistribute it and/or modify it under *) +(*_ the terms of the GNU Lesser General Public License as published by the *) +(*_ Free Software Foundation either version 3 of the License, or any later *) +(*_ version, with the LGPL-3.0 Linking Exception. *) +(*_ *) +(*_ Vcs is distributed in the hope that it will be useful, but WITHOUT ANY *) +(*_ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS *) +(*_ FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License and *) +(*_ the file `NOTICE.md` at the root of this repository for more details. *) +(*_ *) +(*_ You should have received a copy of the GNU Lesser General Public License *) +(*_ and the LGPL-3.0 Linking Exception along with this library. If not, see *) +(*_ and , respectively. *) +(*_******************************************************************************) + +(** Implementation of a git provider for the {!module:Vcs} library, based on + [Miou], and {!module:Vcs_git_provider}. + + This implementation is based on the [git] command line tool. We run it as an + external program with utils from [Stdlib] and [Unix], producing the right + command line invocation and parsing the output to produce a typed version of + the expected results with [Vcs_git_provider]. Note that [git] must be found + in the PATH of the running environment. + + The current implementation runs blocking calls with [Miou.call], and then + awaits the result cooperatively from the calling domain with + [Miou.await_exn]. This only works if there are at least 1 extra domain + available. *) + +type 'a t = ([> Vcs_git_provider.Trait.t ] as 'a) Vcs.t + +(** This is a convenient type alias that may be used to designate a provider + with the exact list of traits supported by this implementation. *) +type t' = Vcs_git_provider.Trait.t t + +val create : unit -> _ t + +(** The implementation of the provider is exported for convenience and tests. + Casual users should prefer using [Vcs] directly. *) +module Impl : sig + type t + + val create : unit -> t + + (** {1 Provider interfaces} *) + + module Add : Vcs.Trait.Add.S with type t = t + module Branch : Vcs.Trait.Branch.S with type t = t + module Commit : Vcs.Trait.Commit.S with type t = t + module Config : Vcs.Trait.Config.S with type t = t + module File_system : Vcs.Trait.File_system.S with type t = t + module Git : Vcs.Trait.Git.S with type t = t + module Init : Vcs.Trait.Init.S with type t = t + module Log : Vcs.Trait.Log.S with type t = t + module Ls_files : Vcs.Trait.Ls_files.S with type t = t + module Name_status : Vcs.Trait.Name_status.S with type t = t + module Num_status : Vcs.Trait.Num_status.S with type t = t + module Refs : Vcs.Trait.Refs.S with type t = t + module Rev_parse : Vcs.Trait.Rev_parse.S with type t = t + module Show : Vcs.Trait.Show.S with type t = t +end + +(** {1 Runtime} + + Exposed if you need to extend it. *) + +module Runtime = Runtime diff --git a/vcs-git-miou.opam b/vcs-git-miou.opam new file mode 100644 index 0000000..7bf8a98 --- /dev/null +++ b/vcs-git-miou.opam @@ -0,0 +1,57 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +synopsis: + "A Git provider for Vcs based on Vcs_git_provider for Miou programs" +maintainer: ["Mathieu Barbin "] +authors: ["Mathieu Barbin"] +license: "LGPL-3.0-or-later WITH LGPL-3.0-linking-exception" +homepage: "https://github.com/mbarbin/vcs" +doc: "https://mbarbin.github.io/vcs/" +bug-reports: "https://github.com/mbarbin/vcs/issues" +depends: [ + "dune" {>= "3.17"} + "ocaml" {>= "5.2"} + "miou" {>= "0.3.0"} + "fpath" {>= "0.7.3"} + "fpath-sexp0" {>= "0.2.2"} + "ppx_sexp_conv" {>= "v0.17" & < "v0.18"} + "ppx_sexp_value" {>= "v0.17" & < "v0.18"} + "ppxlib" {>= "0.33"} + "provider" {>= "0.0.11"} + "sexplib0" {>= "v0.17" & < "v0.18"} + "vcs" {= version} + "vcs-git-blocking" {= version} + "vcs-git-provider" {= version} + "odoc" {with-doc} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/mbarbin/vcs.git" +description: """\ + +[vcs] is a set of OCaml libraries for interacting with Git +repositories. It provides a type-safe and direct-style API to +programmatically perform Git operations, ranging from creating commits +and branches to loading and navigating commit graphs in memory, +computing diffs between revisions, and more. + +[Vcs_git_miou] implements a Git provider for [vcs] based on [miou]. It +runs the [git] CLI as a subprocess in a non-blocking fashion. + +[miou]: https://github.com/robur-coop/miou + +""" +tags: [ "miou" "git" "vcs" "non-blocking-io" ] +x-maintenance-intent: [ "(latest)" ] diff --git a/vcs-git-miou.opam.template b/vcs-git-miou.opam.template new file mode 100644 index 0000000..90b8599 --- /dev/null +++ b/vcs-git-miou.opam.template @@ -0,0 +1,16 @@ +description: """\ + +[vcs] is a set of OCaml libraries for interacting with Git +repositories. It provides a type-safe and direct-style API to +programmatically perform Git operations, ranging from creating commits +and branches to loading and navigating commit graphs in memory, +computing diffs between revisions, and more. + +[Vcs_git_miou] implements a Git provider for [vcs] based on [miou]. It +runs the [git] CLI as a subprocess in a non-blocking fashion. + +[miou]: https://github.com/robur-coop/miou + +""" +tags: [ "miou" "git" "vcs" "non-blocking-io" ] +x-maintenance-intent: [ "(latest)" ] diff --git a/vcs-tests.opam b/vcs-tests.opam index 5d7e55a..1d5652f 100644 --- a/vcs-tests.opam +++ b/vcs-tests.opam @@ -27,6 +27,7 @@ depends: [ "fpath-base" {>= "0.2.2"} "fpath-sexp0" {>= "0.2.2"} "mdx" {with-doc & >= "2.4"} + "miou" {>= "0.3.0"} "pp-log" {>= "0.0.8"} "ppx_compare" {>= "v0.17" & < "v0.18"} "ppx_enumerate" {>= "v0.17" & < "v0.18"} @@ -48,6 +49,7 @@ depends: [ "vcs-command" {= version} "vcs-git-blocking" {= version} "vcs-git-eio" {= version} + "vcs-git-miou" {= version} "vcs-git-provider" {= version} "vcs-test-helpers" {= version} "sherlodoc" {with-doc & >= "0.2"} From 8caa91de7467351e2e48be601903e5f48bbe4995 Mon Sep 17 00:00:00 2001 From: Mathieu Barbin Date: Sun, 5 Jan 2025 10:23:58 +0100 Subject: [PATCH 2/3] Add tests for miou backend --- lib/vcs_git_miou/test/dune | 42 +++++++++ lib/vcs_git_miou/test/test__hello_commit.ml | 89 +++++++++++++++++++ lib/vcs_git_miou/test/test__hello_commit.mli | 20 +++++ .../test/test__no_domain_available.ml | 67 ++++++++++++++ .../test/test__no_domain_available.mli | 20 +++++ lib/vcs_git_miou/test/test__no_run.ml | 30 +++++++ lib/vcs_git_miou/test/test__no_run.mli | 20 +++++ 7 files changed, 288 insertions(+) create mode 100644 lib/vcs_git_miou/test/dune create mode 100644 lib/vcs_git_miou/test/test__hello_commit.ml create mode 100644 lib/vcs_git_miou/test/test__hello_commit.mli create mode 100644 lib/vcs_git_miou/test/test__no_domain_available.ml create mode 100644 lib/vcs_git_miou/test/test__no_domain_available.mli create mode 100644 lib/vcs_git_miou/test/test__no_run.ml create mode 100644 lib/vcs_git_miou/test/test__no_run.mli diff --git a/lib/vcs_git_miou/test/dune b/lib/vcs_git_miou/test/dune new file mode 100644 index 0000000..6aeca5d --- /dev/null +++ b/lib/vcs_git_miou/test/dune @@ -0,0 +1,42 @@ +(library + (name vcs_git_miou_test) + (public_name vcs-tests.vcs_git_miou_test) + (inline_tests) + (flags + :standard + -w + +a-4-40-41-42-44-45-48-66 + -warn-error + +a + -open + Base + -open + Fpath_sexp0 + -open + Expect_test_helpers_base) + (libraries + base + miou + miou.unix + expect_test_helpers_core.expect_test_helpers_base + fpath + fpath-sexp0 + unix + vcs + vcs_git_miou + vcs_test_helpers) + (instrumentation + (backend bisect_ppx)) + (lint + (pps ppx_js_style -check-doc-comments)) + (preprocess + (pps + -unused-code-warnings=force + ppx_compare + ppx_enumerate + ppx_expect + ppx_hash + ppx_here + ppx_let + ppx_sexp_conv + ppx_sexp_value))) diff --git a/lib/vcs_git_miou/test/test__hello_commit.ml b/lib/vcs_git_miou/test/test__hello_commit.ml new file mode 100644 index 0000000..25aa57f --- /dev/null +++ b/lib/vcs_git_miou/test/test__hello_commit.ml @@ -0,0 +1,89 @@ +(*******************************************************************************) +(* Vcs - a Versatile OCaml Library for Git Operations *) +(* Copyright (C) 2024 Mathieu Barbin *) +(* *) +(* This file is part of Vcs. *) +(* *) +(* Vcs is free software; you can redistribute it and/or modify it under *) +(* the terms of the GNU Lesser General Public License as published by the *) +(* Free Software Foundation either version 3 of the License, or any later *) +(* version, with the LGPL-3.0 Linking Exception. *) +(* *) +(* Vcs is distributed in the hope that it will be useful, but WITHOUT ANY *) +(* WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS *) +(* FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License and *) +(* the file `NOTICE.md` at the root of this repository for more details. *) +(* *) +(* You should have received a copy of the GNU Lesser General Public License *) +(* and the LGPL-3.0 Linking Exception along with this library. If not, see *) +(* and , respectively. *) +(*******************************************************************************) + +(* This is a simple test to make sure we can initialize a repo and commit a + file, and verify the mock rev mapping. *) + +let%expect_test "hello commit" = + Miou_unix.run + @@ fun () -> + let vcs = Vcs_git_miou.create () in + let mock_revs = Vcs.Mock_revs.create () in + let repo_root = + let path = Stdlib.Filename.temp_dir ~temp_dir:(Unix.getcwd ()) "vcs" "test" in + Vcs_test_helpers.init vcs ~path:(Absolute_path.v path) + in + let hello_file = Vcs.Path_in_repo.v "hello.txt" in + Vcs.save_file + vcs + ~path:(Vcs.Repo_root.append repo_root hello_file) + ~file_contents:(Vcs.File_contents.create "Hello World!"); + print_s + [%sexp + (Vcs.load_file vcs ~path:(Vcs.Repo_root.append repo_root hello_file) + : Vcs.File_contents.t)]; + [%expect {| "Hello World!" |}]; + print_s + [%sexp + (Vcs.read_dir vcs ~dir:(Vcs.Repo_root.to_absolute_path repo_root) : Fsegment.t list)]; + [%expect {| (.git hello.txt) |}]; + Vcs.add vcs ~repo_root ~path:hello_file; + let rev = + Vcs.commit vcs ~repo_root ~commit_message:(Vcs.Commit_message.v "hello commit") + in + let mock_rev = Vcs.Mock_revs.to_mock mock_revs ~rev in + print_s [%sexp (mock_rev : Vcs.Rev.t)]; + [%expect {| 1185512b92d612b25613f2e5b473e5231185512b |}]; + print_s + [%sexp + (Vcs.Result.show_file_at_rev + vcs + ~repo_root + ~rev:(Vcs.Mock_revs.of_mock mock_revs ~mock_rev |> Option.value_exn ~here:[%here]) + ~path:hello_file + : [ `Present of Vcs.File_contents.t | `Absent ] Vcs.Result.t)]; + [%expect {| (Ok (Present "Hello World!")) |}]; + print_s + [%sexp + (Vcs.Result.show_file_at_rev vcs ~repo_root ~rev ~path:hello_file + : [ `Present of Vcs.File_contents.t | `Absent ] Vcs.Result.t)]; + [%expect {| (Ok (Present "Hello World!")) |}]; + (* Using [Vcs] from within cooperative [Miou.async] constructs. *) + let p1 = + Miou.async (fun () -> [%sexp (Vcs.current_branch vcs ~repo_root : Vcs.Branch_name.t)]) + in + let p2 = + Miou.async (fun () -> + [%sexp + (Vcs.ls_files vcs ~repo_root ~below:Vcs.Path_in_repo.root + : Vcs.Path_in_repo.t list)]) + in + Miou.await_all [ p1; p2 ] + |> List.iter ~f:(function + | Ok sexp -> print_s sexp + | Error exn -> raise exn [@coverage off]); + [%expect + {| + main + (hello.txt) + |}]; + () +;; diff --git a/lib/vcs_git_miou/test/test__hello_commit.mli b/lib/vcs_git_miou/test/test__hello_commit.mli new file mode 100644 index 0000000..45af050 --- /dev/null +++ b/lib/vcs_git_miou/test/test__hello_commit.mli @@ -0,0 +1,20 @@ +(*_******************************************************************************) +(*_ Vcs - a Versatile OCaml Library for Git Operations *) +(*_ Copyright (C) 2024 Mathieu Barbin *) +(*_ *) +(*_ This file is part of Vcs. *) +(*_ *) +(*_ Vcs is free software; you can redistribute it and/or modify it under *) +(*_ the terms of the GNU Lesser General Public License as published by the *) +(*_ Free Software Foundation either version 3 of the License, or any later *) +(*_ version, with the LGPL-3.0 Linking Exception. *) +(*_ *) +(*_ Vcs is distributed in the hope that it will be useful, but WITHOUT ANY *) +(*_ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS *) +(*_ FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License and *) +(*_ the file `NOTICE.md` at the root of this repository for more details. *) +(*_ *) +(*_ You should have received a copy of the GNU Lesser General Public License *) +(*_ and the LGPL-3.0 Linking Exception along with this library. If not, see *) +(*_ and , respectively. *) +(*_******************************************************************************) diff --git a/lib/vcs_git_miou/test/test__no_domain_available.ml b/lib/vcs_git_miou/test/test__no_domain_available.ml new file mode 100644 index 0000000..8a7444d --- /dev/null +++ b/lib/vcs_git_miou/test/test__no_domain_available.ml @@ -0,0 +1,67 @@ +(*******************************************************************************) +(* Vcs - a Versatile OCaml Library for Git Operations *) +(* Copyright (C) 2024 Mathieu Barbin *) +(* *) +(* This file is part of Vcs. *) +(* *) +(* Vcs is free software; you can redistribute it and/or modify it under *) +(* the terms of the GNU Lesser General Public License as published by the *) +(* Free Software Foundation either version 3 of the License, or any later *) +(* version, with the LGPL-3.0 Linking Exception. *) +(* *) +(* Vcs is distributed in the hope that it will be useful, but WITHOUT ANY *) +(* WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS *) +(* FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License and *) +(* the file `NOTICE.md` at the root of this repository for more details. *) +(* *) +(* You should have received a copy of the GNU Lesser General Public License *) +(* and the LGPL-3.0 Linking Exception along with this library. If not, see *) +(* and , respectively. *) +(*******************************************************************************) + +(* As explained in the documentation, [Vcs_git_miou] requires one extra domain + to run the blocking calls to git. In this test we monitor what happens if + there is no such domain available. *) + +let%expect_test "hello commit" = + Miou_unix.run ~domains:0 + @@ fun () -> + let vcs = Vcs_git_miou.create () in + require_does_raise [%here] (fun () -> + Vcs_test_helpers.init vcs ~path:(Absolute_path.v (Unix.getcwd ()))); + [%expect {| (Miou.No_domain_available) |}]; + () +;; + +(* In the next test, we look at a case where the call to git is itself run from + within a call to [Miou.call] when there is no other domain available. This + should be considered a programming error. *) + +let%expect_test "hello commit" = + Miou_unix.run ~domains:1 + @@ fun () -> + let vcs = Vcs_git_miou.create () in + let repo_root = + let path = Stdlib.Filename.temp_dir ~temp_dir:(Unix.getcwd ()) "vcs" "test" in + Vcs_test_helpers.init vcs ~path:(Absolute_path.v path) + in + let hello_file = Vcs.Path_in_repo.v "hello.txt" in + Vcs.save_file + vcs + ~path:(Vcs.Repo_root.append repo_root hello_file) + ~file_contents:(Vcs.File_contents.create "Hello World!"); + print_s + [%sexp + (Vcs.load_file vcs ~path:(Vcs.Repo_root.append repo_root hello_file) + : Vcs.File_contents.t)]; + [%expect {| "Hello World!" |}]; + require_does_raise [%here] (fun () -> + Miou.call (fun () -> + Vcs.save_file + vcs + ~path:(Vcs.Repo_root.append repo_root hello_file) + ~file_contents:(Vcs.File_contents.create "Hello World Again!")) + |> Miou.await_exn); + [%expect {| (Miou.No_domain_available) |}]; + () +;; diff --git a/lib/vcs_git_miou/test/test__no_domain_available.mli b/lib/vcs_git_miou/test/test__no_domain_available.mli new file mode 100644 index 0000000..45af050 --- /dev/null +++ b/lib/vcs_git_miou/test/test__no_domain_available.mli @@ -0,0 +1,20 @@ +(*_******************************************************************************) +(*_ Vcs - a Versatile OCaml Library for Git Operations *) +(*_ Copyright (C) 2024 Mathieu Barbin *) +(*_ *) +(*_ This file is part of Vcs. *) +(*_ *) +(*_ Vcs is free software; you can redistribute it and/or modify it under *) +(*_ the terms of the GNU Lesser General Public License as published by the *) +(*_ Free Software Foundation either version 3 of the License, or any later *) +(*_ version, with the LGPL-3.0 Linking Exception. *) +(*_ *) +(*_ Vcs is distributed in the hope that it will be useful, but WITHOUT ANY *) +(*_ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS *) +(*_ FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License and *) +(*_ the file `NOTICE.md` at the root of this repository for more details. *) +(*_ *) +(*_ You should have received a copy of the GNU Lesser General Public License *) +(*_ and the LGPL-3.0 Linking Exception along with this library. If not, see *) +(*_ and , respectively. *) +(*_******************************************************************************) diff --git a/lib/vcs_git_miou/test/test__no_run.ml b/lib/vcs_git_miou/test/test__no_run.ml new file mode 100644 index 0000000..48fd28e --- /dev/null +++ b/lib/vcs_git_miou/test/test__no_run.ml @@ -0,0 +1,30 @@ +(*******************************************************************************) +(* Vcs - a Versatile OCaml Library for Git Operations *) +(* Copyright (C) 2024 Mathieu Barbin *) +(* *) +(* This file is part of Vcs. *) +(* *) +(* Vcs is free software; you can redistribute it and/or modify it under *) +(* the terms of the GNU Lesser General Public License as published by the *) +(* Free Software Foundation either version 3 of the License, or any later *) +(* version, with the LGPL-3.0 Linking Exception. *) +(* *) +(* Vcs is distributed in the hope that it will be useful, but WITHOUT ANY *) +(* WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS *) +(* FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License and *) +(* the file `NOTICE.md` at the root of this repository for more details. *) +(* *) +(* You should have received a copy of the GNU Lesser General Public License *) +(* and the LGPL-3.0 Linking Exception along with this library. If not, see *) +(* and , respectively. *) +(*******************************************************************************) + +(* The library must be used from without a call to [Miou_unix.run]. *) + +let%expect_test "hello commit" = + let vcs = Vcs_git_miou.create () in + require_does_raise [%here] (fun () -> + Vcs_test_helpers.init vcs ~path:(Absolute_path.v (Unix.getcwd ()))); + [%expect {| ("Stdlib.Effect.Unhandled(Miou.Domains)") |}]; + () +;; diff --git a/lib/vcs_git_miou/test/test__no_run.mli b/lib/vcs_git_miou/test/test__no_run.mli new file mode 100644 index 0000000..45af050 --- /dev/null +++ b/lib/vcs_git_miou/test/test__no_run.mli @@ -0,0 +1,20 @@ +(*_******************************************************************************) +(*_ Vcs - a Versatile OCaml Library for Git Operations *) +(*_ Copyright (C) 2024 Mathieu Barbin *) +(*_ *) +(*_ This file is part of Vcs. *) +(*_ *) +(*_ Vcs is free software; you can redistribute it and/or modify it under *) +(*_ the terms of the GNU Lesser General Public License as published by the *) +(*_ Free Software Foundation either version 3 of the License, or any later *) +(*_ version, with the LGPL-3.0 Linking Exception. *) +(*_ *) +(*_ Vcs is distributed in the hope that it will be useful, but WITHOUT ANY *) +(*_ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS *) +(*_ FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License and *) +(*_ the file `NOTICE.md` at the root of this repository for more details. *) +(*_ *) +(*_ You should have received a copy of the GNU Lesser General Public License *) +(*_ and the LGPL-3.0 Linking Exception along with this library. If not, see *) +(*_ and , respectively. *) +(*_******************************************************************************) From e3a21925a72cc034c535d5453850038f73ad8fa8 Mon Sep 17 00:00:00 2001 From: Mathieu Barbin Date: Sun, 5 Jan 2025 10:44:54 +0100 Subject: [PATCH 3/3] Fix brittle test --- lib/vcs_git_miou/test/test__hello_commit.ml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lib/vcs_git_miou/test/test__hello_commit.ml b/lib/vcs_git_miou/test/test__hello_commit.ml index 25aa57f..10461e4 100644 --- a/lib/vcs_git_miou/test/test__hello_commit.ml +++ b/lib/vcs_git_miou/test/test__hello_commit.ml @@ -52,6 +52,8 @@ let%expect_test "hello commit" = let mock_rev = Vcs.Mock_revs.to_mock mock_revs ~rev in print_s [%sexp (mock_rev : Vcs.Rev.t)]; [%expect {| 1185512b92d612b25613f2e5b473e5231185512b |}]; + (* Making sure the default branch name is deterministic. *) + Vcs.rename_current_branch vcs ~repo_root ~to_:Vcs.Branch_name.main; print_s [%sexp (Vcs.Result.show_file_at_rev