Stricter validation of select filenames.

Now any filenames that appears in the choice position, must now be
based on the filename of the result.

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>

CHANGES.md

@@ -190,6 +190,10 @@
 - Allow `ccomp_type` as a variable for evaluating `enabled_if`. (#2855, @dra27,
   @rgrinberg)
 
+- Stricter validation of file names in `select`. The file names of conditional
+  sources must match the prefix and the extension of the resultant filename.
+  (#2867, @rgrinberg)
+
 1.11.4 (09/10/2019)
 -------------------
 

src/dune/lib_dep.ml

@@ -8,10 +8,11 @@ module Select = struct
       ; file : string
       }
 
-    let decode =
+    let decode ~result_fn =
       let open Dune_lang.Decoder in
       enter
-        (let+ loc = loc
+        (let* dune_version = Dune_lang.Syntax.get_exn Stanza.syntax in
+         let+ loc = loc
          and+ preds, file =
            until_keyword "->"
              ~before:
@@ -21,13 +22,29 @@ module Select = struct
                 match String.drop_prefix s ~prefix:"!" with
                 | Some s -> Right (Lib_name.of_string_exn ~loc s)
                 | None -> Left (Lib_name.of_string_exn ~loc s))
-             ~after:filename
+             ~after:(located filename)
          in
          match file with
          | None ->
            User_error.raise ~loc
              [ Pp.textf "(<[!]libraries>... -> <file>) expected" ]
-         | Some file ->
+         | Some (loc_file, file) ->
+           let () =
+             if dune_version >= (2, 0) then
+               let prefix, suffix =
+                 let name, ext = Filename.split_extension result_fn in
+                 let prefix = name ^ "." in
+                 (prefix, ext)
+               in
+               if not (String.is_prefix file ~prefix && String.is_suffix file ~suffix)
+               then
+                 User_error.raise ~loc:loc_file
+                   [ Pp.textf
+                       "The format for files in this select branch must be \
+                        %s{name}%s"
+                       prefix suffix
+                   ]
+           in
            let rec loop required forbidden = function
              | [] ->
                let common = Lib_name.Set.inter required forbidden in
@@ -68,10 +85,10 @@ module Select = struct
 
   let decode =
     let open Dune_lang.Decoder in
-    let+ result_fn = filename
-    and+ loc = loc
+    let* result_fn = filename in
+    let+ loc = loc
     and+ () = keyword "from"
-    and+ choices = repeat Choice.decode in
+    and+ choices = repeat (Choice.decode ~result_fn) in
     { result_fn; choices; loc }
 end
 

test/blackbox-tests/dune.inc

@@ -1566,6 +1566,14 @@
    test-cases/select
    (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
+(rule
+ (alias select-2-0-rules)
+ (deps (package dune) (source_tree test-cases/select-2-0-rules))
+ (action
+  (chdir
+   test-cases/select-2-0-rules
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+
 (rule
  (alias several-packages)
  (deps (package dune) (source_tree test-cases/several-packages))
@@ -2100,6 +2108,7 @@
   (alias scope-bug)
   (alias scope-ppx-bug)
   (alias select)
+  (alias select-2-0-rules)
   (alias several-packages)
   (alias shadow-bindings)
   (alias stale-artifact-removal)
@@ -2305,6 +2314,7 @@
   (alias sandboxing)
   (alias scope-bug)
   (alias select)
+  (alias select-2-0-rules)
   (alias several-packages)
   (alias shadow-bindings)
   (alias stale-artifact-removal)

test/blackbox-tests/test-cases/select-2-0-rules/run.t

@@ -0,0 +1,19 @@
+  $ echo "(lang dune 2.0)" > dune-project
+  $ cat > dune <<EOF
+  > (library (name foo) (libraries (select foo.ml from (!bar -> f.ml))))
+  > EOF
+  $ dune build
+  File "dune", line 1, characters 60-64:
+  1 | (library (name foo) (libraries (select foo.ml from (!bar -> f.ml))))
+                                                                  ^^^^
+  Error: The format for files in this select branch must be foo.{name}.ml
+  [1]
+  $ cat > dune <<EOF
+  > (library (name foo) (libraries (select foo.ml from (!bar -> foo.mli))))
+  > EOF
+  $ dune build
+  File "dune", line 1, characters 60-67:
+  1 | (library (name foo) (libraries (select foo.ml from (!bar -> foo.mli))))
+                                                                  ^^^^^^^
+  Error: The format for files in this select branch must be foo.{name}.ml
+  [1]

test/blackbox-tests/test-cases/select/run.t

@@ -4,11 +4,11 @@
   >  (name main)
   >  (libraries
   >   (select bar.ml from
-  >    (unix -> bar_unix.ml)
-  >    (!unix -> bar_no_unix.ml))
+  >    (unix -> bar.unix.ml)
+  >    (!unix -> bar.no_unix.ml))
   >   (select foo.ml from
-  >    (fakefoobar -> foo_fake.ml)
-  >    (!fakefoobar -> foo_no_fake.ml))))
+  >    (fakefoobar -> foo.fake.ml)
+  >    (!fakefoobar -> foo.no_fake.ml))))
   > (alias
   >  (name runtest)
   >  (action (run ./main.exe)))
@@ -35,11 +35,11 @@
   >  (name main)
   >  (libraries
   >   (select bar.ml from
-  >    (unix -> bar_unix.ml)
-  >    (!unix -> bar_no_unix.ml))
+  >    (unix -> bar.unix.ml)
+  >    (!unix -> bar.no_unix.ml))
   >   (select foo.ml from
-  >    (fakefoobar -> foo_fake.ml)
-  >    (!fakefoobar -> foo_no_fake.ml))))
+  >    (fakefoobar -> foo.fake.ml)
+  >    (!fakefoobar -> foo.no_fake.ml))))
   > (rule
   >  (alias runtest)
   >  (action (run ./main.exe)))