Check user-written input of implementations

CHANGES.md

@@ -14,6 +14,9 @@
 1.11.0 (unreleased)
 -------------------
 
+- Check that selected implementations (either by variants or default
+  implementations) are indeed implementations. (#2328, @TheLortex, review by ?)
+
 - Don't reserve the `Ppx` toplevel module name for ppx rewriters (#2242, @diml)
 
 - Redesign of the library variant feature according to the #2134 proposal. The

src/lib.ml

@@ -141,6 +141,14 @@ module Error = struct
       [ Pp.text "No solution found for this select form."
       ]
 
+
+  let not_an_implementation_of ~vlib ~impl =
+    make
+      [ Pp.textf "%S is not an implementation of %S."
+          (Lib_name.to_string (Lib_info.name impl))
+          (Lib_name.to_string (Lib_info.name vlib))
+      ]
+
   let dependency_cycle cycle =
     make
       [ Pp.text "Dependency cycle detected between the following libraries:"
@@ -891,16 +899,23 @@ let rec instantiate db name info ~stack ~hidden =
               Variant.pp variant
               Lib_name.pp name)
   in
+  let actually_implements_vlib (lib : lib Or_exn.t) =
+    let* lib = lib in
+    let* vlib = Option.value ~default:(Error.not_an_implementation_of ~vlib:info ~impl:lib.info) lib.implements in
+    if Lib_name.equal vlib.name name
+    then Ok lib
+    else Error.not_an_implementation_of ~vlib:info ~impl:lib.info
+  in
   let default_implementation =
     Lib_info.default_implementation info
-    |> Option.map ~f:(fun l -> lazy (resolve l)) in
+    |> Option.map ~f:(fun l -> lazy (resolve l |> actually_implements_vlib)) in
   let resolved_implementations =
     Lib_info.virtual_ info
     |> Option.map ~f:(fun _ -> lazy (
       (* TODO this can be made even lazier as we don't need to resolve all
          variants at once *)
       Lib_info.known_implementations info
-      |> Variant.Map.map ~f:resolve))
+      |> Variant.Map.map ~f:(fun l -> resolve l |> actually_implements_vlib)))
   in
   let requires, pps, resolved_selects =
     let pps = Lib_info.pps info in

test/blackbox-tests/dune.inc

@@ -1490,6 +1490,16 @@
    test-cases/variants-only-package
    (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
+(alias
+ (name variants-wrong-external-declaration)
+ (deps
+  (package dune)
+  (source_tree test-cases/variants-wrong-external-declaration))
+ (action
+  (chdir
+   test-cases/variants-wrong-external-declaration
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+
 (alias
  (name vlib)
  (deps (package dune) (source_tree test-cases/vlib))
@@ -1506,6 +1516,14 @@
    test-cases/vlib-default-impl
    (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
+(alias
+ (name vlib-wrong-default-impl)
+ (deps (package dune) (source_tree test-cases/vlib-wrong-default-impl))
+ (action
+  (chdir
+   test-cases/vlib-wrong-default-impl
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+
 (alias
  (name windows-diff)
  (deps (package dune) (source_tree test-cases/windows-diff))
@@ -1721,8 +1739,10 @@
   (alias variants-external-declaration-conflict)
   (alias variants-multi-project)
   (alias variants-only-package)
+  (alias variants-wrong-external-declaration)
   (alias vlib)
   (alias vlib-default-impl)
+  (alias vlib-wrong-default-impl)
   (alias windows-diff)
   (alias workspaces)
   (alias wrapped-false-main-module-name)
@@ -1885,8 +1905,10 @@
   (alias variants-external-declaration-conflict)
   (alias variants-multi-project)
   (alias variants-only-package)
+  (alias variants-wrong-external-declaration)
   (alias vlib)
   (alias vlib-default-impl)
+  (alias vlib-wrong-default-impl)
   (alias windows-diff)
   (alias workspaces)
   (alias wrapped-false-main-module-name)

test/blackbox-tests/test-cases/variants-wrong-external-declaration/exe/dune

@@ -0,0 +1,4 @@
+(executable
+ (name exe)
+ (libraries vlibfoo-ext)
+ (variants somevariant))

test/blackbox-tests/test-cases/variants-wrong-external-declaration/exe/dune-project

@@ -0,0 +1,2 @@
+(lang dune 1.10)
+(using library_variants 0.1)

test/blackbox-tests/test-cases/variants-wrong-external-declaration/exe/exe.ml

@@ -0,0 +1 @@
+let () = Vlibfoo.implme ()

test/blackbox-tests/test-cases/variants-wrong-external-declaration/prj1/dune

@@ -0,0 +1,10 @@
+(library
+ (name vlibfoo)
+ (public_name vlibfoo-ext)
+ (virtual_modules vlibfoo)
+)
+
+(external_variant
+  (virtual_library vlibfoo)
+  (variant somevariant)
+  (implementation not-an-implementation))

test/blackbox-tests/test-cases/variants-wrong-external-declaration/prj1/dune-project

@@ -0,0 +1,2 @@
+(lang dune 1.10)
+(using library_variants 0.2)

test/blackbox-tests/test-cases/variants-wrong-external-declaration/prj1/vlibfoo.mli

@@ -0,0 +1 @@
+val implme : unit -> unit

test/blackbox-tests/test-cases/variants-wrong-external-declaration/prj2/bar.ml

@@ -0,0 +1 @@
+let implme () = print_endline "foobar"

test/blackbox-tests/test-cases/variants-wrong-external-declaration/prj2/dune

@@ -0,0 +1,4 @@
+(library
+ (name not_an_implementation)
+ (public_name not-an-implementation)
+)

test/blackbox-tests/test-cases/variants-wrong-external-declaration/prj2/dune-project

@@ -0,0 +1,2 @@
+(lang dune 1.10)
+(using library_variants 0.1)

test/blackbox-tests/test-cases/variants-wrong-external-declaration/run.t

@@ -0,0 +1,7 @@
+External declaration of an implementation, when the given library is not an
+implementation, should fail.
+
+  $ dune build exe/exe.exe
+  Error: "not-an-implementation" is not an implementation of "vlibfoo-ext".
+  -> required by executable exe in exe/dune:2
+  [1]

test/blackbox-tests/test-cases/vlib-wrong-default-impl/dune-project

@@ -0,0 +1,2 @@
+(lang dune 1.10)
+(using library_variants 0.1)

test/blackbox-tests/test-cases/vlib-wrong-default-impl/exe/dune

@@ -0,0 +1,9 @@
+(executable
+ (name exe)
+ (libraries vlibfoo)
+)
+
+(alias
+ (name default)
+ (action
+  (run ./exe.exe)))

test/blackbox-tests/test-cases/vlib-wrong-default-impl/exe/exe.ml

@@ -0,0 +1 @@
+let () = Vlibfoo.implme ()

test/blackbox-tests/test-cases/vlib-wrong-default-impl/implfoo/bar.ml

@@ -0,0 +1 @@
+let implme () = ()

test/blackbox-tests/test-cases/vlib-wrong-default-impl/implfoo/dune

@@ -0,0 +1,3 @@
+(library
+ (name not_an_implem)
+)

test/blackbox-tests/test-cases/vlib-wrong-default-impl/run.t

@@ -0,0 +1,7 @@
+Check that dune makes a proper error if the default implementation of a virtual
+library is not actually an implementation of the virtual library.
+
+  $ dune build @default
+  Error: "not_an_implem" is not an implementation of "vlibfoo".
+  -> required by executable exe in exe/dune:2
+  [1]

test/blackbox-tests/test-cases/vlib-wrong-default-impl/vlibfoo/dune

@@ -0,0 +1,5 @@
+(library
+ (name vlibfoo)
+ (virtual_modules vlibfoo)
+ (default_implementation not_an_implem)
+)

test/blackbox-tests/test-cases/vlib-wrong-default-impl/vlibfoo/vlibfoo.mli

@@ -0,0 +1 @@
+val implme : unit -> unit