From eab7c46bdba965aaa20c595d3a5a3ed24cae6755 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 5 Jun 2018 11:25:12 +0700 Subject: [PATCH] Add flag to allow/disallow multivalue expansions Signed-off-by: Rudi Grinberg --- src/action.ml | 16 ++++++++++---- src/string_with_vars.ml | 22 +++++++++++++------- src/string_with_vars.mli | 14 +++++++++---- test/blackbox-tests/test-cases/misc/run.t | 5 ++++- test/blackbox-tests/test-cases/quoting/run.t | 3 +++ 5 files changed, 43 insertions(+), 17 deletions(-) diff --git a/src/action.ml b/src/action.ml index 8ab14e38..e5cf7a8e 100644 --- a/src/action.ml +++ b/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 diff --git a/src/string_with_vars.ml b/src/string_with_vars.ml index 61a1f86c..19e2a2fb 100644 --- a/src/string_with_vars.ml +++ b/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 diff --git a/src/string_with_vars.mli b/src/string_with_vars.mli index 89e4fd95..0b0e0451 100644 --- a/src/string_with_vars.mli +++ b/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. *) diff --git a/test/blackbox-tests/test-cases/misc/run.t b/test/blackbox-tests/test-cases/misc/run.t index 514d25e7..fffc64b1 100644 --- a/test/blackbox-tests/test-cases/misc/run.t +++ b/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] diff --git a/test/blackbox-tests/test-cases/quoting/run.t b/test/blackbox-tests/test-cases/quoting/run.t index 97f216ee..17015512 100644 --- a/test/blackbox-tests/test-cases/quoting/run.t +++ b/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