From 69c0ab48ce608375185447f78b7bb53fa00212bc Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Mon, 4 Jun 2018 18:24:03 +0700 Subject: [PATCH 01/23] Add test for concat_or_split Signed-off-by: Rudi Grinberg --- .../test-cases/quoting/quote-from-context/args | 3 +++ .../test-cases/quoting/quote-from-context/count_args.ml | 3 +++ .../test-cases/quoting/quote-from-context/dune | 6 ++++++ test/blackbox-tests/test-cases/quoting/run.t | 5 +++++ 4 files changed, 17 insertions(+) create mode 100644 test/blackbox-tests/test-cases/quoting/quote-from-context/args create mode 100644 test/blackbox-tests/test-cases/quoting/quote-from-context/count_args.ml create mode 100644 test/blackbox-tests/test-cases/quoting/quote-from-context/dune diff --git a/test/blackbox-tests/test-cases/quoting/quote-from-context/args b/test/blackbox-tests/test-cases/quoting/quote-from-context/args new file mode 100644 index 00000000..98a86f9e --- /dev/null +++ b/test/blackbox-tests/test-cases/quoting/quote-from-context/args @@ -0,0 +1,3 @@ +foo +bar +baz \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/quoting/quote-from-context/count_args.ml b/test/blackbox-tests/test-cases/quoting/quote-from-context/count_args.ml new file mode 100644 index 00000000..5fe897f2 --- /dev/null +++ b/test/blackbox-tests/test-cases/quoting/quote-from-context/count_args.ml @@ -0,0 +1,3 @@ + +let () = + Printf.printf "Number of args: %d\n" (Array.length Sys.argv - 1) diff --git a/test/blackbox-tests/test-cases/quoting/quote-from-context/dune b/test/blackbox-tests/test-cases/quoting/quote-from-context/dune new file mode 100644 index 00000000..319474cb --- /dev/null +++ b/test/blackbox-tests/test-cases/quoting/quote-from-context/dune @@ -0,0 +1,6 @@ +(executable + ((name count_args))) + +(alias + ((name runtest) + (action (run ./count_args.exe ${read-lines:args})))) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/quoting/run.t b/test/blackbox-tests/test-cases/quoting/run.t index d1f6f44a..97f216ee 100644 --- a/test/blackbox-tests/test-cases/quoting/run.t +++ b/test/blackbox-tests/test-cases/quoting/run.t @@ -17,3 +17,8 @@ The targets should only be interpreted as a single path when quoted - s - t [1] + + $ dune runtest --root quote-from-context + Entering directory 'quote-from-context' + count_args alias runtest + Number of args: 3 From c1d6faef79c7021810525fe4fa89746b5e9b3fbd Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Mon, 4 Jun 2018 17:35:49 +0700 Subject: [PATCH 02/23] Remove Concat_or_split Thie property will now be determined from the context Signed-off-by: Rudi Grinberg --- src/action.ml | 50 +++++++++++++------------------------------- src/action.mli | 10 ++------- src/inline_tests.ml | 5 ++--- src/super_context.ml | 36 +++++++++++++++---------------- 4 files changed, 37 insertions(+), 64 deletions(-) diff --git a/src/action.ml b/src/action.ml index e21fcb30..b6021fff 100644 --- a/src/action.ml +++ b/src/action.ml @@ -271,21 +271,14 @@ module Unresolved = struct end module Var_expansion = struct - module Concat_or_split = struct - type t = - | Concat (* default *) - | Split (* the variable is a "split" list of items *) - end - - open Concat_or_split - type t = - | Paths of Path.t list * Concat_or_split.t - | Strings of string list * Concat_or_split.t + | Paths of Path.t list + | Strings of string list let is_multivalued = function - | Paths (_, Split) | Strings (_, Split) -> true - | Paths (_, Concat) | Strings (_, Concat) -> false + | Paths [_] -> false + | Strings [_] -> false + | _ -> false type context = Path.t (* For String_with_vars.Expand_to *) @@ -297,38 +290,25 @@ module Var_expansion = struct let path_of_string dir s = Path.relative dir s let to_strings dir = function - | Strings (l, Split ) -> l - | Strings (l, Concat) -> [concat l] - | Paths (l, Split ) -> List.map l ~f:(string_of_path ~dir) - | Paths (l, Concat) -> [concat (List.map l ~f:(string_of_path ~dir))] + | Strings l -> l + | Paths l -> List.map l ~f:(string_of_path ~dir) let to_string (dir: context) = function - | Strings (l, _) -> concat l - | Paths (l, _) -> concat (List.map l ~f:(string_of_path ~dir)) + | Strings l -> concat l + | Paths l -> concat (List.map l ~f:(string_of_path ~dir)) let to_path dir = function - | Strings (l, _) -> path_of_string dir (concat l) - | Paths ([p], _) -> p - | Paths (l, _) -> + | Strings l -> path_of_string dir (concat l) + | Paths [p] -> p + | Paths l -> path_of_string dir (concat (List.map l ~f:(string_of_path ~dir))) let to_prog_and_args dir exp : Unresolved.Program.t * string list = let module P = Unresolved.Program in match exp with - | Paths ([p], _) -> (This p, []) - | Strings ([s], _) -> (P.of_string ~dir s, []) - | Paths ([], _) | Strings ([], _) -> (Search "", []) - | Paths (l, Concat) -> - (This - (path_of_string dir - (concat (List.map l ~f:(string_of_path ~dir)))), - []) - | Strings (l, Concat) -> - (P.of_string ~dir (concat l), l) - | Paths (p :: l, Split) -> - (This p, List.map l ~f:(string_of_path ~dir)) - | Strings (s :: l, Split) -> - (P.of_string ~dir s, l) + | Paths (x::xs) -> (This x, to_strings dir (Paths xs)) + | Strings (s::xs) -> (P.of_string ~dir s, to_strings dir (Strings xs)) + | Paths [] | Strings [] -> (Search "", []) end module VE = Var_expansion diff --git a/src/action.mli b/src/action.mli index 484debf3..89e0a91f 100644 --- a/src/action.mli +++ b/src/action.mli @@ -1,15 +1,9 @@ open! Import module Var_expansion : sig - module Concat_or_split : sig - type t = - | Concat (** default *) - | Split (** the variable is a "split" list of items *) - end - type t = - | Paths of Path.t list * Concat_or_split.t - | Strings of string list * Concat_or_split.t + | Paths of Path.t list + | Strings of string list val to_string : Path.t -> t -> string (** [to_string dir v] convert the variable expansion to a string. diff --git a/src/inline_tests.ml b/src/inline_tests.ml index df47cb84..120823a8 100644 --- a/src/inline_tests.ml +++ b/src/inline_tests.ml @@ -188,7 +188,7 @@ include Sub_system.Register_end_point( let extra_vars = String.Map.singleton "library-name" - (Action.Var_expansion.Strings ([lib.name], Concat)) + (Action.Var_expansion.Strings [lib.name]) in let runner_libs = @@ -212,8 +212,7 @@ include Sub_system.Register_end_point( let files ml_kind = Action.Var_expansion.Paths ( List.filter_map source_modules ~f:(fun m -> - Module.file m ~dir ml_kind), - Split) + Module.file m ~dir ml_kind)) in let extra_vars = List.fold_left diff --git a/src/super_context.ml b/src/super_context.ml index b9978d1a..68f26e31 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -273,15 +273,15 @@ let create let open Action.Var_expansion in let make = match Bin.make with - | None -> Strings (["make"], Split) - | Some p -> Paths ([p], Split) + | None -> Strings ["make"] + | Some p -> Paths [p] in let cflags = context.ocamlc_cflags in - let strings l = Strings (l , Split) in - let string s = Strings ([s], Concat) in - let path p = Paths ([p], Split) in + let strings l = Strings l in + let string s = Strings [s] in + let path p = Paths [p] in let vars = - [ "-verbose" , Strings ([] (*"-verbose";*), Concat) + [ "-verbose" , Strings ([] (*"-verbose";*)) ; "CPP" , strings (context.c_compiler :: cflags @ ["-E"]) ; "PA_CPP" , strings (context.c_compiler :: cflags @ ["-undef"; "-traditional"; @@ -602,8 +602,8 @@ module Action = struct acc.ddeps <- String.Map.add acc.ddeps key dep; None - let path_exp path = Action.Var_expansion.Paths ([path], Concat) - let str_exp path = Action.Var_expansion.Strings ([path], Concat) + let path_exp path = Action.Var_expansion.Paths [path] + let str_exp path = Action.Var_expansion.Strings [path] let map_exe sctx = match sctx.host with @@ -683,8 +683,8 @@ module Action = struct | Some p -> let x = Pkg_version.read sctx p >>^ function - | None -> Strings ([""], Concat) - | Some s -> Strings ([s], Concat) + | None -> Strings [""] + | Some s -> Strings [s] in add_ddep acc ~key x | None -> @@ -696,7 +696,7 @@ module Action = struct let path = Path.relative dir s in let data = Build.contents path - >>^ fun s -> Strings ([s], Concat) + >>^ fun s -> Strings [s] in add_ddep acc ~key data end @@ -704,7 +704,7 @@ module Action = struct let path = Path.relative dir s in let data = Build.lines_of path - >>^ fun l -> Strings (l, Split) + >>^ fun l -> Strings l in add_ddep acc ~key data end @@ -712,7 +712,7 @@ module Action = struct let path = Path.relative dir s in let data = Build.strings path - >>^ fun l -> Strings (l, Split) + >>^ fun l -> Strings l in add_ddep acc ~key data end @@ -734,7 +734,7 @@ module Action = struct match targets_written_by_user with | Infer -> Loc.fail loc "You cannot use ${@} with inferred rules." | Alias -> Loc.fail loc "You cannot use ${@} in aliases." - | Static l -> Some (Paths (l, Split)) + | Static l -> Some (Paths l) end | _ -> match String.lsplit2 var ~on:':' with @@ -743,7 +743,7 @@ module Action = struct | x -> let exp = expand loc key var x in (match exp with - | Some (Paths (ps, _)) -> + | Some (Paths ps) -> acc.sdeps <- Path.Set.union (Path.Set.of_list ps) acc.sdeps | _ -> ()); exp) @@ -764,10 +764,10 @@ module Action = struct | [] -> Loc.warn loc "Variable '<' used with no explicit \ dependencies@."; - Strings ([""], Concat) + Strings [""] | dep :: _ -> - Paths ([dep], Concat)) - | "^" -> Some (Paths (deps_written_by_user, Split)) + Paths [dep]) + | "^" -> Some (Paths deps_written_by_user) | _ -> None) let run sctx ~loc ?(extra_vars=String.Map.empty) From bb58cf859910fb977c8e1cfcbd1241b66a99be9f Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Mon, 4 Jun 2018 21:28:30 +0700 Subject: [PATCH 03/23] s/false/true/ Signed-off-by: Rudi Grinberg --- src/action.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/action.ml b/src/action.ml index b6021fff..c8b5f49b 100644 --- a/src/action.ml +++ b/src/action.ml @@ -278,7 +278,7 @@ module Var_expansion = struct let is_multivalued = function | Paths [_] -> false | Strings [_] -> false - | _ -> false + | _ -> true type context = Path.t (* For String_with_vars.Expand_to *) From 8351fcb4669096d86e5bc77821e60eb2f9e906e7 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Mon, 4 Jun 2018 21:37:02 +0700 Subject: [PATCH 04/23] Move the multivalue error to a function Since it's used more than once Signed-off-by: Rudi Grinberg --- src/string_with_vars.ml | 34 ++++++++++++++++++---------------- 1 file changed, 18 insertions(+), 16 deletions(-) diff --git a/src/string_with_vars.ml b/src/string_with_vars.ml index 605bb458..d4b91a34 100644 --- a/src/string_with_vars.ml +++ b/src/string_with_vars.ml @@ -132,6 +132,12 @@ end module Expand_to(V: EXPANSION) = struct + let check_valid_multivalue syntax ~var t ctx = + if not t.quoted && V.is_multivalued ctx then + Loc.fail t.loc "please quote the string \ + containing the list variable %s" + (string_of_var syntax var) + let expand ctx t ~f = match t.items with | [Var (syntax, v)] when not t.quoted -> @@ -140,18 +146,16 @@ module Expand_to(V: EXPANSION) = struct | Some e -> Expand.Full.Expansion e | None -> Expand.Full.String (string_of_var syntax v)) | _ -> - Expand.Full.String (List.map t.items ~f:(function - | Text s -> s - | Var (syntax, v) -> - match f t.loc v with - | Some x -> - if not t.quoted && V.is_multivalued x then - Loc.fail t.loc "please quote the string \ - containing the list variable %s" - (string_of_var syntax v) - else V.to_string ctx x - | None -> string_of_var syntax v) - |> String.concat ~sep:"") + Expand.Full.String ( + List.map t.items ~f:(function + | Text s -> s + | Var (syntax, v) -> + match f t.loc v with + | Some x -> + check_valid_multivalue syntax ~var:v t x; + V.to_string ctx x + | None -> string_of_var syntax v) + |> String.concat ~sep:"") let partial_expand ctx t ~f = let commit_text acc_text acc = @@ -170,10 +174,8 @@ module Expand_to(V: EXPANSION) = struct match f t.loc v with | None -> loop [] (it :: commit_text acc_text acc) items | Some x -> - if not t.quoted && V.is_multivalued x then - Loc.fail t.loc "please quote the string containing the \ - list variable %s" (string_of_var syntax v) - else loop (V.to_string ctx x :: acc_text) acc items + check_valid_multivalue syntax ~var:v t x; + loop (V.to_string ctx x :: acc_text) acc items in match t.items with | [Var (_, v)] when not t.quoted -> From 731b61b0b9fcfbce33ca8f0da6dbafbad409ae09 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Mon, 4 Jun 2018 22:01:51 +0700 Subject: [PATCH 05/23] Improve the error message with invalid strings Signed-off-by: Rudi Grinberg --- src/string_with_vars.ml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/string_with_vars.ml b/src/string_with_vars.ml index d4b91a34..33df64ef 100644 --- a/src/string_with_vars.ml +++ b/src/string_with_vars.ml @@ -134,8 +134,9 @@ module Expand_to(V: EXPANSION) = struct let check_valid_multivalue syntax ~var t ctx = if not t.quoted && V.is_multivalued ctx then - Loc.fail t.loc "please quote the string \ - containing the list variable %s" + Loc.fail t.loc "Variable %s expands to multiple values, \ + however a single value is expected here. \ + Please quote this atom. " (string_of_var syntax var) let expand ctx t ~f = From 9545d9a854bbb6dab2cceac1dd4732bbfd4303f1 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Mon, 4 Jun 2018 22:06:58 +0700 Subject: [PATCH 06/23] Add length function to exapnsions This is useful for an error message that includes the number of items we've expanded to. Signed-off-by: Rudi Grinberg --- src/action.ml | 4 ++++ src/string_with_vars.ml | 10 ++++++---- src/string_with_vars.mli | 2 ++ 3 files changed, 12 insertions(+), 4 deletions(-) diff --git a/src/action.ml b/src/action.ml index c8b5f49b..8ab14e38 100644 --- a/src/action.ml +++ b/src/action.ml @@ -275,6 +275,10 @@ module Var_expansion = struct | Paths of Path.t list | Strings of string list + let length = function + | Paths x -> List.length x + | Strings x -> List.length x + let is_multivalued = function | Paths [_] -> false | Strings [_] -> false diff --git a/src/string_with_vars.ml b/src/string_with_vars.ml index 33df64ef..61a1f86c 100644 --- a/src/string_with_vars.ml +++ b/src/string_with_vars.ml @@ -106,6 +106,7 @@ let string_of_var syntax v = module type EXPANSION = sig type t + val length : t -> int val is_multivalued : t -> bool type context val to_string : context -> t -> string @@ -132,12 +133,12 @@ end module Expand_to(V: EXPANSION) = struct - let check_valid_multivalue syntax ~var t ctx = - if not t.quoted && V.is_multivalued ctx then - Loc.fail t.loc "Variable %s expands to multiple values, \ + let check_valid_multivalue syntax ~var t x = + 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. " - (string_of_var syntax var) + (string_of_var syntax var) (V.length x) let expand ctx t ~f = match t.items with @@ -189,6 +190,7 @@ end module String_expansion = struct type t = string + let length _ = 1 let is_multivalued _ = false type context = unit let to_string () (s: string) = s diff --git a/src/string_with_vars.mli b/src/string_with_vars.mli index 9dc3ab38..89e4fd95 100644 --- a/src/string_with_vars.mli +++ b/src/string_with_vars.mli @@ -49,6 +49,8 @@ module type EXPANSION = sig type t (** The value to which variables are expanded. *) + val length : t -> int + val is_multivalued : t -> bool (** Report whether the value is a multivalued one (such as for example ${@}) which much be in quoted strings to be concatenated From eab7c46bdba965aaa20c595d3a5a3ed24cae6755 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 5 Jun 2018 11:25:12 +0700 Subject: [PATCH 07/23] 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 From cadee0e661a3d14404194df5055a2c329dbcaae4 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 5 Jun 2018 12:09:47 +0700 Subject: [PATCH 08/23] Write explicit interface for Expand_to Signed-off-by: Rudi Grinberg --- src/string_with_vars.ml | 21 +++++++++++++++++++++ src/string_with_vars.mli | 20 +++++++++++++------- 2 files changed, 34 insertions(+), 7 deletions(-) diff --git a/src/string_with_vars.ml b/src/string_with_vars.ml index 19e2a2fb..3860423c 100644 --- a/src/string_with_vars.ml +++ b/src/string_with_vars.ml @@ -131,7 +131,28 @@ module Expand = struct end end +module type Expand_intf = sig + type context + type expansion + + val expand + : context + -> t + -> allow_multivalue:bool + -> f:(Loc.t -> string -> expansion option) + -> expansion Expand.Full.t + + val partial_expand + : context + -> t + -> allow_multivalue:bool + -> f:(Loc.t -> string -> expansion option) + -> expansion Expand.Partial.t +end + module Expand_to(V: EXPANSION) = struct + type expansion = V.t + type context = V.context let check_valid_multivalue syntax ~var t x = if not t.quoted && V.is_multivalued x then diff --git a/src/string_with_vars.mli b/src/string_with_vars.mli index 0b0e0451..fa9d5d5f 100644 --- a/src/string_with_vars.mli +++ b/src/string_with_vars.mli @@ -79,24 +79,27 @@ module Expand : sig end end -module Expand_to(V : EXPANSION) : sig +module type Expand_intf = sig + type context + type expansion + val expand - : V.context + : context -> t -> allow_multivalue:bool - -> f:(Loc.t -> string -> V.t option) - -> V.t Expand.Full.t + -> f:(Loc.t -> string -> expansion option) + -> expansion Expand.Full.t (** [expand t ~f] return [t] where all variables have been expanded using [f]. If [f loc var] return [Some x], the variable [var] is replaced by [x]; otherwise, the variable is inserted using the syntax it was originally defined with: ${..} or $(..) *) val partial_expand - : V.context + : context -> t -> allow_multivalue:bool - -> f:(Loc.t -> string -> V.t option) - -> V.t Expand.Partial.t + -> f:(Loc.t -> string -> expansion option) + -> expansion Expand.Partial.t (** [partial_expand t ~f] is like [expand_generic] where all variables that could be expanded (i.e., those for which [f] returns [Some _]) are. If all the variables of [t] were @@ -104,6 +107,9 @@ module Expand_to(V : EXPANSION) : sig least a variable of [t], it returns a string-with-vars. *) end +module Expand_to(V : EXPANSION) : Expand_intf + with type expansion = V.t and type context = V.context + val expand : t -> f:(Loc.t -> string -> string option) From 588129d5824ce0a5277d9eb4647b053fdc1585ea Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 5 Jun 2018 12:10:26 +0700 Subject: [PATCH 09/23] Move Var_expansion to own module These variables can occur outside actions so such expansions shouldn't live under Var_expansion. Signed-off-by: Rudi Grinberg --- src/action.ml | 85 +++++++++++++------------------------------ src/action.mli | 11 ------ src/inline_tests.ml | 5 +-- src/super_context.ml | 22 +++++------ src/super_context.mli | 6 +-- src/var_expansion.ml | 44 ++++++++++++++++++++++ src/var_expansion.mli | 19 ++++++++++ 7 files changed, 104 insertions(+), 88 deletions(-) create mode 100644 src/var_expansion.ml create mode 100644 src/var_expansion.mli diff --git a/src/action.ml b/src/action.ml index e5cf7a8e..3c9e9ec4 100644 --- a/src/action.ml +++ b/src/action.ml @@ -270,53 +270,14 @@ module Unresolved = struct | Search s -> Ok (f s)) end -module Var_expansion = struct - type t = - | Paths of Path.t list - | Strings of string list +let var_expansion_to_prog_and_args dir exp : Unresolved.Program.t * string list = + let module P = Unresolved.Program in + match (exp : Var_expansion.t) with + | Paths (x::xs) -> (This x, Var_expansion.to_strings dir (Paths xs)) + | Strings (s::xs) -> ( P.of_string ~dir s + , Var_expansion.to_strings dir (Strings xs)) + | Paths [] | Strings [] -> (Search "", []) - let length = function - | Paths x -> List.length x - | Strings x -> List.length x - - let is_multivalued = function - | Paths [_] -> false - | Strings [_] -> false - | _ -> true - - type context = Path.t (* For String_with_vars.Expand_to *) - - let concat = function - | [s] -> s - | l -> String.concat ~sep:" " l - - let string_of_path ~dir p = Path.reach ~from:dir p - let path_of_string dir s = Path.relative dir s - - let to_strings dir = function - | Strings l -> l - | Paths l -> List.map l ~f:(string_of_path ~dir) - - let to_string (dir: context) = function - | Strings l -> concat l - | Paths l -> concat (List.map l ~f:(string_of_path ~dir)) - - let to_path dir = function - | Strings l -> path_of_string dir (concat l) - | Paths [p] -> p - | Paths l -> - path_of_string dir (concat (List.map l ~f:(string_of_path ~dir))) - - let to_prog_and_args dir exp : Unresolved.Program.t * string list = - let module P = Unresolved.Program in - match exp with - | Paths (x::xs) -> (This x, to_strings dir (Paths xs)) - | Strings (s::xs) -> (P.of_string ~dir s, to_strings dir (Strings xs)) - | Paths [] | Strings [] -> (Search "", []) -end - -module VE = Var_expansion -module To_VE = String_with_vars.Expand_to(VE) module SW = String_with_vars module Unexpanded = struct @@ -357,37 +318,39 @@ module Unexpanded = struct let expand ~generic ~special ~map ~dir ~allow_multivalue ~f = function | Left x -> map x | Right template -> - match To_VE.expand dir template ~f ~allow_multivalue with - | Expansion e -> special dir e - | String s -> generic dir s + match + Var_expansion.Expand.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 + ~special:Var_expansion.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 + ~special:Var_expansion.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 + ~generic:Var_expansion.path_of_string + ~special:Var_expansion.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 + ~special:var_expansion_to_prog_and_args ~map:(fun x -> (x, [])) end @@ -452,7 +415,9 @@ module Unexpanded = struct module E = struct let expand ~generic ~special ~dir ~allow_multivalue ~f template = - match To_VE.partial_expand dir template ~allow_multivalue ~f with + match + Var_expansion.Expand.partial_expand dir template ~allow_multivalue ~f + with | Expansion e -> Left (special dir e) | String s -> Left (generic dir s) | Unexpanded x -> Right x @@ -461,25 +426,25 @@ module Unexpanded = struct expand ~dir ~f x ~allow_multivalue:false ~generic:(fun _dir x -> x) - ~special:VE.to_string + ~special:Var_expansion.to_string let strings ~dir ~f x = expand ~dir ~f x ~allow_multivalue:true ~generic:(fun _dir x -> [x]) - ~special:VE.to_strings + ~special:Var_expansion.to_strings let path ~dir ~f x = expand ~dir ~f x ~allow_multivalue:false - ~generic:VE.path_of_string - ~special:VE.to_path + ~generic:Var_expansion.path_of_string + ~special:Var_expansion.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 + ~special:var_expansion_to_prog_and_args end let rec partial_expand t ~dir ~map_exe ~f : Partial.t = diff --git a/src/action.mli b/src/action.mli index 89e0a91f..310dcd89 100644 --- a/src/action.mli +++ b/src/action.mli @@ -1,16 +1,5 @@ open! Import -module Var_expansion : sig - type t = - | Paths of Path.t list - | Strings of string list - - val to_string : Path.t -> t -> string - (** [to_string dir v] convert the variable expansion to a string. - If it is a path, the corresponding string will be relative to - [dir]. *) -end - module Outputs : module type of struct include Action_intf.Outputs end (** result of the lookup of a program, the path to it or information about the diff --git a/src/inline_tests.ml b/src/inline_tests.ml index 120823a8..27ff3d43 100644 --- a/src/inline_tests.ml +++ b/src/inline_tests.ml @@ -187,8 +187,7 @@ include Sub_system.Register_end_point( in let extra_vars = - String.Map.singleton "library-name" - (Action.Var_expansion.Strings [lib.name]) + String.Map.singleton "library-name" (Var_expansion.Strings [lib.name]) in let runner_libs = @@ -210,7 +209,7 @@ include Sub_system.Register_end_point( let target = Path.relative inline_test_dir main_module_filename in let source_modules = Module.Name.Map.values source_modules in let files ml_kind = - Action.Var_expansion.Paths ( + Var_expansion.Paths ( List.filter_map source_modules ~f:(fun m -> Module.file m ~dir ml_kind)) in diff --git a/src/super_context.ml b/src/super_context.ml index 68f26e31..aa08ea04 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -45,7 +45,7 @@ type t = ; artifacts : Artifacts.t ; stanzas_to_consider_for_install : Installable.t list ; cxx_flags : string list - ; vars : Action.Var_expansion.t String.Map.t + ; vars : Var_expansion.t String.Map.t ; chdir : (Action.t, Action.t) Build.t ; host : t option ; libs_by_package : (Package.t * Lib.Set.t) Package.Name.Map.t @@ -92,7 +92,7 @@ let expand_vars t ~scope ~dir ?(extra_vars=String.Map.empty) s = | "SCOPE_ROOT" -> Some (Path.reach ~from:dir (Scope.root scope)) | var -> - Option.map ~f:(fun e -> Action.Var_expansion.to_string dir e) + Option.map ~f:(fun e -> Var_expansion.to_string dir e) (match expand_var_no_root t var with | Some _ as x -> x | None -> String.Map.find extra_vars var)) @@ -270,7 +270,7 @@ let create | None -> Path.relative context.ocaml_bin "ocamlopt" | Some p -> p in - let open Action.Var_expansion in + let open Var_expansion in let make = match Bin.make with | None -> Strings ["make"] @@ -588,7 +588,7 @@ module Action = struct ; (* Static deps from ${...} variables. For instance ${exe:...} *) mutable sdeps : Path.Set.t ; (* Dynamic deps from ${...} variables. For instance ${read:...} *) - mutable ddeps : (unit, Action.Var_expansion.t) Build.t String.Map.t + mutable ddeps : (unit, Var_expansion.t) Build.t String.Map.t } let add_lib_dep acc lib kind = @@ -602,8 +602,8 @@ module Action = struct acc.ddeps <- String.Map.add acc.ddeps key dep; None - let path_exp path = Action.Var_expansion.Paths [path] - let str_exp path = Action.Var_expansion.Strings [path] + let path_exp path = Var_expansion.Paths [path] + let str_exp path = Var_expansion.Strings [path] let map_exe sctx = match sctx.host with @@ -630,7 +630,7 @@ module Action = struct ; ddeps = String.Map.empty } in - let open Action.Var_expansion in + let open Var_expansion in let expand loc key var = function | Some ("exe" , s) -> Some (path_exp (map_exe (Path.relative dir s))) | Some ("path" , s) -> Some (path_exp (Path.relative dir s) ) @@ -751,7 +751,7 @@ module Action = struct (t, acc) let expand_step2 ~dir ~dynamic_expansions ~deps_written_by_user ~map_exe t = - let open Action.Var_expansion in + let open Var_expansion in U.Partial.expand t ~dir ~map_exe ~f:(fun loc key -> match String.Map.find dynamic_expansions key with | Some _ as opt -> opt @@ -762,9 +762,9 @@ module Action = struct Some (match deps_written_by_user with | [] -> - Loc.warn loc "Variable '<' used with no explicit \ - dependencies@."; - Strings [""] + Loc.warn loc "Variable '<' used with no explicit \ + dependencies@."; + Strings [""] | dep :: _ -> Paths [dep]) | "^" -> Some (Paths deps_written_by_user) diff --git a/src/super_context.mli b/src/super_context.mli index 9ca190de..9f74c063 100644 --- a/src/super_context.mli +++ b/src/super_context.mli @@ -82,7 +82,7 @@ val expand_vars : t -> scope:Scope.t -> dir:Path.t - -> ?extra_vars:Action.Var_expansion.t String.Map.t + -> ?extra_vars:Var_expansion.t String.Map.t -> String_with_vars.t -> string @@ -90,7 +90,7 @@ val expand_and_eval_set : t -> scope:Scope.t -> dir:Path.t - -> ?extra_vars:Action.Var_expansion.t String.Map.t + -> ?extra_vars:Var_expansion.t String.Map.t -> Ordered_set_lang.Unexpanded.t -> standard:(unit, string list) Build.t -> (unit, string list) Build.t @@ -224,7 +224,7 @@ module Action : sig val run : t -> loc:Loc.t - -> ?extra_vars:Action.Var_expansion.t String.Map.t + -> ?extra_vars:Var_expansion.t String.Map.t -> Action.Unexpanded.t -> dir:Path.t -> dep_kind:Build.lib_dep_kind diff --git a/src/var_expansion.ml b/src/var_expansion.ml new file mode 100644 index 00000000..8dc6d996 --- /dev/null +++ b/src/var_expansion.ml @@ -0,0 +1,44 @@ +open Stdune + +module T = struct + type t = + | Paths of Path.t list + | Strings of string list + + let length = function + | Paths x -> List.length x + | Strings x -> List.length x + + let is_multivalued = function + | Paths [_] -> false + | Strings [_] -> false + | _ -> true + + type context = Path.t (* For String_with_vars.Expand_to *) + + let concat = function + | [s] -> s + | l -> String.concat ~sep:" " l + + let string_of_path ~dir p = Path.reach ~from:dir p + + let to_string (dir: context) = function + | Strings l -> concat l + | Paths l -> concat (List.map l ~f:(string_of_path ~dir)) +end + +include T + +module Expand = String_with_vars.Expand_to(T) + +let path_of_string dir s = Path.relative dir s + +let to_strings dir = function + | Strings l -> l + | Paths l -> List.map l ~f:(string_of_path ~dir) + +let to_path dir = function + | Strings l -> path_of_string dir (concat l) + | Paths [p] -> p + | Paths l -> + path_of_string dir (concat (List.map l ~f:(string_of_path ~dir))) diff --git a/src/var_expansion.mli b/src/var_expansion.mli new file mode 100644 index 00000000..09819fcf --- /dev/null +++ b/src/var_expansion.mli @@ -0,0 +1,19 @@ +open Stdune + +type t = + | Paths of Path.t list + | Strings of string list + +val to_string : Path.t -> t -> string +(** [to_string dir v] convert the variable expansion to a string. + If it is a path, the corresponding string will be relative to + [dir]. *) + +val path_of_string : Path.t -> string -> Path.t + +val to_strings : Path.t -> t -> string list + +val to_path : Path.t -> t -> Path.t + +module Expand : String_with_vars.Expand_intf + with type expansion = t and type context = Path.t From bab65e989d14288b4eb0b515334930b8fdca2af7 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 5 Jun 2018 14:00:03 +0700 Subject: [PATCH 10/23] Allow for proper expansoin of vars in super contexts Multivalues are no longer allowed when unquoted, and paths are no longer needlessly converted. Signed-off-by: Rudi Grinberg --- src/gen_rules.ml | 3 +-- src/super_context.ml | 32 +++++++++++++++----------------- src/super_context.mli | 8 ++++++++ src/var_expansion.ml | 17 +++++++++++++++++ src/var_expansion.mli | 15 +++++++++++++++ 5 files changed, 56 insertions(+), 19 deletions(-) diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 3ffd5868..8f7cf26c 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -176,8 +176,7 @@ module Gen(P : Install_rules.Params) = struct +-----------------------------------------------------------------+ *) let interpret_locks ~dir ~scope locks = - List.map locks ~f:(fun s -> - Path.relative dir (SC.expand_vars sctx ~dir ~scope s)) + List.map locks ~f:(SC.expand_vars_path sctx ~dir ~scope) let user_rule (rule : Rule.t) ~dir ~scope = let targets : SC.Action.targets = diff --git a/src/super_context.ml b/src/super_context.ml index aa08ea04..35b46404 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -86,16 +86,18 @@ let find_scope_by_name t name = Scope.DB.find_by_name t.scopes name let expand_var_no_root t var = String.Map.find t.vars var -let expand_vars t ~scope ~dir ?(extra_vars=String.Map.empty) s = - String_with_vars.expand s ~f:(fun _loc -> function - | "ROOT" -> Some (Path.reach ~from:dir t.context.build_dir) - | "SCOPE_ROOT" -> - Some (Path.reach ~from:dir (Scope.root scope)) - | var -> - Option.map ~f:(fun e -> Var_expansion.to_string dir e) +let (expand_vars, expand_vars_path) = + let make expander t ~scope ~dir ?(extra_vars=String.Map.empty) s = + expander ~dir s ~f:(fun _loc -> function + | "ROOT" -> Some (Var_expansion.Paths [t.context.build_dir]) + | "SCOPE_ROOT" -> Some (Paths [Scope.root scope]) + | var -> (match expand_var_no_root t var with | Some _ as x -> x - | None -> String.Map.find extra_vars var)) + | None -> String.Map.find extra_vars var)) in + ( make Var_expansion.Single.string + , make Var_expansion.Single.path + ) let expand_and_eval_set t ~scope ~dir ?extra_vars set ~standard = let open Build.O in @@ -482,13 +484,11 @@ module Deps = struct let make_alias t ~scope ~dir s = let loc = String_with_vars.loc s in - Alias.of_user_written_path ~loc - (Path.relative ~error_loc:loc dir (expand_vars t ~scope ~dir s)) + Alias.of_user_written_path ~loc ((expand_vars_path t ~scope ~dir s)) let dep t ~scope ~dir = function | File s -> - let path = Path.relative ~error_loc:(String_with_vars.loc s) dir - (expand_vars t ~scope ~dir s) in + let path = expand_vars_path t ~scope ~dir s in Build.path path >>^ fun () -> [path] | Alias s -> @@ -500,19 +500,17 @@ module Deps = struct >>^ fun () -> [] | Glob_files s -> begin let loc = String_with_vars.loc s in - let path = - Path.relative ~error_loc:loc dir (expand_vars t ~scope ~dir s) in + let path = expand_vars_path t ~scope ~dir s in match Glob_lexer.parse_string (Path.basename path) with | Ok re -> let dir = Path.parent_exn path in Build.paths_glob ~loc ~dir (Re.compile re) >>^ Path.Set.to_list | Error (_pos, msg) -> - Loc.fail loc "invalid glob: %s" msg + Loc.fail (String_with_vars.loc s) "invalid glob: %s" msg end | Files_recursively_in s -> - let path = Path.relative ~error_loc:(String_with_vars.loc s) - dir (expand_vars t ~scope ~dir s) in + let path = expand_vars_path t ~scope ~dir s in Build.files_recursively_in ~dir:path ~file_tree:t.file_tree >>^ Path.Set.to_list | Package p -> diff --git a/src/super_context.mli b/src/super_context.mli index 9f74c063..2f06dfba 100644 --- a/src/super_context.mli +++ b/src/super_context.mli @@ -86,6 +86,14 @@ val expand_vars -> String_with_vars.t -> string +val expand_vars_path + : t + -> scope:Scope.t + -> dir:Path.t + -> ?extra_vars:Var_expansion.t String.Map.t + -> String_with_vars.t + -> Path.t + val expand_and_eval_set : t -> scope:Scope.t diff --git a/src/var_expansion.ml b/src/var_expansion.ml index 8dc6d996..080b18ae 100644 --- a/src/var_expansion.ml +++ b/src/var_expansion.ml @@ -42,3 +42,20 @@ let to_path dir = function | Paths [p] -> p | Paths l -> path_of_string dir (concat (List.map l ~f:(string_of_path ~dir))) + +module Single = struct + let path ~dir sw ~f = + let relative = Path.relative ~error_loc:(String_with_vars.loc sw) in + match Expand.expand dir sw ~allow_multivalue:false ~f with + | String s + | Expansion (Strings [s]) -> relative dir s + | Expansion (Paths [s]) -> Path.append dir s + | _ -> assert false (* multivalues aren't allowed *) + + let string ~dir sw ~f = + match Expand.expand dir sw ~allow_multivalue:false ~f with + | String s + | Expansion (Strings [s]) -> s + | Expansion (Paths [s]) -> string_of_path ~dir s + | _ -> assert false (* multivalues aren't allowed *) +end diff --git a/src/var_expansion.mli b/src/var_expansion.mli index 09819fcf..048a2488 100644 --- a/src/var_expansion.mli +++ b/src/var_expansion.mli @@ -17,3 +17,18 @@ val to_path : Path.t -> t -> Path.t module Expand : String_with_vars.Expand_intf with type expansion = t and type context = Path.t + +(** Specialized expansion that produce only a single value *) +module Single : sig + val path + : dir:Path.t + -> String_with_vars.t + -> f:(Loc.t -> string -> t option) + -> Path.t + + val string + : dir:Path.t + -> String_with_vars.t + -> f:(Loc.t -> string -> t option) + -> string +end From 589943df60b9a076bb365ec0041510314a0e063c Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 5 Jun 2018 23:42:32 +0700 Subject: [PATCH 11/23] Simplify String_with_vars Make it expand only to Value.t since the string only version wasn't really used. Variable expansions are now Value.t list. Which also gives the flexibility for a value to expand to a collection of more than 1 value. Signed-off-by: Rudi Grinberg --- src/action.ml | 107 ++++++++------------ src/action.mli | 4 +- src/inline_tests.ml | 4 +- src/stdune/either.ml | 5 + src/stdune/either.mli | 2 + src/string_with_vars.ml | 206 ++++++++++++++++----------------------- src/string_with_vars.mli | 85 +++------------- src/super_context.ml | 72 +++++++------- src/super_context.mli | 8 +- src/value.ml | 27 +++++ src/value.mli | 17 ++++ src/var_expansion.ml | 61 ------------ src/var_expansion.mli | 34 ------- 13 files changed, 237 insertions(+), 395 deletions(-) create mode 100644 src/value.ml create mode 100644 src/value.mli delete mode 100644 src/var_expansion.ml delete mode 100644 src/var_expansion.mli diff --git a/src/action.ml b/src/action.ml index 3c9e9ec4..c2ef1c7f 100644 --- a/src/action.ml +++ b/src/action.ml @@ -270,13 +270,12 @@ module Unresolved = struct | Search s -> Ok (f s)) end -let var_expansion_to_prog_and_args dir exp : Unresolved.Program.t * string list = - let module P = Unresolved.Program in - match (exp : Var_expansion.t) with - | Paths (x::xs) -> (This x, Var_expansion.to_strings dir (Paths xs)) - | Strings (s::xs) -> ( P.of_string ~dir s - , Var_expansion.to_strings dir (Strings xs)) - | Paths [] | Strings [] -> (Search "", []) +let prog_and_args_of_values p ~dir = + match p with + | [] -> (Unresolved.Program.Search "", []) + | Value.Path p :: xs -> (This p, Value.to_strings ~dir xs) + | String s :: xs -> + (Unresolved.Program.of_string ~dir s, Value.to_strings ~dir xs) module SW = String_with_vars @@ -315,43 +314,33 @@ module Unexpanded = struct include Past module E = struct - let expand ~generic ~special ~map ~dir ~allow_multivalue ~f = function - | Left x -> map x - | Right template -> - match - Var_expansion.Expand.expand dir template ~f ~allow_multivalue - with - | Expansion e -> special dir e - | String s -> generic dir s - [@@inlined always] + let expand ~dir ~mode ~f ~l ~r = + Either.map ~l + ~r:(fun s -> r (String_with_vars.expand s ~dir ~f ~mode) ~dir) - let string ~dir ~f x = - expand ~dir ~f x - ~allow_multivalue:false - ~generic:(fun _dir x -> x) - ~special:Var_expansion.to_string - ~map:(fun x -> x) + let string = + expand ~mode:Single + ~l:(fun x -> x) + ~r:Value.to_string - let strings ~dir ~f x = - expand ~dir ~f x - ~allow_multivalue:true - ~generic:(fun _dir x -> [x]) - ~special:Var_expansion.to_strings - ~map:(fun x -> [x]) + let strings = + expand ~mode:Many + ~l:(fun x -> [x]) + ~r:Value.to_strings - let path ~dir ~f x = - expand ~dir ~f x - ~allow_multivalue:false - ~generic:Var_expansion.path_of_string - ~special:Var_expansion.to_path - ~map:(fun x -> x) + let path e = + let error_loc = + match e with + | Left _ -> None + | Right r -> Some (String_with_vars.loc r) in + expand ~mode:Single + ~l:(fun x -> x) + ~r:Value.(to_path ?error_loc) e - let prog_and_args ~dir ~f x = - expand ~dir ~f x - ~allow_multivalue:true - ~generic:(fun _dir s -> (Program.of_string ~dir s, [])) - ~special:var_expansion_to_prog_and_args - ~map:(fun x -> (x, [])) + let prog_and_args = + expand ~mode:Many + ~l:(fun x -> (x, [])) + ~r:prog_and_args_of_values end let rec expand t ~dir ~map_exe ~f : Unresolved.t = @@ -414,37 +403,17 @@ module Unexpanded = struct end module E = struct - let expand ~generic ~special ~dir ~allow_multivalue ~f template = - match - Var_expansion.Expand.partial_expand dir template ~allow_multivalue ~f - with - | Expansion e -> Left (special dir e) - | String s -> Left (generic dir s) + let expand ~dir ~mode ~f ~map x = + match String_with_vars.partial_expand ~mode ~dir ~f x with + | Expanded e -> Left (map e ~dir) | Unexpanded x -> Right x - let string ~dir ~f x = - expand ~dir ~f x - ~allow_multivalue:false - ~generic:(fun _dir x -> x) - ~special:Var_expansion.to_string - - let strings ~dir ~f x = - expand ~dir ~f x - ~allow_multivalue:true - ~generic:(fun _dir x -> [x]) - ~special:Var_expansion.to_strings - - let path ~dir ~f x = - expand ~dir ~f x - ~allow_multivalue:false - ~generic:Var_expansion.path_of_string - ~special:Var_expansion.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:var_expansion_to_prog_and_args + let string = expand ~mode:Single ~map:(Value.to_string) + let strings = expand ~mode:Many ~map:(Value.to_strings) + let path x = + let error_loc = String_with_vars.loc x in + expand ~mode:Single ~map:(Value.to_path ~error_loc) x + let prog_and_args = expand ~mode:Many ~map:(prog_and_args_of_values) end let rec partial_expand t ~dir ~map_exe ~f : Partial.t = diff --git a/src/action.mli b/src/action.mli index 310dcd89..e3972fdd 100644 --- a/src/action.mli +++ b/src/action.mli @@ -82,7 +82,7 @@ module Unexpanded : sig : t -> dir:Path.t -> map_exe:(Path.t -> Path.t) - -> f:(Loc.t -> String.t -> Var_expansion.t option) + -> f:(Loc.t -> String.t -> Value.t list option) -> Unresolved.t end @@ -90,7 +90,7 @@ module Unexpanded : sig : t -> dir:Path.t -> map_exe:(Path.t -> Path.t) - -> f:(Loc.t -> string -> Var_expansion.t option) + -> f:(Loc.t -> string -> Value.t list option) -> Partial.t end diff --git a/src/inline_tests.ml b/src/inline_tests.ml index 27ff3d43..3c202834 100644 --- a/src/inline_tests.ml +++ b/src/inline_tests.ml @@ -187,7 +187,7 @@ include Sub_system.Register_end_point( in let extra_vars = - String.Map.singleton "library-name" (Var_expansion.Strings [lib.name]) + String.Map.singleton "library-name" ([Value.String lib.name]) in let runner_libs = @@ -209,7 +209,7 @@ include Sub_system.Register_end_point( let target = Path.relative inline_test_dir main_module_filename in let source_modules = Module.Name.Map.values source_modules in let files ml_kind = - Var_expansion.Paths ( + Value.paths ( List.filter_map source_modules ~f:(fun m -> Module.file m ~dir ml_kind)) in diff --git a/src/stdune/either.ml b/src/stdune/either.ml index 082092aa..f76d48f3 100644 --- a/src/stdune/either.ml +++ b/src/stdune/either.ml @@ -1,3 +1,8 @@ type ('a, 'b) t = | Left of 'a | Right of 'b + +let map t ~l ~r = + match t with + | Left x -> l x + | Right x -> r x diff --git a/src/stdune/either.mli b/src/stdune/either.mli index 621339d8..21bd9125 100644 --- a/src/stdune/either.mli +++ b/src/stdune/either.mli @@ -3,3 +3,5 @@ type ('a, 'b) t = | Left of 'a | Right of 'b + +val map : ('a, 'b) t -> l:('a -> 'c) -> r:('b -> 'c) -> 'c diff --git a/src/string_with_vars.ml b/src/string_with_vars.ml index 3860423c..733d51b5 100644 --- a/src/string_with_vars.ml +++ b/src/string_with_vars.ml @@ -104,137 +104,103 @@ let string_of_var syntax v = | Parens -> sprintf "$(%s)" v | Braces -> sprintf "${%s}" v -module type EXPANSION = sig - type t - val length : t -> int - val is_multivalued : t -> bool - type context - val to_string : context -> t -> string -end - let concat_rev = function | [] -> "" | [s] -> s | l -> String.concat (List.rev l) ~sep:"" -module Expand = struct - module Full = struct - type nonrec 'a t = - | Expansion of 'a - | String of string - end - module Partial = struct - type nonrec 'a t = - | Expansion of 'a - | String of string - | Unexpanded of t - end +module Mode = struct + type 'a t = + | Single : Value.t t + | Many : Value.t list t + + let string + : type a. a t -> string -> a + = fun t s -> + match t with + | Single -> Value.String s + | Many -> [Value.String s] + + let value + : type a. a t -> Value.t list -> a option + = fun t s -> + match t, s with + | Many, s -> Some s + | Single, [s] -> Some s + | Single, _ -> None end -module type Expand_intf = sig - type context - type expansion - - val expand - : context - -> t - -> allow_multivalue:bool - -> f:(Loc.t -> string -> expansion option) - -> expansion Expand.Full.t - - val partial_expand - : context - -> t - -> allow_multivalue:bool - -> f:(Loc.t -> string -> expansion option) - -> expansion Expand.Partial.t +module Partial = struct + type nonrec 'a t = + | Expanded of 'a + | Unexpanded of t end -module Expand_to(V: EXPANSION) = struct - type expansion = V.t - type context = V.context +let invalid_multivalue syntax ~var t x = + Loc.fail t.loc "Variable %s expands to %d values, \ + however a single value is expected here. \ + Please quote this atom." + (string_of_var syntax var) (List.length x) - let check_valid_multivalue syntax ~var t x = - 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." - (string_of_var syntax var) (V.length x) +let expand t ~mode ~dir ~f = + match t.items with + | [Var (syntax, v)] when not t.quoted -> + (* Unquoted single var *) + begin match f t.loc v with + | Some e -> + begin match Mode.value mode e with + | None -> invalid_multivalue syntax ~var:v t e + | Some s -> s + end + | None -> Mode.string mode (string_of_var syntax v) + end + | _ -> + Mode.string mode ( + List.concat_map t.items ~f:(function + | Text s -> [s] + | Var (syntax, v) -> + begin match f t.loc v, t.quoted with + | Some ([] | _::_::_ as e) , false -> + invalid_multivalue syntax ~var:v t e + | Some ([_] as t), false + | Some t, true -> Value.to_strings ~dir t + | None, _ -> [string_of_var syntax v] + end) + |> String.concat ~sep:"") - 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 -> - 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 ( - List.map t.items ~f:(function - | Text s -> s - | Var (syntax, v) -> - match f t.loc v with - | Some x -> - check_valid_multivalue syntax ~var:v t x; - V.to_string ctx x - | None -> string_of_var syntax v) - |> String.concat ~sep:"") - - 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 - in - let rec loop acc_text acc items = - match items with - | [] -> begin - match acc with - | [] -> Expand.Partial.String (concat_rev acc_text) - | _ -> Unexpanded { t with items = List.rev (commit_text acc_text acc) } - end - | Text s :: items -> loop (s :: acc_text) acc items - | Var (syntax, v) as it :: items -> - match f t.loc v with - | None -> loop [] (it :: commit_text acc_text acc) items - | Some x -> - check_valid_multivalue syntax ~var:v t x; - loop (V.to_string ctx x :: acc_text) acc items - in - match t.items with - | [Var (syntax, v)] when not t.quoted -> - (* Unquoted single var *) - (match f t.loc v with - | 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 - -module String_expansion = struct - type t = string - let length _ = 1 - let is_multivalued _ = false - type context = unit - let to_string () (s: string) = s -end - -module S = Expand_to(String_expansion) - -let expand t ~f = - 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 ~allow_multivalue:true ~f with - | Expand.Partial.Expansion s -> Left s - | String s -> Left s - | Unexpanded s -> Right s +let partial_expand t ~mode ~dir ~f = + let commit_text acc_text acc = + let s = concat_rev acc_text in + if s = "" then acc else Text s :: acc + in + let rec loop acc_text acc items = + match items with + | [] -> + begin match acc with + | [] -> Partial.Expanded (Mode.string mode (concat_rev acc_text)) + | _ -> Unexpanded { t with items = List.rev (commit_text acc_text acc) } + end + | Text s :: items -> loop (s :: acc_text) acc items + | Var (syntax, v) as it :: items -> + begin match f t.loc v with + | Some (([] | _::_) as e) when not t.quoted -> + invalid_multivalue syntax ~var:v t e + | Some t -> + loop (List.rev_append (Value.to_strings ~dir t) acc_text) acc items + | None -> loop [] (it :: commit_text acc_text acc) items + end + in + match t.items with + | [Var (syntax, v)] when not t.quoted -> + (* Unquoted single var *) + begin match f t.loc v with + | Some e -> Partial.Expanded ( + match Mode.value mode e with + | None -> invalid_multivalue syntax ~var:v t e + | Some s -> s) + | None -> Unexpanded t + end + | _ -> loop [] [] t.items let to_string t = match t.items with diff --git a/src/string_with_vars.mli b/src/string_with_vars.mli index fa9d5d5f..f29de007 100644 --- a/src/string_with_vars.mli +++ b/src/string_with_vars.mli @@ -45,81 +45,28 @@ val iter : t -> f:(Loc.t -> string -> unit) -> unit val is_var : t -> name:string -> bool -module type EXPANSION = sig - type t - (** The value to which variables are expanded. *) - - val length : t -> int - - val is_multivalued : t -> bool - (** Report whether the value is a multivalued one (such as for - example ${@}) which much be in quoted strings to be concatenated - to text or other variables. *) - - type context - (** Context needed to expand values of type [t] to strings. *) - - val to_string : context -> t -> string - (** When needing to expand with text portions or if the - string-with-vars is quoted, the value is converted to a string - using [to_string]. *) +module Mode : sig + type 'a t = + | Single : Value.t t + | Many : Value.t list t end -module Expand : sig - module Full : sig - type nonrec 'a t = - | Expansion of 'a - | String of string - end - module Partial : sig - type nonrec 'a t = - | Expansion of 'a - | String of string - | Unexpanded of t - end +module Partial : sig + type nonrec 'a t = + | Expanded of 'a + | Unexpanded of t end -module type Expand_intf = sig - type context - type expansion - - val expand - : context - -> t - -> allow_multivalue:bool - -> f:(Loc.t -> string -> expansion option) - -> expansion Expand.Full.t - (** [expand t ~f] return [t] where all variables have been expanded - using [f]. If [f loc var] return [Some x], the variable [var] is - replaced by [x]; otherwise, the variable is inserted using the syntax - it was originally defined with: ${..} or $(..) *) - - val partial_expand - : context - -> t - -> allow_multivalue:bool - -> f:(Loc.t -> string -> expansion option) - -> expansion Expand.Partial.t - (** [partial_expand t ~f] is like [expand_generic] where all - variables that could be expanded (i.e., those for which [f] - returns [Some _]) are. If all the variables of [t] were - expanded, a string is returned. If [f] returns [None] on at - least a variable of [t], it returns a string-with-vars. *) -end - -module Expand_to(V : EXPANSION) : Expand_intf - with type expansion = V.t and type context = V.context - 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). *) + -> mode:'a Mode.t + -> dir:Path.t + -> f:(Loc.t -> string -> Value.t list option) + -> 'a 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. *) + -> mode:'a Mode.t + -> dir:Path.t + -> f:(Loc.t -> string -> Value.t list option) + -> 'a Partial.t diff --git a/src/super_context.ml b/src/super_context.ml index 35b46404..1cc820a0 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -45,7 +45,7 @@ type t = ; artifacts : Artifacts.t ; stanzas_to_consider_for_install : Installable.t list ; cxx_flags : string list - ; vars : Var_expansion.t String.Map.t + ; vars : Value.t list String.Map.t ; chdir : (Action.t, Action.t) Build.t ; host : t option ; libs_by_package : (Package.t * Lib.Set.t) Package.Name.Map.t @@ -87,17 +87,24 @@ let find_scope_by_name t name = Scope.DB.find_by_name t.scopes name let expand_var_no_root t var = String.Map.find t.vars var let (expand_vars, expand_vars_path) = - let make expander t ~scope ~dir ?(extra_vars=String.Map.empty) s = - expander ~dir s ~f:(fun _loc -> function - | "ROOT" -> Some (Var_expansion.Paths [t.context.build_dir]) - | "SCOPE_ROOT" -> Some (Paths [Scope.root scope]) + let expand t ~scope ~dir ?(extra_vars=String.Map.empty) s = + String_with_vars.expand ~mode:Single ~dir s ~f:(fun _loc -> function + | "ROOT" -> Some [Value.Path t.context.build_dir] + | "SCOPE_ROOT" -> Some [Value.Path (Scope.root scope)] | var -> (match expand_var_no_root t var with | Some _ as x -> x - | None -> String.Map.find extra_vars var)) in - ( make Var_expansion.Single.string - , make Var_expansion.Single.path - ) + | None -> String.Map.find extra_vars var)) + in + let expand_vars t ~scope ~dir ?extra_vars s = + expand t ~scope ~dir ?extra_vars s + |> Value.to_string ~dir + in + let expand_vars_path t ~scope ~dir ?extra_vars s = + expand t ~scope ~dir ?extra_vars s + |> Value.to_path ~error_loc:(String_with_vars.loc s) ~dir + in + (expand_vars, expand_vars_path) let expand_and_eval_set t ~scope ~dir ?extra_vars set ~standard = let open Build.O in @@ -272,18 +279,17 @@ let create | None -> Path.relative context.ocaml_bin "ocamlopt" | Some p -> p in - let open Var_expansion in + let string s = [Value.String s] in + let path p = [Value.Path p] in let make = match Bin.make with - | None -> Strings ["make"] - | Some p -> Paths [p] + | None -> string "make" + | Some p -> path p in let cflags = context.ocamlc_cflags in - let strings l = Strings l in - let string s = Strings [s] in - let path p = Paths [p] in + let strings = Value.strings in let vars = - [ "-verbose" , Strings ([] (*"-verbose";*)) + [ "-verbose" , [] ; "CPP" , strings (context.c_compiler :: cflags @ ["-E"]) ; "PA_CPP" , strings (context.c_compiler :: cflags @ ["-undef"; "-traditional"; @@ -586,7 +592,7 @@ module Action = struct ; (* Static deps from ${...} variables. For instance ${exe:...} *) mutable sdeps : Path.Set.t ; (* Dynamic deps from ${...} variables. For instance ${read:...} *) - mutable ddeps : (unit, Var_expansion.t) Build.t String.Map.t + mutable ddeps : (unit, Value.t list) Build.t String.Map.t } let add_lib_dep acc lib kind = @@ -600,8 +606,8 @@ module Action = struct acc.ddeps <- String.Map.add acc.ddeps key dep; None - let path_exp path = Var_expansion.Paths [path] - let str_exp path = Var_expansion.Strings [path] + let path_exp path = [Value.Path path] + let str_exp str = [Value.String str] let map_exe sctx = match sctx.host with @@ -628,7 +634,6 @@ module Action = struct ; ddeps = String.Map.empty } in - let open Var_expansion in let expand loc key var = function | Some ("exe" , s) -> Some (path_exp (map_exe (Path.relative dir s))) | Some ("path" , s) -> Some (path_exp (Path.relative dir s) ) @@ -681,8 +686,8 @@ module Action = struct | Some p -> let x = Pkg_version.read sctx p >>^ function - | None -> Strings [""] - | Some s -> Strings [s] + | None -> [Value.String ""] + | Some s -> [String s] in add_ddep acc ~key x | None -> @@ -694,7 +699,7 @@ module Action = struct let path = Path.relative dir s in let data = Build.contents path - >>^ fun s -> Strings [s] + >>^ fun s -> [Value.String s] in add_ddep acc ~key data end @@ -702,7 +707,7 @@ module Action = struct let path = Path.relative dir s in let data = Build.lines_of path - >>^ fun l -> Strings l + >>^ Value.strings in add_ddep acc ~key data end @@ -710,7 +715,7 @@ module Action = struct let path = Path.relative dir s in let data = Build.strings path - >>^ fun l -> Strings l + >>^ Value.strings in add_ddep acc ~key data end @@ -732,7 +737,7 @@ module Action = struct match targets_written_by_user with | Infer -> Loc.fail loc "You cannot use ${@} with inferred rules." | Alias -> Loc.fail loc "You cannot use ${@} in aliases." - | Static l -> Some (Paths l) + | Static l -> Some (Value.paths l) end | _ -> match String.lsplit2 var ~on:':' with @@ -740,16 +745,15 @@ module Action = struct Some (path_exp (Path.relative dir s)) | x -> let exp = expand loc key var x in - (match exp with - | Some (Paths ps) -> - acc.sdeps <- Path.Set.union (Path.Set.of_list ps) acc.sdeps - | _ -> ()); + Option.iter exp ~f:(fun vs -> + acc.sdeps <- + Path.Set.union (Path.Set.of_list (Value.paths_only vs)) acc.sdeps; + ); exp) in (t, acc) let expand_step2 ~dir ~dynamic_expansions ~deps_written_by_user ~map_exe t = - let open Var_expansion in U.Partial.expand t ~dir ~map_exe ~f:(fun loc key -> match String.Map.find dynamic_expansions key with | Some _ as opt -> opt @@ -762,10 +766,10 @@ module Action = struct | [] -> Loc.warn loc "Variable '<' used with no explicit \ dependencies@."; - Strings [""] + [Value.String ""] | dep :: _ -> - Paths [dep]) - | "^" -> Some (Paths deps_written_by_user) + [Path dep]) + | "^" -> Some (Value.paths deps_written_by_user) | _ -> None) let run sctx ~loc ?(extra_vars=String.Map.empty) diff --git a/src/super_context.mli b/src/super_context.mli index 2f06dfba..ae4bc5c3 100644 --- a/src/super_context.mli +++ b/src/super_context.mli @@ -82,7 +82,7 @@ val expand_vars : t -> scope:Scope.t -> dir:Path.t - -> ?extra_vars:Var_expansion.t String.Map.t + -> ?extra_vars:Value.t list String.Map.t -> String_with_vars.t -> string @@ -90,7 +90,7 @@ val expand_vars_path : t -> scope:Scope.t -> dir:Path.t - -> ?extra_vars:Var_expansion.t String.Map.t + -> ?extra_vars:Value.t list String.Map.t -> String_with_vars.t -> Path.t @@ -98,7 +98,7 @@ val expand_and_eval_set : t -> scope:Scope.t -> dir:Path.t - -> ?extra_vars:Var_expansion.t String.Map.t + -> ?extra_vars:Value.t list String.Map.t -> Ordered_set_lang.Unexpanded.t -> standard:(unit, string list) Build.t -> (unit, string list) Build.t @@ -232,7 +232,7 @@ module Action : sig val run : t -> loc:Loc.t - -> ?extra_vars:Var_expansion.t String.Map.t + -> ?extra_vars:Value.t list String.Map.t -> Action.Unexpanded.t -> dir:Path.t -> dep_kind:Build.lib_dep_kind diff --git a/src/value.ml b/src/value.ml new file mode 100644 index 00000000..f8cf5828 --- /dev/null +++ b/src/value.ml @@ -0,0 +1,27 @@ +open Stdune + +type t = + | String of string + | Path of Path.t + +let string_of_path ~dir p = Path.reach ~from:dir p + +let to_string t ~dir = + match t with + | String s -> s + | Path p -> string_of_path ~dir p + +let to_strings t ~dir = List.map t ~f:(to_string ~dir) + +let to_path ?error_loc t ~dir = + match t with + | String s -> Path.relative ?error_loc dir s + | Path p -> p + +let strings = List.map ~f:(fun x -> String x) +let paths = List.map ~f:(fun x -> Path x) + +let paths_only = + List.filter_map ~f:(function + | String _ -> None + | Path p -> Some p) diff --git a/src/value.mli b/src/value.mli new file mode 100644 index 00000000..72226e21 --- /dev/null +++ b/src/value.mli @@ -0,0 +1,17 @@ +open Stdune + +type t = + | String of string + | Path of Path.t + +val to_string : t -> dir:Path.t -> string + +val to_strings : t list -> dir:Path.t -> string list + +val to_path : ?error_loc:Loc.t -> t -> dir:Path.t -> Path.t + +val strings : string list -> t list + +val paths : Path.t list -> t list + +val paths_only : t list -> Path.t list diff --git a/src/var_expansion.ml b/src/var_expansion.ml deleted file mode 100644 index 080b18ae..00000000 --- a/src/var_expansion.ml +++ /dev/null @@ -1,61 +0,0 @@ -open Stdune - -module T = struct - type t = - | Paths of Path.t list - | Strings of string list - - let length = function - | Paths x -> List.length x - | Strings x -> List.length x - - let is_multivalued = function - | Paths [_] -> false - | Strings [_] -> false - | _ -> true - - type context = Path.t (* For String_with_vars.Expand_to *) - - let concat = function - | [s] -> s - | l -> String.concat ~sep:" " l - - let string_of_path ~dir p = Path.reach ~from:dir p - - let to_string (dir: context) = function - | Strings l -> concat l - | Paths l -> concat (List.map l ~f:(string_of_path ~dir)) -end - -include T - -module Expand = String_with_vars.Expand_to(T) - -let path_of_string dir s = Path.relative dir s - -let to_strings dir = function - | Strings l -> l - | Paths l -> List.map l ~f:(string_of_path ~dir) - -let to_path dir = function - | Strings l -> path_of_string dir (concat l) - | Paths [p] -> p - | Paths l -> - path_of_string dir (concat (List.map l ~f:(string_of_path ~dir))) - -module Single = struct - let path ~dir sw ~f = - let relative = Path.relative ~error_loc:(String_with_vars.loc sw) in - match Expand.expand dir sw ~allow_multivalue:false ~f with - | String s - | Expansion (Strings [s]) -> relative dir s - | Expansion (Paths [s]) -> Path.append dir s - | _ -> assert false (* multivalues aren't allowed *) - - let string ~dir sw ~f = - match Expand.expand dir sw ~allow_multivalue:false ~f with - | String s - | Expansion (Strings [s]) -> s - | Expansion (Paths [s]) -> string_of_path ~dir s - | _ -> assert false (* multivalues aren't allowed *) -end diff --git a/src/var_expansion.mli b/src/var_expansion.mli deleted file mode 100644 index 048a2488..00000000 --- a/src/var_expansion.mli +++ /dev/null @@ -1,34 +0,0 @@ -open Stdune - -type t = - | Paths of Path.t list - | Strings of string list - -val to_string : Path.t -> t -> string -(** [to_string dir v] convert the variable expansion to a string. - If it is a path, the corresponding string will be relative to - [dir]. *) - -val path_of_string : Path.t -> string -> Path.t - -val to_strings : Path.t -> t -> string list - -val to_path : Path.t -> t -> Path.t - -module Expand : String_with_vars.Expand_intf - with type expansion = t and type context = Path.t - -(** Specialized expansion that produce only a single value *) -module Single : sig - val path - : dir:Path.t - -> String_with_vars.t - -> f:(Loc.t -> string -> t option) - -> Path.t - - val string - : dir:Path.t - -> String_with_vars.t - -> f:(Loc.t -> string -> t option) - -> string -end From ff173b98d89fbc7f01da7a985f2e656a9c0abf3a Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 6 Jun 2018 01:50:00 +0700 Subject: [PATCH 12/23] Share quote handling in partial and normal expansion The partial expansion had a bug in its condition for a 1 element value list. This fixes the bug by implementing the condition once and for all. Signed-off-by: Rudi Grinberg --- src/string_with_vars.ml | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/src/string_with_vars.ml b/src/string_with_vars.ml index 733d51b5..bcecebbb 100644 --- a/src/string_with_vars.ml +++ b/src/string_with_vars.ml @@ -142,6 +142,14 @@ let invalid_multivalue syntax ~var t x = Please quote this atom." (string_of_var syntax var) (List.length x) +let expand_var syntax ~var ~dir ~f t = + match f t.loc var, t.quoted with + | Some ([] | _::_::_ as e) , false -> + invalid_multivalue syntax ~var t e + | Some ([_] as t), false + | Some t, true -> Some (Value.to_strings ~dir t) + | None, _ -> None + let expand t ~mode ~dir ~f = match t.items with | [Var (syntax, v)] when not t.quoted -> @@ -159,12 +167,9 @@ let expand t ~mode ~dir ~f = List.concat_map t.items ~f:(function | Text s -> [s] | Var (syntax, v) -> - begin match f t.loc v, t.quoted with - | Some ([] | _::_::_ as e) , false -> - invalid_multivalue syntax ~var:v t e - | Some ([_] as t), false - | Some t, true -> Value.to_strings ~dir t - | None, _ -> [string_of_var syntax v] + begin match expand_var syntax ~var:v ~dir ~f t with + | Some values -> values + | None -> [string_of_var syntax v] end) |> String.concat ~sep:"") @@ -182,11 +187,8 @@ let partial_expand t ~mode ~dir ~f = end | Text s :: items -> loop (s :: acc_text) acc items | Var (syntax, v) as it :: items -> - begin match f t.loc v with - | Some (([] | _::_) as e) when not t.quoted -> - invalid_multivalue syntax ~var:v t e - | Some t -> - loop (List.rev_append (Value.to_strings ~dir t) acc_text) acc items + begin match expand_var syntax ~var:v ~dir ~f t with + | Some values -> loop (List.rev_append values acc_text) acc items | None -> loop [] (it :: commit_text acc_text acc) items end in From 9221b1ed6cc0a8431e2bbdac6698ede72d5b70e3 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 6 Jun 2018 02:02:56 +0700 Subject: [PATCH 13/23] Change echo to be variadic Signed-off-by: Rudi Grinberg --- src/action.ml | 22 ++++++++++++---------- src/action_intf.ml | 4 ++-- src/stdune/string.ml | 5 +++++ src/value.ml | 4 ++++ src/value.mli | 2 ++ test/blackbox-tests/test-cases/misc/run.t | 5 +---- 6 files changed, 26 insertions(+), 16 deletions(-) diff --git a/src/action.ml b/src/action.ml index c2ef1c7f..8c4c2d66 100644 --- a/src/action.ml +++ b/src/action.ml @@ -34,7 +34,7 @@ struct ; cstr "ignore-stderr" (t @> nil) (fun t -> Ignore (Stderr, t)) ; cstr "ignore-outputs" (t @> nil) (fun t -> Ignore (Outputs, t)) ; cstr "progn" (rest t) (fun l -> Progn l) - ; cstr "echo" (string @> nil) (fun x -> Echo x) + ; cstr "echo" (string @> rest string) (fun x xs -> Echo (x::xs)) ; cstr "cat" (path @> nil) (fun x -> Cat x) ; cstr "copy" (path @> path @> nil) (fun src dst -> Copy (src, dst)) (* @@ -78,7 +78,8 @@ struct ] | Progn l -> List (Sexp.unsafe_atom_of_string "progn" :: List.map l ~f:sexp_of_t) - | Echo x -> List [Sexp.unsafe_atom_of_string "echo"; string x] + | Echo xs -> + List (Sexp.unsafe_atom_of_string "echo" :: List.map xs ~f:string) | Cat x -> List [Sexp.unsafe_atom_of_string "cat"; path x] | Copy (x, y) -> List [Sexp.unsafe_atom_of_string "copy"; path x; path y] @@ -150,7 +151,7 @@ module Make_mapper | Ignore (outputs, t) -> Ignore (outputs, map t ~dir ~f_program ~f_string ~f_path) | Progn l -> Progn (List.map l ~f:(fun t -> map t ~dir ~f_program ~f_string ~f_path)) - | Echo x -> Echo (f_string ~dir x) + | Echo xs -> Echo (List.map xs ~f:(f_string ~dir)) | Cat x -> Cat (f_path ~dir x) | Copy (x, y) -> Copy (f_path ~dir x, f_path ~dir y) | Symlink (x, y) -> @@ -365,7 +366,7 @@ module Unexpanded = struct | Ignore (outputs, t) -> Ignore (outputs, expand t ~dir ~map_exe ~f) | Progn l -> Progn (List.map l ~f:(fun t -> expand t ~dir ~map_exe ~f)) - | Echo x -> Echo (E.string ~dir ~f x) + | Echo xs -> Echo (List.concat_map xs ~f:(E.strings ~dir ~f)) | Cat x -> Cat (E.path ~dir ~f x) | Copy (x, y) -> Copy (E.path ~dir ~f x, E.path ~dir ~f y) @@ -408,12 +409,13 @@ module Unexpanded = struct | Expanded e -> Left (map e ~dir) | Unexpanded x -> Right x - let string = expand ~mode:Single ~map:(Value.to_string) - let strings = expand ~mode:Many ~map:(Value.to_strings) + let string = expand ~mode:Single ~map:Value.to_string + let strings = expand ~mode:Many ~map:Value.to_strings + let cat_strings = expand ~mode:Many ~map:Value.concat let path x = let error_loc = String_with_vars.loc x in expand ~mode:Single ~map:(Value.to_path ~error_loc) x - let prog_and_args = expand ~mode:Many ~map:(prog_and_args_of_values) + let prog_and_args = expand ~mode:Many ~map:prog_and_args_of_values end let rec partial_expand t ~dir ~map_exe ~f : Partial.t = @@ -457,7 +459,7 @@ module Unexpanded = struct | Ignore (outputs, t) -> Ignore (outputs, partial_expand t ~dir ~map_exe ~f) | Progn l -> Progn (List.map l ~f:(fun t -> partial_expand t ~dir ~map_exe ~f)) - | Echo x -> Echo (E.string ~dir ~f x) + | Echo xs -> Echo (List.map xs ~f:(E.cat_strings ~dir ~f)) | Cat x -> Cat (E.path ~dir ~f x) | Copy (x, y) -> Copy (E.path ~dir ~f x, E.path ~dir ~f y) @@ -686,7 +688,7 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to = exec t ~ectx ~dir ~stdout_to ~stderr_to ~env:(Env.add env ~var ~value) | Redirect (Stdout, fn, Echo s) -> - Io.write_file fn s; + Io.write_file fn (String.concat s ~sep:" "); Fiber.return () | Redirect (outputs, fn, Run (Ok prog, args)) -> let out = Process.File fn in @@ -703,7 +705,7 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to = redirect ~ectx ~dir outputs Config.dev_null t ~env ~stdout_to ~stderr_to | Progn l -> exec_list l ~ectx ~dir ~env ~stdout_to ~stderr_to - | Echo str -> exec_echo stdout_to str + | Echo strs -> exec_echo stdout_to (String.concat strs ~sep:" ") | Cat fn -> Io.with_file_in fn ~f:(fun ic -> let oc = diff --git a/src/action_intf.ml b/src/action_intf.ml index c5c76f72..9c7c663f 100644 --- a/src/action_intf.ml +++ b/src/action_intf.ml @@ -29,7 +29,7 @@ module type Ast = sig | Redirect of Outputs.t * path * t | Ignore of Outputs.t * t | Progn of t list - | Echo of string + | Echo of string list | Cat of path | Copy of path * path | Symlink of path * path @@ -61,7 +61,7 @@ module type Helpers = sig val ignore_stderr : t -> t val ignore_outputs : t -> t val progn : t list -> t - val echo : string -> t + val echo : string list -> t val cat : path -> t val copy : path -> path -> t val symlink : path -> path -> t diff --git a/src/stdune/string.ml b/src/stdune/string.ml index 16a3c9f1..bc7e87f9 100644 --- a/src/stdune/string.ml +++ b/src/stdune/string.ml @@ -214,3 +214,8 @@ let enumerate_gen s = let enumerate_and = enumerate_gen "and" let enumerate_or = enumerate_gen "or" + +let concat ~sep = function + | [] -> "" + | [x] -> x + | xs -> concat ~sep xs diff --git a/src/value.ml b/src/value.ml index f8cf5828..0eb9b3e3 100644 --- a/src/value.ml +++ b/src/value.ml @@ -21,6 +21,10 @@ let to_path ?error_loc t ~dir = let strings = List.map ~f:(fun x -> String x) let paths = List.map ~f:(fun x -> Path x) +let concat ts ~dir = + List.map ~f:(to_string ~dir) ts + |> String.concat ~sep:" " + let paths_only = List.filter_map ~f:(function | String _ -> None diff --git a/src/value.mli b/src/value.mli index 72226e21..de89de48 100644 --- a/src/value.mli +++ b/src/value.mli @@ -15,3 +15,5 @@ val strings : string list -> t list val paths : Path.t list -> t list val paths_only : t list -> Path.t list + +val concat : t list -> dir:Path.t -> string diff --git a/test/blackbox-tests/test-cases/misc/run.t b/test/blackbox-tests/test-cases/misc/run.t index fffc64b1..514d25e7 100644 --- a/test/blackbox-tests/test-cases/misc/run.t +++ b/test/blackbox-tests/test-cases/misc/run.t @@ -2,9 +2,6 @@ File "dune", line 65, characters 21-44: Warning: Directory dir-that-doesnt-exist doesn't exist. No rule found for jbuild - 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 diff alias runtest [1] From 774306c396085d50000792a49d57316aa3f1f00d Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 6 Jun 2018 02:39:10 +0700 Subject: [PATCH 14/23] Remove old usage for Var_expansion in ppx driver Signed-off-by: Rudi Grinberg --- src/preprocessing.ml | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/preprocessing.ml b/src/preprocessing.ml index d8461be8..5bb68740 100644 --- a/src/preprocessing.ml +++ b/src/preprocessing.ml @@ -475,8 +475,7 @@ let lint_module sctx ~dir ~dep_kind ~lint ~lib_name ~scope ~dir_kind = >>| fun (exe, driver) -> (exe, let extra_vars = - String_map.singleton "corrected-suffix" - (Action.Var_expansion.Strings ([corrected_suffix], Split)) + String_map.singleton "corrected-suffix" [Value.String corrected_suffix] in Build.memoize "ppx flags" (SC.expand_and_eval_set sctx driver.info.lint_flags @@ -558,8 +557,7 @@ let make sctx ~dir ~dep_kind ~lint ~preprocess get_ppx_driver sctx ~loc ~scope ~dir_kind pps >>| fun (exe, driver) -> (exe, let extra_vars = - String_map.singleton "corrected-suffix" - (Action.Var_expansion.Strings ([corrected_suffix], Split)) + String_map.singleton "corrected-suffix" [Value.String corrected_suffix] in Build.memoize "ppx flags" (SC.expand_and_eval_set sctx driver.info.flags From 124d94231064d383929524ba7da357f31b076d69 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Wed, 6 Jun 2018 12:03:21 +0100 Subject: [PATCH 15/23] s/jbuild/dune/ in misc test Signed-off-by: Jeremie Dimino --- test/blackbox-tests/test-cases/misc/dune | 10 ++++------ test/blackbox-tests/test-cases/misc/run.t | 6 +++--- 2 files changed, 7 insertions(+), 9 deletions(-) diff --git a/test/blackbox-tests/test-cases/misc/dune b/test/blackbox-tests/test-cases/misc/dune index 8629755f..c2620964 100644 --- a/test/blackbox-tests/test-cases/misc/dune +++ b/test/blackbox-tests/test-cases/misc/dune @@ -1,13 +1,11 @@ -(jbuild_version 1) - ;; Test for ${^} with globs in rules (rule ((targets (result expected)) - (deps (jbuild (glob_files *.txt))) + (deps (dune (glob_files *.txt))) (action (progn (with-stdout-to result (echo ${^})) - (with-stdout-to expected (echo "jbuild a.txt b.txt c.txt")))))) + (with-stdout-to expected (echo "dune a.txt b.txt c.txt")))))) (rule ((targets (result2 expected2)) @@ -28,11 +26,11 @@ ;; Test inferred rules -(rule (copy jbuild jbuild-plop)) +(rule (copy dune dune-plop)) (alias ((name runtest) - (deps (jbuild jbuild-plop)) + (deps (dune dune-plop)) (action (run diff -u ${^})))) ;; For some tests in subdirs diff --git a/test/blackbox-tests/test-cases/misc/run.t b/test/blackbox-tests/test-cases/misc/run.t index 514d25e7..42a23831 100644 --- a/test/blackbox-tests/test-cases/misc/run.t +++ b/test/blackbox-tests/test-cases/misc/run.t @@ -1,7 +1,7 @@ $ dune runtest --display short - File "dune", line 65, characters 21-44: + File "dune", line 63, characters 21-44: Warning: Directory dir-that-doesnt-exist doesn't exist. - No rule found for jbuild diff alias runtest diff alias runtest - [1] + diff alias runtest + diff alias runtest From 243f3437f248061fb891e261051a936954d8ead6 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 6 Jun 2018 19:30:03 +0700 Subject: [PATCH 16/23] implement expand in terms of partial_expand Signed-off-by: Rudi Grinberg --- src/string_with_vars.ml | 40 +++++++++++++++------------------------- 1 file changed, 15 insertions(+), 25 deletions(-) diff --git a/src/string_with_vars.ml b/src/string_with_vars.ml index bcecebbb..28aa90dc 100644 --- a/src/string_with_vars.ml +++ b/src/string_with_vars.ml @@ -143,36 +143,13 @@ let invalid_multivalue syntax ~var t x = (string_of_var syntax var) (List.length x) let expand_var syntax ~var ~dir ~f t = - match f t.loc var, t.quoted with + match f syntax t.loc var, t.quoted with | Some ([] | _::_::_ as e) , false -> invalid_multivalue syntax ~var t e | Some ([_] as t), false | Some t, true -> Some (Value.to_strings ~dir t) | None, _ -> None -let expand t ~mode ~dir ~f = - match t.items with - | [Var (syntax, v)] when not t.quoted -> - (* Unquoted single var *) - begin match f t.loc v with - | Some e -> - begin match Mode.value mode e with - | None -> invalid_multivalue syntax ~var:v t e - | Some s -> s - end - | None -> Mode.string mode (string_of_var syntax v) - end - | _ -> - Mode.string mode ( - List.concat_map t.items ~f:(function - | Text s -> [s] - | Var (syntax, v) -> - begin match expand_var syntax ~var:v ~dir ~f t with - | Some values -> values - | None -> [string_of_var syntax v] - end) - |> String.concat ~sep:"") - let partial_expand t ~mode ~dir ~f = let commit_text acc_text acc = let s = concat_rev acc_text in @@ -195,7 +172,7 @@ let partial_expand t ~mode ~dir ~f = match t.items with | [Var (syntax, v)] when not t.quoted -> (* Unquoted single var *) - begin match f t.loc v with + begin match f syntax t.loc v with | Some e -> Partial.Expanded ( match Mode.value mode e with | None -> invalid_multivalue syntax ~var:v t e @@ -204,6 +181,19 @@ let partial_expand t ~mode ~dir ~f = end | _ -> loop [] [] t.items +let expand t ~mode ~dir ~f = + match + partial_expand t ~mode ~dir ~f:(fun syntax loc var -> + match f loc var with + | None -> Some [Value.String (string_of_var syntax var)] + | s -> s) + with + | Partial.Expanded s -> s + | Unexpanded _ -> assert false (* we are expanding every variable *) + +let partial_expand t ~mode ~dir ~f = + partial_expand t ~mode ~dir ~f:(fun _ loc v -> f loc v) + let to_string t = match t.items with (* [to_string is only called from action.ml, always on [t]s of this form *) From 9cc8ff920a1fa88d05f9581977de6f483e980e94 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 6 Jun 2018 19:35:04 +0700 Subject: [PATCH 17/23] Special case t.items = [Text _] and t.items = [] Signed-off-by: Rudi Grinberg --- src/string_with_vars.ml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/string_with_vars.ml b/src/string_with_vars.ml index 28aa90dc..0ed7a62c 100644 --- a/src/string_with_vars.ml +++ b/src/string_with_vars.ml @@ -170,6 +170,8 @@ let partial_expand t ~mode ~dir ~f = end in match t.items with + | [] -> Partial.Expanded (Mode.string mode "") + | [Text s] -> Expanded (Mode.string mode s) | [Var (syntax, v)] when not t.quoted -> (* Unquoted single var *) begin match f syntax t.loc v with From c96df4dc1528ba07de851f524ea5e9ae96519069 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 6 Jun 2018 20:14:10 +0700 Subject: [PATCH 18/23] Inline expand_var Signed-off-by: Rudi Grinberg --- src/string_with_vars.ml | 17 ++++++----------- 1 file changed, 6 insertions(+), 11 deletions(-) diff --git a/src/string_with_vars.ml b/src/string_with_vars.ml index 0ed7a62c..be89e754 100644 --- a/src/string_with_vars.ml +++ b/src/string_with_vars.ml @@ -142,14 +142,6 @@ let invalid_multivalue syntax ~var t x = Please quote this atom." (string_of_var syntax var) (List.length x) -let expand_var syntax ~var ~dir ~f t = - match f syntax t.loc var, t.quoted with - | Some ([] | _::_::_ as e) , false -> - invalid_multivalue syntax ~var t e - | Some ([_] as t), false - | Some t, true -> Some (Value.to_strings ~dir t) - | None, _ -> None - let partial_expand t ~mode ~dir ~f = let commit_text acc_text acc = let s = concat_rev acc_text in @@ -163,9 +155,12 @@ let partial_expand t ~mode ~dir ~f = | _ -> Unexpanded { t with items = List.rev (commit_text acc_text acc) } end | Text s :: items -> loop (s :: acc_text) acc items - | Var (syntax, v) as it :: items -> - begin match expand_var syntax ~var:v ~dir ~f t with - | Some values -> loop (List.rev_append values acc_text) acc items + | Var (syntax, var) as it :: items -> + begin match f syntax t.loc var with + | Some ([] | _::_::_ as e) when not t.quoted -> + invalid_multivalue syntax ~var t e + | Some t -> + loop (List.rev_append (Value.to_strings ~dir t) acc_text) acc items | None -> loop [] (it :: commit_text acc_text acc) items end in From 6ebff9d388ef9489ee71427c6adf48447e0c5ec6 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 6 Jun 2018 21:34:47 +0700 Subject: [PATCH 19/23] Move Value.t list functions to Value.L Signed-off-by: Rudi Grinberg --- src/action.ml | 10 +++++----- src/inline_tests.ml | 2 +- src/string_with_vars.ml | 2 +- src/super_context.ml | 14 +++++++------- src/value.ml | 25 ++++++++++++++----------- src/value.mli | 14 ++++++++------ 6 files changed, 36 insertions(+), 31 deletions(-) diff --git a/src/action.ml b/src/action.ml index 8c4c2d66..63a0e0b8 100644 --- a/src/action.ml +++ b/src/action.ml @@ -274,9 +274,9 @@ end let prog_and_args_of_values p ~dir = match p with | [] -> (Unresolved.Program.Search "", []) - | Value.Path p :: xs -> (This p, Value.to_strings ~dir xs) + | Value.Path p :: xs -> (This p, Value.L.to_strings ~dir xs) | String s :: xs -> - (Unresolved.Program.of_string ~dir s, Value.to_strings ~dir xs) + (Unresolved.Program.of_string ~dir s, Value.L.to_strings ~dir xs) module SW = String_with_vars @@ -327,7 +327,7 @@ module Unexpanded = struct let strings = expand ~mode:Many ~l:(fun x -> [x]) - ~r:Value.to_strings + ~r:Value.L.to_strings let path e = let error_loc = @@ -410,8 +410,8 @@ module Unexpanded = struct | Unexpanded x -> Right x let string = expand ~mode:Single ~map:Value.to_string - let strings = expand ~mode:Many ~map:Value.to_strings - let cat_strings = expand ~mode:Many ~map:Value.concat + let strings = expand ~mode:Many ~map:Value.L.to_strings + let cat_strings = expand ~mode:Many ~map:Value.L.concat let path x = let error_loc = String_with_vars.loc x in expand ~mode:Single ~map:(Value.to_path ~error_loc) x diff --git a/src/inline_tests.ml b/src/inline_tests.ml index 3c202834..2b140231 100644 --- a/src/inline_tests.ml +++ b/src/inline_tests.ml @@ -209,7 +209,7 @@ include Sub_system.Register_end_point( let target = Path.relative inline_test_dir main_module_filename in let source_modules = Module.Name.Map.values source_modules in let files ml_kind = - Value.paths ( + Value.L.paths ( List.filter_map source_modules ~f:(fun m -> Module.file m ~dir ml_kind)) in diff --git a/src/string_with_vars.ml b/src/string_with_vars.ml index be89e754..e63d4876 100644 --- a/src/string_with_vars.ml +++ b/src/string_with_vars.ml @@ -160,7 +160,7 @@ let partial_expand t ~mode ~dir ~f = | Some ([] | _::_::_ as e) when not t.quoted -> invalid_multivalue syntax ~var t e | Some t -> - loop (List.rev_append (Value.to_strings ~dir t) acc_text) acc items + loop (List.rev_append (Value.L.to_strings ~dir t) acc_text) acc items | None -> loop [] (it :: commit_text acc_text acc) items end in diff --git a/src/super_context.ml b/src/super_context.ml index 1cc820a0..bf93fb09 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -287,7 +287,7 @@ let create | Some p -> path p in let cflags = context.ocamlc_cflags in - let strings = Value.strings in + let strings = Value.L.strings in let vars = [ "-verbose" , [] ; "CPP" , strings (context.c_compiler :: cflags @ ["-E"]) @@ -707,7 +707,7 @@ module Action = struct let path = Path.relative dir s in let data = Build.lines_of path - >>^ Value.strings + >>^ Value.L.strings in add_ddep acc ~key data end @@ -715,7 +715,7 @@ module Action = struct let path = Path.relative dir s in let data = Build.strings path - >>^ Value.strings + >>^ Value.L.strings in add_ddep acc ~key data end @@ -737,7 +737,7 @@ module Action = struct match targets_written_by_user with | Infer -> Loc.fail loc "You cannot use ${@} with inferred rules." | Alias -> Loc.fail loc "You cannot use ${@} in aliases." - | Static l -> Some (Value.paths l) + | Static l -> Some (Value.L.paths l) end | _ -> match String.lsplit2 var ~on:':' with @@ -746,8 +746,8 @@ module Action = struct | x -> let exp = expand loc key var x in Option.iter exp ~f:(fun vs -> - acc.sdeps <- - Path.Set.union (Path.Set.of_list (Value.paths_only vs)) acc.sdeps; + acc.sdeps <- Path.Set.union (Path.Set.of_list + (Value.L.paths_only vs)) acc.sdeps; ); exp) in @@ -769,7 +769,7 @@ module Action = struct [Value.String ""] | dep :: _ -> [Path dep]) - | "^" -> Some (Value.paths deps_written_by_user) + | "^" -> Some (Value.L.paths deps_written_by_user) | _ -> None) let run sctx ~loc ?(extra_vars=String.Map.empty) diff --git a/src/value.ml b/src/value.ml index 0eb9b3e3..9d8cf9fd 100644 --- a/src/value.ml +++ b/src/value.ml @@ -11,21 +11,24 @@ let to_string t ~dir = | String s -> s | Path p -> string_of_path ~dir p -let to_strings t ~dir = List.map t ~f:(to_string ~dir) - let to_path ?error_loc t ~dir = match t with | String s -> Path.relative ?error_loc dir s | Path p -> p -let strings = List.map ~f:(fun x -> String x) -let paths = List.map ~f:(fun x -> Path x) +module L = struct + let to_strings t ~dir = List.map t ~f:(to_string ~dir) -let concat ts ~dir = - List.map ~f:(to_string ~dir) ts - |> String.concat ~sep:" " + let concat ts ~dir = + List.map ~f:(to_string ~dir) ts + |> String.concat ~sep:" " -let paths_only = - List.filter_map ~f:(function - | String _ -> None - | Path p -> Some p) + let paths_only = + List.filter_map ~f:(function + | String _ -> None + | Path p -> Some p) + + let strings = List.map ~f:(fun x -> String x) + + let paths = List.map ~f:(fun x -> Path x) +end diff --git a/src/value.mli b/src/value.mli index de89de48..d2a7b845 100644 --- a/src/value.mli +++ b/src/value.mli @@ -6,14 +6,16 @@ type t = val to_string : t -> dir:Path.t -> string -val to_strings : t list -> dir:Path.t -> string list - val to_path : ?error_loc:Loc.t -> t -> dir:Path.t -> Path.t -val strings : string list -> t list +module L : sig + val strings : string list -> t list -val paths : Path.t list -> t list + val paths : Path.t list -> t list -val paths_only : t list -> Path.t list + val paths_only : t list -> Path.t list -val concat : t list -> dir:Path.t -> string + val concat : t list -> dir:Path.t -> string + + val to_strings : t list -> dir:Path.t -> string list +end From 7d8a7e94aa6a09bf21a662abec15784340bf0a64 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 6 Jun 2018 21:38:01 +0700 Subject: [PATCH 20/23] Fix incorrect concatenation for multivalues in quoted context Signed-off-by: Rudi Grinberg --- src/string_with_vars.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/string_with_vars.ml b/src/string_with_vars.ml index e63d4876..17dfa664 100644 --- a/src/string_with_vars.ml +++ b/src/string_with_vars.ml @@ -160,7 +160,7 @@ let partial_expand t ~mode ~dir ~f = | Some ([] | _::_::_ as e) when not t.quoted -> invalid_multivalue syntax ~var t e | Some t -> - loop (List.rev_append (Value.L.to_strings ~dir t) acc_text) acc items + loop (Value.L.concat ~dir t :: acc_text) acc items | None -> loop [] (it :: commit_text acc_text acc) items end in From bdeef73c29ff2bb6b7b1506061d9ef8e352d4ea8 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 6 Jun 2018 21:42:53 +0700 Subject: [PATCH 21/23] Add test for proper concatenation Signed-off-by: Rudi Grinberg --- test/blackbox-tests/test-cases/quoting/quotes-multi/dune | 4 ++++ test/blackbox-tests/test-cases/quoting/quotes-multi/foo | 3 +++ test/blackbox-tests/test-cases/quoting/run.t | 3 +++ 3 files changed, 10 insertions(+) create mode 100644 test/blackbox-tests/test-cases/quoting/quotes-multi/dune create mode 100644 test/blackbox-tests/test-cases/quoting/quotes-multi/foo diff --git a/test/blackbox-tests/test-cases/quoting/quotes-multi/dune b/test/blackbox-tests/test-cases/quoting/quotes-multi/dune new file mode 100644 index 00000000..3e834869 --- /dev/null +++ b/test/blackbox-tests/test-cases/quoting/quotes-multi/dune @@ -0,0 +1,4 @@ + +(alias + ((name runtest) + (action (echo "lines: ${read-lines:foo}")))) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/quoting/quotes-multi/foo b/test/blackbox-tests/test-cases/quoting/quotes-multi/foo new file mode 100644 index 00000000..98a86f9e --- /dev/null +++ b/test/blackbox-tests/test-cases/quoting/quotes-multi/foo @@ -0,0 +1,3 @@ +foo +bar +baz \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/quoting/run.t b/test/blackbox-tests/test-cases/quoting/run.t index 17015512..a9e3c98b 100644 --- a/test/blackbox-tests/test-cases/quoting/run.t +++ b/test/blackbox-tests/test-cases/quoting/run.t @@ -25,3 +25,6 @@ The targets should only be interpreted as a single path when quoted Entering directory 'quote-from-context' count_args alias runtest Number of args: 3 + + $ dune runtest --root quotes-multi 2>&1 | grep -v Entering + lines: foo bar baz From abfa90b5a722b4b9926e0f00721e0be2a091a206 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 6 Jun 2018 23:43:34 +0700 Subject: [PATCH 22/23] Update tests Signed-off-by: Rudi Grinberg --- test/blackbox-tests/test-cases/quoting/run.t | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/test/blackbox-tests/test-cases/quoting/run.t b/test/blackbox-tests/test-cases/quoting/run.t index a9e3c98b..4dd78f7b 100644 --- a/test/blackbox-tests/test-cases/quoting/run.t +++ b/test/blackbox-tests/test-cases/quoting/run.t @@ -3,14 +3,9 @@ that ${@} is not quoted and doesn't contain exactly 1 element $ dune build --root bad x Entering directory 'bad' - Error: Rule failed to generate the following targets: - - x - - 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. + [1] The targets should only be interpreted as a single path when quoted @@ -26,5 +21,6 @@ The targets should only be interpreted as a single path when quoted count_args alias runtest Number of args: 3 - $ dune runtest --root quotes-multi 2>&1 | grep -v Entering + $ dune runtest --root quotes-multi + Entering directory 'quotes-multi' lines: foo bar baz From a7ada1ddb94d26b2573cccbfc7fc0375961cb110 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 7 Jun 2018 15:35:25 +0700 Subject: [PATCH 23/23] Update CHANGES for the quoting issue Signed-off-by: Rudi Grinberg --- CHANGES.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 8f158a1b..7d9f0d96 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -62,6 +62,10 @@ next - Make the output of Dune slightly more deterministic when run from inside Dune (#855, @diml) +- Simplify quoting behavior of variables. All values are now multi-valued and + whether a multi valued variable is allowed is determined by the quoting and + substitution context it appears in. (#849, fix #701, @rgrinberg) + 1.0+beta20 (10/04/2018) -----------------------