diff --git a/.github/workflows/more-ci.yml b/.github/workflows/more-ci.yml index 25d8fb1..5e8549b 100644 --- a/.github/workflows/more-ci.yml +++ b/.github/workflows/more-ci.yml @@ -35,6 +35,9 @@ jobs: # We exclude the combination already tested in the 'ci' workflow. - os: ubuntu-latest ocaml-compiler: 5.2.x + # We exclude windows-4.14 - this fails when building core. + - os: windows-latest + ocaml-compiler: 4.14.x runs-on: ${{ matrix.os }} @@ -52,16 +55,11 @@ jobs: # janestreet-bleeding: https://github.com/janestreet/opam-repository.git # janestreet-bleeding-external: https://github.com/janestreet/opam-repository.git#external-packages + # We build and run tests for a subset of packages. More tests are run in + # the development workflow and as part of the main CI job. These are the + # tests that are checked for every combination of os and ocaml-compiler. - name: Install dependencies - run: opam install ./provider.opam --deps-only --with-test + run: opam install ./provider.opam ./provider-tests.opam --deps-only --with-test - - name: Build - run: opam exec -- dune build @all -p provider - - # For now, we only run tests for the `provider` package. Effectively, this - # runs nothing because the tests are in the `provider-test` package. We - # configured this in preparation for running the tests for specific - # packages only in the future, once we have a dedicated test suite that - # can run on every matrix combination configured here. - - name: Run tests - run: opam exec -- dune build @runtest -p provider + - name: Build & Run tests + run: opam exec -- dune build @all @runtest -p provider,provider-tests diff --git a/doc/docs/reference/dune b/doc/docs/reference/dune index 611baea..698f949 100644 --- a/doc/docs/reference/dune +++ b/doc/docs/reference/dune @@ -1,5 +1,5 @@ (mdx - (package provider-tests) + (package provider-dev) (deps (package provider) (glob_files *.txt)) diff --git a/doc/docs/tutorials/getting-started/dune b/doc/docs/tutorials/getting-started/dune index 611baea..698f949 100644 --- a/doc/docs/tutorials/getting-started/dune +++ b/doc/docs/tutorials/getting-started/dune @@ -1,5 +1,5 @@ (mdx - (package provider-tests) + (package provider-dev) (deps (package provider) (glob_files *.txt)) diff --git a/doc/docs/tutorials/handler-explicit/dune b/doc/docs/tutorials/handler-explicit/dune index 611baea..698f949 100644 --- a/doc/docs/tutorials/handler-explicit/dune +++ b/doc/docs/tutorials/handler-explicit/dune @@ -1,5 +1,5 @@ (mdx - (package provider-tests) + (package provider-dev) (deps (package provider) (glob_files *.txt)) diff --git a/dune-project b/dune-project index cb39510..b4c8716 100644 --- a/dune-project +++ b/dune-project @@ -25,12 +25,64 @@ (>= 4.14)) (sexplib0 (and - (>= v0.17) + (>= v0.16) (< v0.18))))) (package (name provider-tests) (synopsis "Tests for provider") + (depends + (ocaml + (>= 4.14)) + (base + (and + (>= v0.16) + (< v0.18))) + (expect_test_helpers_core + (and + (>= v0.16) + (< v0.18))) + (ppx_compare + (and + (>= v0.16) + (< v0.18))) + (ppx_enumerate + (and + (>= v0.16) + (< v0.18))) + (ppx_expect + (and + (>= v0.16) + (< v0.18))) + (ppx_hash + (and + (>= v0.16) + (< v0.18))) + (ppx_here + (and + (>= v0.16) + (< v0.18))) + (ppx_let + (and + (>= v0.16) + (< v0.18))) + (ppx_sexp_conv + (and + (>= v0.16) + (< v0.18))) + (ppx_sexp_value + (and + (>= v0.16) + (< v0.18))) + (ppxlib + (>= 0.33)) + (provider + (= :version)))) + +(package + (name provider-dev) + (synopsis + "Package to regroup dev targets for the provider project, documentation, etc.") (depends (ocaml (>= 5.2)) @@ -101,6 +153,8 @@ (>= 0.33)) (provider (= :version)) + (provider-tests + (= :version)) (sherlodoc (and :with-doc diff --git a/provider-dev.opam b/provider-dev.opam new file mode 100644 index 0000000..007cf33 --- /dev/null +++ b/provider-dev.opam @@ -0,0 +1,51 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +synopsis: + "Package to regroup dev targets for the provider project, documentation, etc." +maintainer: ["Mathieu Barbin "] +authors: ["Mathieu Barbin"] +license: "ISC" +homepage: "https://github.com/mbarbin/provider" +doc: "https://mbarbin.github.io/provider/" +bug-reports: "https://github.com/mbarbin/provider/issues" +depends: [ + "dune" {>= "3.16"} + "ocaml" {>= "5.2"} + "ocamlformat" {with-dev-setup & = "0.26.2"} + "base" {>= "v0.17" & < "v0.18"} + "bisect_ppx" {with-dev-setup & >= "2.8.3"} + "eio" {>= "1.0"} + "eio_main" {>= "1.0"} + "expect_test_helpers_core" {>= "v0.17" & < "v0.18"} + "higher_kinded" {>= "v0.17" & < "v0.18"} + "mdx" {>= "2.4"} + "ppx_compare" {>= "v0.17" & < "v0.18"} + "ppx_enumerate" {>= "v0.17" & < "v0.18"} + "ppx_expect" {>= "v0.17" & < "v0.18"} + "ppx_hash" {>= "v0.17" & < "v0.18"} + "ppx_here" {>= "v0.17" & < "v0.18"} + "ppx_js_style" {with-dev-setup & >= "v0.17" & < "v0.18"} + "ppx_let" {>= "v0.17" & < "v0.18"} + "ppx_sexp_conv" {>= "v0.17" & < "v0.18"} + "ppx_sexp_value" {>= "v0.17" & < "v0.18"} + "ppxlib" {>= "0.33"} + "provider" {= version} + "provider-tests" {= version} + "sherlodoc" {with-doc & >= "0.2"} + "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/provider.git" diff --git a/provider-tests.opam b/provider-tests.opam index 63ddc83..02f13d6 100644 --- a/provider-tests.opam +++ b/provider-tests.opam @@ -9,27 +9,19 @@ doc: "https://mbarbin.github.io/provider/" bug-reports: "https://github.com/mbarbin/provider/issues" depends: [ "dune" {>= "3.16"} - "ocaml" {>= "5.2"} - "ocamlformat" {with-dev-setup & = "0.26.2"} - "base" {>= "v0.17" & < "v0.18"} - "bisect_ppx" {with-dev-setup & >= "2.8.3"} - "eio" {>= "1.0"} - "eio_main" {>= "1.0"} - "expect_test_helpers_core" {>= "v0.17" & < "v0.18"} - "higher_kinded" {>= "v0.17" & < "v0.18"} - "mdx" {>= "2.4"} - "ppx_compare" {>= "v0.17" & < "v0.18"} - "ppx_enumerate" {>= "v0.17" & < "v0.18"} - "ppx_expect" {>= "v0.17" & < "v0.18"} - "ppx_hash" {>= "v0.17" & < "v0.18"} - "ppx_here" {>= "v0.17" & < "v0.18"} - "ppx_js_style" {with-dev-setup & >= "v0.17" & < "v0.18"} - "ppx_let" {>= "v0.17" & < "v0.18"} - "ppx_sexp_conv" {>= "v0.17" & < "v0.18"} - "ppx_sexp_value" {>= "v0.17" & < "v0.18"} + "ocaml" {>= "4.14"} + "base" {>= "v0.16" & < "v0.18"} + "expect_test_helpers_core" {>= "v0.16" & < "v0.18"} + "ppx_compare" {>= "v0.16" & < "v0.18"} + "ppx_enumerate" {>= "v0.16" & < "v0.18"} + "ppx_expect" {>= "v0.16" & < "v0.18"} + "ppx_hash" {>= "v0.16" & < "v0.18"} + "ppx_here" {>= "v0.16" & < "v0.18"} + "ppx_let" {>= "v0.16" & < "v0.18"} + "ppx_sexp_conv" {>= "v0.16" & < "v0.18"} + "ppx_sexp_value" {>= "v0.16" & < "v0.18"} "ppxlib" {>= "0.33"} "provider" {= version} - "sherlodoc" {with-doc & >= "0.2"} "odoc" {with-doc} ] build: [ diff --git a/provider.opam b/provider.opam index 75d2d81..5932e0c 100644 --- a/provider.opam +++ b/provider.opam @@ -10,7 +10,7 @@ bug-reports: "https://github.com/mbarbin/provider/issues" depends: [ "dune" {>= "3.16"} "ocaml" {>= "4.14"} - "sexplib0" {>= "v0.17" & < "v0.18"} + "sexplib0" {>= "v0.16" & < "v0.18"} "odoc" {with-doc} ] build: [ diff --git a/test/dune b/test/dune index 2316370..150fb43 100644 --- a/test/dune +++ b/test/dune @@ -14,10 +14,10 @@ Expect_test_helpers_base) (libraries base - eio - eio_main expect_test_helpers_core.expect_test_helpers_base provider + test_interfaces + test_providers unix) (instrumentation (backend bisect_ppx)) @@ -34,5 +34,3 @@ ppx_let ppx_sexp_conv ppx_sexp_value))) - -(include_subdirs qualified) diff --git a/test/eio/dune b/test/eio/dune new file mode 100644 index 0000000..28a4f02 --- /dev/null +++ b/test/eio/dune @@ -0,0 +1,39 @@ +(library + (name provider_test_eio) + (public_name provider-dev.provider_test_eio) + (inline_tests) + (flags + :standard + -w + +a-4-40-41-42-44-45-48-66 + -warn-error + +a + -open + Base + -open + Expect_test_helpers_base) + (libraries + base + eio + eio_main + eio_test_providers + expect_test_helpers_core.expect_test_helpers_base + provider + test_interfaces + test_providers + unix) + (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/test/test__reader.ml b/test/eio/test__reader.ml similarity index 83% rename from test/test__reader.ml rename to test/eio/test__reader.ml index 702f58d..55caab9 100644 --- a/test/test__reader.ml +++ b/test/eio/test__reader.ml @@ -25,7 +25,7 @@ let with_temp_dir ~env ~path ~f = let print_all_text_files t ~path = print_s [%sexp - (Interface.Directory_reader.find_files_with_extension t ~path ~ext:".txt" + (Test_interfaces.Directory_reader.find_files_with_extension t ~path ~ext:".txt" : string list)] ;; @@ -33,10 +33,10 @@ let print_all_text_files t ~path = capabilities. *) let print_all_text_files_with_lines t ~path = List.iter - (Interface.Directory_reader.find_files_with_extension t ~path ~ext:".txt") + (Test_interfaces.Directory_reader.find_files_with_extension t ~path ~ext:".txt") ~f:(fun file -> let lines = - let contents = Interface.File_reader.load t ~path:(path ^ "/" ^ file) in + let contents = Test_interfaces.File_reader.load t ~path:(path ^ "/" ^ file) in List.sum (module Int) (String.split_lines contents) ~f:(Fn.const 1) in print_s [%sexp { file : string; lines : int }]) @@ -47,14 +47,14 @@ let print_all_text_files_with_lines t ~path = requiring it. *) let print_all_text_files_with_lines_if_available t ~path = List.iter - (Interface.Directory_reader.find_files_with_extension t ~path ~ext:".txt") + (Test_interfaces.Directory_reader.find_files_with_extension t ~path ~ext:".txt") ~f:(fun file -> let lines = let (Provider.T { t; handler }) = t in match Provider.Handler.lookup_opt handler - ~trait:Interface.File_reader.Provider_interface.File_reader + ~trait:Test_interfaces.File_reader.Provider_interface.File_reader with | None -> "not-available" | Some (module File_reader) -> @@ -67,16 +67,18 @@ let print_all_text_files_with_lines_if_available t ~path = (* Now let's put it all together in a test. *) let%expect_test "test" = - let unix_reader = Providers.Unix_reader.make () in + let unix_reader = Test_providers.Unix_reader.make () in Eio_main.run @@ fun env -> - let eio_reader = Providers.Eio_reader.make ~env in + let eio_reader = Eio_test_providers.Eio_reader.make ~env in with_temp_dir ~env ~path:"test" ~f:(fun dir -> print_s - [%sexp (Interface.Directory_reader.readdir unix_reader ~path:dir : string list)]; + [%sexp + (Test_interfaces.Directory_reader.readdir unix_reader ~path:dir : string list)]; [%expect {| () |}]; print_s - [%sexp (Interface.Directory_reader.readdir eio_reader ~path:dir : string list)]; + [%sexp + (Test_interfaces.Directory_reader.readdir eio_reader ~path:dir : string list)]; [%expect {| () |}]; print_all_text_files unix_reader ~path:dir; [%expect {| () |}]; diff --git a/test/test__reader.mli b/test/eio/test__reader.mli similarity index 100% rename from test/test__reader.mli rename to test/eio/test__reader.mli diff --git a/test/eio/test_providers/dune b/test/eio/test_providers/dune new file mode 100644 index 0000000..3073290 --- /dev/null +++ b/test/eio/test_providers/dune @@ -0,0 +1,36 @@ +(library + (name eio_test_providers) + (public_name provider-dev.eio_test_providers) + (inline_tests) + (flags + :standard + -w + +a-4-40-41-42-44-45-48-66 + -warn-error + +a + -open + Base + -open + Expect_test_helpers_base) + (libraries + base + eio + expect_test_helpers_core.expect_test_helpers_base + test_interfaces + provider + unix) + (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/test/providers/eio_reader.ml b/test/eio/test_providers/eio_reader.ml similarity index 78% rename from test/providers/eio_reader.ml rename to test/eio/test_providers/eio_reader.ml index 9bf28ac..869941c 100644 --- a/test/providers/eio_reader.ml +++ b/test/eio/test_providers/eio_reader.ml @@ -17,10 +17,10 @@ let make ~env : [ `Directory_reader | `File_reader ] Provider.t = ; handler = Provider.Handler.make [ Provider.Trait.implement - Interface.Directory_reader.Provider_interface.Directory_reader + Test_interfaces.Directory_reader.Provider_interface.Directory_reader ~impl:(module Impl) ; Provider.Trait.implement - Interface.File_reader.Provider_interface.File_reader + Test_interfaces.File_reader.Provider_interface.File_reader ~impl:(module Impl) ] } diff --git a/test/providers/eio_reader.mli b/test/eio/test_providers/eio_reader.mli similarity index 83% rename from test/providers/eio_reader.mli rename to test/eio/test_providers/eio_reader.mli index 4c8052e..81688ca 100644 --- a/test/providers/eio_reader.mli +++ b/test/eio/test_providers/eio_reader.mli @@ -18,7 +18,7 @@ type t {!module:Interface.File_reader}. *) val make : env:< fs : _ Eio.Path.t ; .. > - -> [ Interface.Directory_reader.tag | Interface.File_reader.tag ] Provider.t + -> [ Test_interfaces.Directory_reader.tag | Test_interfaces.File_reader.tag ] Provider.t (** In this specific example, we chose to expose the signature of the provider's implementation. This is not something that is usually required, since @@ -28,6 +28,6 @@ val make module Impl : sig type nonrec t = t - include Interface.Directory_reader.Provider_interface.S with type t := t - include Interface.File_reader.Provider_interface.S with type t := t + include Test_interfaces.Directory_reader.Provider_interface.S with type t := t + include Test_interfaces.File_reader.Provider_interface.S with type t := t end diff --git a/test/providers/num_printer.mli b/test/providers/num_printer.mli deleted file mode 100644 index 395ef3d..0000000 --- a/test/providers/num_printer.mli +++ /dev/null @@ -1,15 +0,0 @@ -(** [Num_printer] is a provider for the {!module:Interface.Int_printer} and - {!module:Interface.Float_printer} interfaces. - - The structure of this file is very similar to the [Eio_reader] module, thus - is not documented in details. Refer to {!Eio_reader} for more. *) - -(** In this case we decided to expose the type {!type:t} and {!val:handler}, to - demonstrate how to override a particular binding. See [test__override.ml]. *) -type t = unit - -val handler - : (t, [ Interface.Int_printer.tag | Interface.Float_printer.tag ]) Provider.Handler.t - -(** If you simply wish to use this provider without overrides, use [make ()]. *) -val make : t -> [ Interface.Int_printer.tag | Interface.Float_printer.tag ] Provider.t diff --git a/test/test__cache.ml b/test/test__cache.ml index c183ea2..b4cd71e 100644 --- a/test/test__cache.ml +++ b/test/test__cache.ml @@ -13,15 +13,15 @@ module Cache_state = struct end let%expect_test "override" = - let num_printer = Providers.Num_printer.make () in + let num_printer = Test_providers.Num_printer.make () in let cache_state_of_uid uid = if Provider.Trait.Uid.equal uid - (Interface.Int_printer.Provider_interface.Int_printer |> Provider.Trait.uid) + (Test_interfaces.Int_printer.Provider_interface.Int_printer |> Provider.Trait.uid) then Cache_state.Int_printer else if Provider.Trait.Uid.equal uid - (Interface.Float_printer.Provider_interface.Float_printer + (Test_interfaces.Float_printer.Provider_interface.Float_printer |> Provider.Trait.uid) then Cache_state.Float_printer else assert false [@coverage off] @@ -45,8 +45,8 @@ let%expect_test "override" = ignore (Provider.Handler.lookup handler - ~trait:Interface.Int_printer.Provider_interface.Int_printer - : (module Interface.Int_printer.Provider_interface.S with type t = a))) + ~trait:Test_interfaces.Int_printer.Provider_interface.Int_printer + : (module Test_interfaces.Int_printer.Provider_interface.S with type t = a))) handler; require_equal [%here] @@ -59,8 +59,8 @@ let%expect_test "override" = ignore (Provider.Handler.lookup handler - ~trait:Interface.Float_printer.Provider_interface.Float_printer - : (module Interface.Float_printer.Provider_interface.S with type t = a))) + ~trait:Test_interfaces.Float_printer.Provider_interface.Float_printer + : (module Test_interfaces.Float_printer.Provider_interface.S with type t = a))) handler; require_equal [%here] @@ -74,7 +74,7 @@ let%expect_test "override" = (Option.is_some (Provider.Handler.lookup_opt handler - ~trait:Interface.Int_printer.Provider_interface.Int_printer)); + ~trait:Test_interfaces.Int_printer.Provider_interface.Int_printer)); require_equal [%here] (module Cache_state) @@ -87,7 +87,7 @@ let%expect_test "override" = (Option.is_some (Provider.Handler.lookup_opt handler - ~trait:Interface.Float_printer.Provider_interface.Float_printer)); + ~trait:Test_interfaces.Float_printer.Provider_interface.Float_printer)); require_equal [%here] (module Cache_state) @@ -100,7 +100,7 @@ let%expect_test "override" = [%here] (Provider.Handler.implements handler - ~trait:Interface.Int_printer.Provider_interface.Int_printer); + ~trait:Test_interfaces.Int_printer.Provider_interface.Int_printer); let post_cache_state = cache_state handler in require_equal [%here] (module Cache_state) pre_cache_state post_cache_state in @@ -110,7 +110,7 @@ let%expect_test "override" = [%here] (Provider.Handler.implements handler - ~trait:Interface.Float_printer.Provider_interface.Float_printer); + ~trait:Test_interfaces.Float_printer.Provider_interface.Float_printer); let post_cache_state = cache_state handler in require_equal [%here] (module Cache_state) pre_cache_state post_cache_state in diff --git a/test/test__introspection.ml b/test/test__introspection.ml index e352c7f..5019eb4 100644 --- a/test/test__introspection.ml +++ b/test/test__introspection.ml @@ -17,9 +17,17 @@ let print_implements (Provider.T { t = _; handler }) = [%sexp { implements = { file_reader = - (implements Interface.File_reader.Provider_interface.File_reader : bool) + (implements Test_interfaces.File_reader.Provider_interface.File_reader + : bool) ; directory_reader = - (implements Interface.Directory_reader.Provider_interface.Directory_reader + (implements + Test_interfaces.Directory_reader.Provider_interface.Directory_reader + : bool) + ; int_printer = + (implements Test_interfaces.Int_printer.Provider_interface.Int_printer + : bool) + ; float_printer = + (implements Test_interfaces.Float_printer.Provider_interface.Float_printer : bool) } }] @@ -32,25 +40,32 @@ let%expect_test "introspection" = (( implements ( (file_reader false) - (directory_reader false)))) |}]; - let unix_reader = Providers.Unix_reader.make () in - Eio_main.run - @@ fun env -> - let eio_reader = Providers.Eio_reader.make ~env in - print_implements eio_reader; + (directory_reader false) + (int_printer false) + (float_printer false)))) + |}]; + let int_printer = Test_providers.Int_printer.make () in + let num_printer = Test_providers.Num_printer.make () in + print_implements num_printer; [%expect {| (( implements ( - (file_reader true) - (directory_reader true)))) |}]; - print_implements unix_reader; + (file_reader false) + (directory_reader false) + (int_printer true) + (float_printer true)))) + |}]; + print_implements int_printer; [%expect {| (( implements ( (file_reader false) - (directory_reader true)))) |}]; + (directory_reader false) + (int_printer true) + (float_printer false)))) + |}]; let id_mapping = Hashtbl.create (module Int) in let next_id = ref 0 in let sexp_of_id id = @@ -66,21 +81,16 @@ let%expect_test "introspection" = Sexp.Atom (Int.to_string id) in Ref.set_temporarily Provider.Trait.Info.sexp_of_id sexp_of_id ~f:(fun () -> - print_implemented_traits unix_reader; + print_implemented_traits int_printer; [%expect - {| - (( - (id 0) - (name - Provider_test__Interface__Directory_reader.Provider_interface.Directory_reader))) |}]; - print_implemented_traits eio_reader; + {| (((id 0) (name Test_interfaces.Int_printer.Provider_interface.Int_printer))) |}]; + print_implemented_traits num_printer; [%expect {| - (((id 0) - (name - Provider_test__Interface__Directory_reader.Provider_interface.Directory_reader)) + (((id 0) (name Test_interfaces.Int_printer.Provider_interface.Int_printer)) ((id 1) - (name Provider_test__Interface__File_reader.Provider_interface.File_reader))) |}]; + (name Test_interfaces.Float_printer.Provider_interface.Float_printer))) + |}]; ()); () ;; diff --git a/test/test__invalid_tags.ml b/test/test__invalid_tags.ml index 7ed4a24..3ac6832 100644 --- a/test/test__invalid_tags.ml +++ b/test/test__invalid_tags.ml @@ -3,9 +3,9 @@ runtime. *) let%expect_test "invalid tags" = - (* [Providers.Num_printer] was correctly built. *) - let print_42 printer = Interface.Int_printer.print printer 42 in - print_42 (Providers.Num_printer.make ()); + (* [Test_providers.Num_printer] was correctly built. *) + let print_42 printer = Test_interfaces.Int_printer.print printer 42 in + print_42 (Test_providers.Num_printer.make ()); [%expect {| 42 |}]; (* Now let's build a provider with an empty interface, that claims however to implement the [Int_printer] interface. *) @@ -21,7 +21,7 @@ let%expect_test "invalid tags" = ("Trait not implemented" (( trait_info ( (id #id) - (name - Provider_test__Interface__Int_printer.Provider_interface.Int_printer))))) |}]; + (name Test_interfaces.Int_printer.Provider_interface.Int_printer))))) + |}]; () ;; diff --git a/test/test__make_handler.ml b/test/test__make_handler.ml new file mode 100644 index 0000000..e12f2d5 --- /dev/null +++ b/test/test__make_handler.ml @@ -0,0 +1,79 @@ +(* This test is focused on the "make interface" functionality. We are testing + that different ways to create an interface -- using [make], [extend], [Trait. + implement], or the provider interface supplied maker -- all result in + equivalent interfaces. This ensures consistency across different methods of + interface creation. *) + +let%expect_test "int-printer" = + let printer = Test_providers.Int_printer.make () in + Test_interfaces.Int_printer.print printer 123_456_789; + [%expect {| 123456789 |}]; + () +;; + +let%expect_test "make interface" = + let binding1 = + Provider.Trait.implement + Test_interfaces.Int_printer.Provider_interface.Int_printer + ~impl:(module Test_providers.Num_printer.Impl) + in + Test_interfaces.Int_printer.print + (Provider.T { t = (); handler = Provider.Handler.make [ binding1 ] }) + 1234; + [%expect {| 1234 |}]; + let num1 = + Test_interfaces.Int_printer.Provider_interface.make + (module Test_providers.Num_printer.Impl) + in + Test_interfaces.Int_printer.print (Provider.T { t = (); handler = num1 }) 5678; + [%expect {| 5678 |}]; + (match binding1, List.hd_exn (Provider.Handler.bindings num1) with + | T t, T t' -> + require [%here] (Provider.Trait.same t.trait t'.trait); + [%expect {||}]; + ()); + let binding2 = + Provider.Trait.implement + Test_interfaces.Float_printer.Provider_interface.Float_printer + ~impl:(module Test_providers.Num_printer.Impl) + in + (match binding1, binding2 with + | T t1, T t2 -> + print_s + [%sexp + { trait1 = (Provider.Trait.info t1.trait : Provider.Trait.Info.t) + ; trait2 = (Provider.Trait.info t2.trait : Provider.Trait.Info.t) + }]; + [%expect + {| + ((trait1 ( + (id #id) (name Test_interfaces.Int_printer.Provider_interface.Int_printer))) + (trait2 ( + (id #id) + (name Test_interfaces.Float_printer.Provider_interface.Float_printer)))) + |}]; + require [%here] (not (Provider.Trait.same t1.trait t2.trait)); + [%expect {||}]; + ()); + (match Provider.Handler.bindings num1 with + | [ c1 ] -> + require_equal + [%here] + (module Provider.Trait.Uid) + (Provider.Binding.uid c1) + (Provider.Binding.uid binding1); + [%expect {||}] + | _ -> assert false); + let empty = Provider.Handler.make [] in + require [%here] (Provider.Handler.is_empty empty); + require [%here] (List.is_empty (Provider.Handler.bindings empty)); + let num2 = Provider.Handler.make [ binding2 ] in + require [%here] (not (Provider.Handler.is_empty num2)); + require [%here] (not (Provider.Private.Handler.same_trait_uids empty num2)); + [%expect {||}]; + let num3 = Provider.Handler.make [ binding1; binding2 ] in + let num4 = Provider.Handler.extend num1 ~with_:(Provider.Handler.bindings num2) in + require [%here] (Provider.Private.Handler.same_trait_uids num3 num4); + [%expect {||}]; + () +;; diff --git a/test/test__make_interface.mli b/test/test__make_handler.mli similarity index 100% rename from test/test__make_interface.mli rename to test/test__make_handler.mli diff --git a/test/test__make_interface.ml b/test/test__make_interface.ml deleted file mode 100644 index f8f887a..0000000 --- a/test/test__make_interface.ml +++ /dev/null @@ -1,66 +0,0 @@ -(* This test is focused on the "make interface" functionality. We are testing - that different ways to create an interface -- using [make], [extend], [Trait. - implement], or the provider interface supplied maker -- all result in - equivalent interfaces. This ensures consistency across different methods of - interface creation. *) - -let%expect_test "make interface" = - let trait1 = - Provider.Trait.implement - Interface.Directory_reader.Provider_interface.Directory_reader - ~impl:(module Providers.Eio_reader.Impl) - in - let eio1 = - Interface.Directory_reader.Provider_interface.make (module Providers.Eio_reader.Impl) - in - (match trait1, List.hd_exn (Provider.Handler.bindings eio1) with - | T t, T t' -> - require [%here] (Provider.Trait.same t.trait t'.trait); - [%expect {||}]; - ()); - let trait2 = - Provider.Trait.implement - Interface.File_reader.Provider_interface.File_reader - ~impl:(module Providers.Eio_reader.Impl) - in - (match trait1, trait2 with - | T t1, T t2 -> - print_s - [%sexp - { trait1 = (Provider.Trait.info t1.trait : Provider.Trait.Info.t) - ; trait2 = (Provider.Trait.info t2.trait : Provider.Trait.Info.t) - }]; - [%expect - {| - ((trait1 ( - (id #id) - (name - Provider_test__Interface__Directory_reader.Provider_interface.Directory_reader))) - (trait2 ( - (id #id) - (name Provider_test__Interface__File_reader.Provider_interface.File_reader)))) |}]; - require [%here] (not (Provider.Trait.same t1.trait t2.trait)); - [%expect {||}]; - ()); - (match Provider.Handler.bindings eio1 with - | [ c1 ] -> - require_equal - [%here] - (module Provider.Trait.Uid) - (Provider.Binding.uid c1) - (Provider.Binding.uid trait1); - [%expect {||}] - | _ -> assert false); - let empty = Provider.Handler.make [] in - require [%here] (Provider.Handler.is_empty empty); - require [%here] (List.is_empty (Provider.Handler.bindings empty)); - let eio2 = Provider.Handler.make [ trait2 ] in - require [%here] (not (Provider.Handler.is_empty eio2)); - require [%here] (not (Provider.Private.Handler.same_trait_uids empty eio2)); - [%expect {||}]; - let eio3 = Provider.Handler.make [ trait1; trait2 ] in - let eio4 = Provider.Handler.extend eio1 ~with_:(Provider.Handler.bindings eio2) in - require [%here] (Provider.Private.Handler.same_trait_uids eio3 eio4); - [%expect {||}]; - () -;; diff --git a/test/test__override.ml b/test/test__override.ml index 981cbdd..3e7c3e5 100644 --- a/test/test__override.ml +++ b/test/test__override.ml @@ -12,10 +12,10 @@ module Int_hum_printer = struct { t = () ; handler = Provider.Handler.extend - Providers.Num_printer.handler + Test_providers.Num_printer.handler ~with_: [ Provider.Trait.implement - Interface.Int_printer.Provider_interface.Int_printer + Test_interfaces.Int_printer.Provider_interface.Int_printer ~impl:(module Impl) ] } @@ -31,18 +31,17 @@ let%expect_test "override" = print_s [%sexp (info : Sexp.t list)] in let test printer = - Interface.Int_printer.print printer 1234; - Interface.Float_printer.print printer 1234.5678 + Test_interfaces.Int_printer.print printer 1234; + Test_interfaces.Float_printer.print printer 1234.5678 in - let num_printer = Providers.Num_printer.make () in + let num_printer = Test_providers.Num_printer.make () in print_implemented_traits num_printer; [%expect {| - (((id #id) - (name - Provider_test__Interface__Float_printer.Provider_interface.Float_printer)) - ((id #id) - (name Provider_test__Interface__Int_printer.Provider_interface.Int_printer))) |}]; + (((id #id) (name Test_interfaces.Int_printer.Provider_interface.Int_printer)) + ((id #id) + (name Test_interfaces.Float_printer.Provider_interface.Float_printer))) + |}]; test num_printer; [%expect {| 1234 @@ -51,11 +50,10 @@ let%expect_test "override" = print_implemented_traits hum_printer; [%expect {| - (((id #id) - (name - Provider_test__Interface__Float_printer.Provider_interface.Float_printer)) - ((id #id) - (name Provider_test__Interface__Int_printer.Provider_interface.Int_printer))) |}]; + (((id #id) (name Test_interfaces.Int_printer.Provider_interface.Int_printer)) + ((id #id) + (name Test_interfaces.Float_printer.Provider_interface.Float_printer))) + |}]; test hum_printer; (* Now there's an additional underscore separator in '1_234'. *) [%expect {| diff --git a/test/interface/directory_reader.ml b/test/test_interfaces/directory_reader.ml similarity index 100% rename from test/interface/directory_reader.ml rename to test/test_interfaces/directory_reader.ml diff --git a/test/interface/directory_reader.mli b/test/test_interfaces/directory_reader.mli similarity index 100% rename from test/interface/directory_reader.mli rename to test/test_interfaces/directory_reader.mli diff --git a/test/test_interfaces/dune b/test/test_interfaces/dune new file mode 100644 index 0000000..070bfc7 --- /dev/null +++ b/test/test_interfaces/dune @@ -0,0 +1,30 @@ +(library + (name test_interfaces) + (public_name provider-tests.test_interfaces) + (inline_tests) + (flags + :standard + -w + +a-4-40-41-42-44-45-48-66 + -warn-error + +a + -open + Base + -open + Expect_test_helpers_base) + (libraries base expect_test_helpers_core.expect_test_helpers_base provider) + (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/test/interface/file_reader.ml b/test/test_interfaces/file_reader.ml similarity index 100% rename from test/interface/file_reader.ml rename to test/test_interfaces/file_reader.ml diff --git a/test/interface/file_reader.mli b/test/test_interfaces/file_reader.mli similarity index 100% rename from test/interface/file_reader.mli rename to test/test_interfaces/file_reader.mli diff --git a/test/interface/float_printer.ml b/test/test_interfaces/float_printer.ml similarity index 100% rename from test/interface/float_printer.ml rename to test/test_interfaces/float_printer.ml diff --git a/test/interface/float_printer.mli b/test/test_interfaces/float_printer.mli similarity index 100% rename from test/interface/float_printer.mli rename to test/test_interfaces/float_printer.mli diff --git a/test/interface/int_printer.ml b/test/test_interfaces/int_printer.ml similarity index 100% rename from test/interface/int_printer.ml rename to test/test_interfaces/int_printer.ml diff --git a/test/interface/int_printer.mli b/test/test_interfaces/int_printer.mli similarity index 100% rename from test/interface/int_printer.mli rename to test/test_interfaces/int_printer.mli diff --git a/test/test_providers/dune b/test/test_providers/dune new file mode 100644 index 0000000..182efd2 --- /dev/null +++ b/test/test_providers/dune @@ -0,0 +1,35 @@ +(library + (name test_providers) + (public_name provider-tests.test_providers) + (inline_tests) + (flags + :standard + -w + +a-4-40-41-42-44-45-48-66 + -warn-error + +a + -open + Base + -open + Expect_test_helpers_base) + (libraries + base + expect_test_helpers_core.expect_test_helpers_base + test_interfaces + provider + unix) + (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/test/test_providers/int_printer.ml b/test/test_providers/int_printer.ml new file mode 100644 index 0000000..a805ea6 --- /dev/null +++ b/test/test_providers/int_printer.ml @@ -0,0 +1,17 @@ +module Impl = struct + type t = unit + + let string_of_int () i = Int.to_string i +end + +include Impl + +let handler : (unit, [ `Int_printer ]) Provider.Handler.t = + Provider.Handler.make + (List.concat + [ Test_interfaces.Int_printer.Provider_interface.make (module Impl) + |> Provider.Handler.bindings + ]) +;; + +let make () : [ `Int_printer ] Provider.t = Provider.T { t = (); handler } diff --git a/test/test_providers/int_printer.mli b/test/test_providers/int_printer.mli new file mode 100644 index 0000000..10b66c2 --- /dev/null +++ b/test/test_providers/int_printer.mli @@ -0,0 +1,11 @@ +(** [Int_printer] is a provider for {!module:Test_interfaces.Int_printer}. + + The structure of this file is very similar to the [Eio_reader] module, thus + is not documented in details. Refer to {!Eio_reader} for more. + + We use it as an alternate to [Num_printer], which is able to print both + integers and floats to demonstrate cases involving sub typing. *) + +type t = unit + +val make : t -> Test_interfaces.Int_printer.tag Provider.t diff --git a/test/providers/num_printer.ml b/test/test_providers/num_printer.ml similarity index 74% rename from test/providers/num_printer.ml rename to test/test_providers/num_printer.ml index 9e447e9..1996392 100644 --- a/test/providers/num_printer.ml +++ b/test/test_providers/num_printer.ml @@ -10,9 +10,9 @@ include Impl let handler : (unit, [ `Int_printer | `Float_printer ]) Provider.Handler.t = Provider.Handler.make (List.concat - [ Interface.Int_printer.Provider_interface.make (module Impl) + [ Test_interfaces.Int_printer.Provider_interface.make (module Impl) |> Provider.Handler.bindings - ; Interface.Float_printer.Provider_interface.make (module Impl) + ; Test_interfaces.Float_printer.Provider_interface.make (module Impl) |> Provider.Handler.bindings ]) ;; diff --git a/test/test_providers/num_printer.mli b/test/test_providers/num_printer.mli new file mode 100644 index 0000000..1b5df1c --- /dev/null +++ b/test/test_providers/num_printer.mli @@ -0,0 +1,31 @@ +(** [Num_printer] is a provider for the {!module:Test_interfaces.Int_printer} + and {!module:Test_interfaces.Float_printer} interfaces. + + The structure of this file is very similar to the [Eio_reader] module, thus + is not documented in details. Refer to {!Eio_reader} for more. *) + +(** In this case we decided to expose the type {!type:t} and {!val:handler}, to + demonstrate how to override a particular binding. See [test__override.ml]. *) +type t = unit + +val handler + : ( t + , [ Test_interfaces.Int_printer.tag | Test_interfaces.Float_printer.tag ] ) + Provider.Handler.t + +(** If you simply wish to use this provider without overrides, use [make ()]. *) +val make + : t + -> [ Test_interfaces.Int_printer.tag | Test_interfaces.Float_printer.tag ] Provider.t + +(** In this specific example, we chose to expose the signature of the provider's + implementation. This is not something that is usually required, since + {!make} already provides a way to build a provider. This is only done here + for the sake of the tests, as we show different ways an interface can be + built based on various parts of its implementation. *) +module Impl : sig + type nonrec t = t + + include Test_interfaces.Int_printer.Provider_interface.S with type t := t + include Test_interfaces.Float_printer.Provider_interface.S with type t := t +end diff --git a/test/providers/unix_reader.ml b/test/test_providers/unix_reader.ml similarity index 55% rename from test/providers/unix_reader.ml rename to test/test_providers/unix_reader.ml index a16da92..be9d21e 100644 --- a/test/providers/unix_reader.ml +++ b/test/test_providers/unix_reader.ml @@ -11,11 +11,6 @@ include Impl let make () : [ `Directory_reader ] Provider.t = Provider.T { t = () - ; handler = - Provider.Handler.make - [ Provider.Trait.implement - Interface.Directory_reader.Provider_interface.Directory_reader - ~impl:(module Impl) - ] + ; handler = Test_interfaces.Directory_reader.Provider_interface.make (module Impl) } ;; diff --git a/test/providers/unix_reader.mli b/test/test_providers/unix_reader.mli similarity index 58% rename from test/providers/unix_reader.mli rename to test/test_providers/unix_reader.mli index 8006b10..bbb693b 100644 --- a/test/providers/unix_reader.mli +++ b/test/test_providers/unix_reader.mli @@ -1,13 +1,13 @@ -(** [Unix_reader] is a provider for the {!module:Interface.Directory_reader} - interface based on [Unix]. +(** [Unix_reader] is a provider for {!module:Test_interfaces.Directory_reader} + based on [Unix]. It is meant to demonstrate how to illustrate how multiple providers may be implemented the same interfaces. {!module:Eio_reader} is another provider - for the {!module:Interface.Directory_reader} interface. + for the {!module:Test_interfaces.Directory_reader} interface. The structure of this file is very similar to the [Eio_reader] module, thus is not documented in details. Refer to {!Eio_reader} for more. *) type t = unit -val make : t -> Interface.Directory_reader.tag Provider.t +val make : t -> Test_interfaces.Directory_reader.tag Provider.t