Errors on invalid configurations

Signed-off-by: Lucas Pluvinage <[email protected]>

src/lib.ml

@@ -1320,6 +1320,33 @@ module DB = struct
       | Hidden (_, _) -> assert false
       | Not_found -> assert false)
 
+  let extract_loc_from_variant_map vmap =
+    Variant.Map.choose vmap
+    |> Option.map
+         ~f:(fun (_, (loc, _)) -> loc)
+
+  let check_valid_external_variants
+        (libmap : resolve_result Lib_name.Map.t)
+        (variant_map : (Loc.t * Lib_name.t) Variant.Map.t Lib_name.Map.t) =
+    let do_the_check vlib variants =
+      let loc = extract_loc_from_variant_map variants in
+      match Lib_name.Map.find libmap vlib with
+      | None ->
+        Errors.fail_opt loc
+          "Virtual library %a hasn't been found in the project."
+          Lib_name.pp vlib
+      | Some (Found (lib : Lib_info.t)) when Option.is_none lib.virtual_ ->
+        Errors.fail_opt loc
+          "Library %a isn't a virtual library."
+          Lib_name.pp vlib
+      | Some (Redirect (None, best_name)) ->
+        Errors.fail_opt loc
+          "To declare variants you must use %a's public name,@ which is %a."
+          Lib_name.pp vlib Lib_name.pp best_name
+      | _ -> ()
+    in
+    Lib_name.Map.iteri variant_map ~f:do_the_check
+
   let create_from_library_stanzas ?parent ~lib_config lib_stanzas
         variants_stanzas =
     (* Lookup the local scope to find implementations*)
@@ -1342,18 +1369,18 @@ module DB = struct
       |> Lib_name.Map.of_list_multi
       |> Lib_name.Map.map ~f:Variant.Map.of_list
       |> Lib_name.Map.mapi ~f:(fun name x -> match x with
-      | Ok x -> x
-      | Error (variant, (loc1, impl1), (loc2, impl2)) ->
-        Errors.fail_opt None
-          "Error: Two implementations of %a have the same variant %a:\n\
-          - %a (%a)\n\
-          - %a (%a)\n"
-          Lib_name.pp name
-          Variant.pp variant
-          Lib_name.pp impl1
-          Loc.pp_file_colon_line loc1
-          Lib_name.pp impl2
-          Loc.pp_file_colon_line loc2
+        | Ok x -> x
+        | Error (variant, (loc1, impl1), (loc2, impl2)) ->
+          Errors.fail_opt None
+            "Error: Two implementations of %a have the same variant %a:\n\
+             - %a (%a)\n\
+             - %a (%a)\n"
+            Lib_name.pp name
+            Variant.pp variant
+            Lib_name.pp impl1
+            Loc.pp_file_colon_line loc1
+            Lib_name.pp impl2
+            Loc.pp_file_colon_line loc2
       )
     in
     let map =
@@ -1398,6 +1425,7 @@ module DB = struct
             (Loc.to_file_colon_line loc2)
     in
     check_valid_implementations map;
+    check_valid_external_variants map variant_map;
     create () ?parent
       ~resolve:(fun name ->
         Lib_name.Map.find map name

test/blackbox-tests/test-cases/variants-external-declaration-conflict/not-a-vlib-redirect/dune

@@ -0,0 +1,9 @@
+(library
+ (name libfoo)
+ (public_name another-name)
+)
+
+(external_variant
+  (virtual_library libfoo)
+  (variant somevariant)
+  (implementation impl1))

test/blackbox-tests/test-cases/variants-external-declaration-conflict/not-a-vlib-redirect/dune-project

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

test/blackbox-tests/test-cases/variants-external-declaration-conflict/not-a-vlib-redirect/libfoo.ml

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

test/blackbox-tests/test-cases/variants-external-declaration-conflict/not-a-vlib/dune

@@ -0,0 +1,8 @@
+(library
+ (name libfoo)
+)
+
+(external_variant
+  (virtual_library libfoo)
+  (variant somevariant)
+  (implementation impl1))

test/blackbox-tests/test-cases/variants-external-declaration-conflict/not-a-vlib/dune-project

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

test/blackbox-tests/test-cases/variants-external-declaration-conflict/not-a-vlib/libfoo.ml

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

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

@@ -24,3 +24,33 @@ implementation with the same variant.
   - impl1 (vlib/dune:6)
   [1]
 
+  $ dune build --root not-a-vlib
+  Entering directory 'not-a-vlib'
+  File "dune", line 5, characters 0-94:
+  5 | (external_variant
+  6 |   (virtual_library libfoo)
+  7 |   (variant somevariant)
+  8 |   (implementation impl1))
+  Error: Library libfoo isn't a virtual library.
+  [1]
+
+  $ dune build --root not-a-vlib-redirect
+  Entering directory 'not-a-vlib-redirect'
+  File "dune", line 6, characters 0-94:
+  6 | (external_variant
+  7 |   (virtual_library libfoo)
+  8 |   (variant somevariant)
+  9 |   (implementation impl1))
+  Error: To declare variants you must use libfoo's public name,
+  which is another-name.
+  [1]
+
+  $ dune build --root vlib-dont-exist
+  Entering directory 'vlib-dont-exist'
+  File "dune", line 1, characters 0-100:
+  1 | (external_variant
+  2 |   (virtual_library i-dont-exist)
+  3 |   (variant somevariant)
+  4 |   (implementation impl1))
+  Error: Virtual library i-dont-exist hasn't been found in the project.
+  [1]

test/blackbox-tests/test-cases/variants-external-declaration-conflict/vlib-dont-exist/dune

@@ -0,0 +1,4 @@
+(external_variant
+  (virtual_library i-dont-exist)
+  (variant somevariant)
+  (implementation impl1))

test/blackbox-tests/test-cases/variants-external-declaration-conflict/vlib-dont-exist/dune-project

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