Add flag to allow/disallow multivalue expansions

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>

src/action.ml

@@ -354,34 +354,38 @@ module Unexpanded = struct
     include Past
 
     module E = struct
-      let expand ~generic ~special ~map ~dir ~f = function
+      let expand ~generic ~special ~map ~dir ~allow_multivalue ~f = function
         | Left x -> map x
         | Right template ->
-           match To_VE.expand dir template ~f with
+           match To_VE.expand dir template ~f ~allow_multivalue with
            | Expansion e -> special dir e
            | String    s -> generic dir s
       [@@inlined always]
 
       let string ~dir ~f x =
         expand ~dir ~f x
+          ~allow_multivalue:false
           ~generic:(fun _dir x -> x)
           ~special:VE.to_string
           ~map:(fun x -> x)
 
       let strings ~dir ~f x =
         expand ~dir ~f x
+          ~allow_multivalue:true
           ~generic:(fun _dir x -> [x])
           ~special:VE.to_strings
           ~map:(fun x -> [x])
 
       let path ~dir ~f x =
         expand ~dir ~f x
+          ~allow_multivalue:false
           ~generic:VE.path_of_string
           ~special:VE.to_path
           ~map:(fun x -> x)
 
       let prog_and_args ~dir ~f x =
         expand ~dir ~f x
+          ~allow_multivalue:true
           ~generic:(fun _dir s -> (Program.of_string ~dir s, []))
           ~special:VE.to_prog_and_args
           ~map:(fun x -> (x, []))
@@ -447,29 +451,33 @@ module Unexpanded = struct
   end
 
   module E = struct
-    let expand ~generic ~special ~dir ~f template =
-      match To_VE.partial_expand dir template ~f with
+    let expand ~generic ~special ~dir ~allow_multivalue ~f template =
+      match To_VE.partial_expand dir template ~allow_multivalue ~f with
       | Expansion e -> Left (special dir e)
       | String s -> Left (generic dir s)
       | Unexpanded x -> Right x
 
     let string ~dir ~f x =
       expand ~dir ~f x
+        ~allow_multivalue:false
         ~generic:(fun _dir x -> x)
         ~special:VE.to_string
 
     let strings ~dir ~f x =
       expand ~dir ~f x
+        ~allow_multivalue:true
         ~generic:(fun _dir x -> [x])
         ~special:VE.to_strings
 
     let path ~dir ~f x =
       expand ~dir ~f x
+        ~allow_multivalue:false
         ~generic:VE.path_of_string
         ~special:VE.to_path
 
     let prog_and_args ~dir ~f x =
       expand ~dir ~f x
+        ~allow_multivalue:true
         ~generic:(fun dir s -> (Unresolved.Program.of_string ~dir s, []))
         ~special:VE.to_prog_and_args
   end

src/string_with_vars.ml

@@ -137,15 +137,18 @@ module Expand_to(V: EXPANSION) = struct
     if not t.quoted && V.is_multivalued x then
       Loc.fail t.loc "Variable %s expands to %d values, \
                       however a single value is expected here. \
-                      Please quote this atom. "
+                      Please quote this atom."
         (string_of_var syntax var) (V.length x)
 
-  let expand ctx t ~f =
+  let expand ctx t ~allow_multivalue ~f =
     match t.items with
     | [Var (syntax, v)] when not t.quoted ->
       (* Unquoted single var *)
       (match f t.loc v with
-       | Some e -> Expand.Full.Expansion e
+       | Some e ->
+         if not allow_multivalue then
+           check_valid_multivalue syntax ~var:v t e;
+         Expand.Full.Expansion e
        | None -> Expand.Full.String (string_of_var syntax v))
     | _ ->
       Expand.Full.String (
@@ -159,7 +162,7 @@ module Expand_to(V: EXPANSION) = struct
             | None -> string_of_var syntax v)
         |> String.concat ~sep:"")
 
-  let partial_expand ctx t ~f =
+  let partial_expand ctx t ~allow_multivalue ~f =
     let commit_text acc_text acc =
       let s = concat_rev acc_text in
       if s = "" then acc else Text s :: acc
@@ -180,10 +183,13 @@ module Expand_to(V: EXPANSION) = struct
           loop (V.to_string ctx x :: acc_text) acc items
     in
     match t.items with
-    | [Var (_, v)] when not t.quoted ->
+    | [Var (syntax, v)] when not t.quoted ->
       (* Unquoted single var *)
       (match f t.loc v with
-       | Some e -> Expand.Partial.Expansion e
+       | Some e ->
+         if not allow_multivalue then
+           check_valid_multivalue syntax ~var:v t e;
+         Expand.Partial.Expansion e
        | None   -> Expand.Partial.Unexpanded t)
     | _ -> loop [] [] t.items
 end
@@ -199,12 +205,12 @@ end
 module S = Expand_to(String_expansion)
 
 let expand t ~f =
-  match S.expand () t ~f with
+  match S.expand () t ~allow_multivalue:true ~f with
   | Expand.Full.String s
   | Expansion s -> s
 
 let partial_expand t ~f =
-  match S.partial_expand () t ~f with
+  match S.partial_expand () t ~allow_multivalue:true ~f with
   | Expand.Partial.Expansion s -> Left s
   | String s -> Left s
   | Unexpanded s -> Right s

src/string_with_vars.mli

@@ -83,6 +83,7 @@ module Expand_to(V : EXPANSION) : sig
   val expand
     :  V.context
     -> t
+    -> allow_multivalue:bool
     -> f:(Loc.t -> string -> V.t option)
     -> V.t Expand.Full.t
   (** [expand t ~f] return [t] where all variables have been expanded
@@ -93,6 +94,7 @@ module Expand_to(V : EXPANSION) : sig
   val partial_expand
     :  V.context
     -> t
+    -> allow_multivalue:bool
     -> f:(Loc.t -> string -> V.t option)
     -> V.t Expand.Partial.t
     (** [partial_expand t ~f] is like [expand_generic] where all
@@ -102,12 +104,16 @@ module Expand_to(V : EXPANSION) : sig
         least a variable of [t], it returns a string-with-vars. *)
 end
 
-val expand :
-  t -> f:(Loc.t -> string -> string option) -> string
+val expand
+  :  t
+  -> f:(Loc.t -> string -> string option)
+  -> string
 (** Specialized version [Expand_to.expand] that returns a string (so
     variables are assumed to expand to a single value). *)
 
-val partial_expand :
-  t -> f:(Loc.t -> string -> string option) -> (string, t) Either.t
+val partial_expand
+  :  t
+  -> f:(Loc.t -> string -> string option)
+  -> (string, t) Either.t
 (** [partial_expand] is a specialized version of
     [Expand_to.partial_expand] that returns a string. *)

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

@@ -2,6 +2,9 @@
   File "dune", line 65, characters 21-44:
   Warning: Directory dir-that-doesnt-exist doesn't exist.
   No rule found for jbuild
-          diff alias runtest
+  File "dune", line 9, characters 43-47:
+  Error: Variable ${^} expands to 4 values, however a single value is expected here. Please quote this atom.
+  File "dune", line 16, characters 44-48:
+  Error: Variable ${^} expands to 2 values, however a single value is expected here. Please quote this atom.
           diff alias runtest
   [1]

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

@@ -8,6 +8,9 @@ that ${@} is not quoted and doesn't contain exactly 1 element
   - y
   [1]
 
+  $ dune build --root bad x
+  File "dune", line 3, characters 26-30:
+  Error: Variable ${@} expands to 2 values, however a single value is expected here. Please quote this atom.
 
 The targets should only be interpreted as a single path when quoted