From a91cf637ae9bb60be627579c49f83efcbd782a1e Mon Sep 17 00:00:00 2001 From: Christophe Troestler Date: Thu, 1 Feb 2018 23:45:30 +0100 Subject: [PATCH] Trigger an error for unquoted concatenations with list variables Thus x${v} where v is a variable that returns several values must necessarily be quoted: "x${v}". --- src/action.ml | 72 +++++++++++++++++++++------------------- src/action.mli | 6 ++-- src/string_with_vars.ml | 72 ++++++++++++++++++++++++++++------------ src/string_with_vars.mli | 53 +++++++++++++++++++---------- src/super_context.ml | 11 ++---- 5 files changed, 130 insertions(+), 84 deletions(-) diff --git a/src/action.ml b/src/action.ml index 0503502d..c9dcf678 100644 --- a/src/action.ml +++ b/src/action.ml @@ -272,20 +272,29 @@ module Var_expansion = struct | Paths of Path.t list * Concat_or_split.t | Strings of string list * Concat_or_split.t + let is_multivalued = function + | Paths (_, Split) | Strings (_, Split) -> true + | Paths (_, Concat) | Strings (_, Concat) -> false + let concat = function | [s] -> s | l -> String.concat ~sep:" " l + let to_string = function + | Strings (l, _) -> concat l + | Paths (l, _) -> concat (List.map l ~f:Path.to_string) + + (* Relative to [dir]. *) 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 + let to_strings_rel ~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))] - let to_string ~dir = function + let to_string_rel ~dir = function | Strings (l, _) -> concat l | Paths (l, _) -> concat (List.map l ~f:(string_of_path ~dir)) @@ -352,29 +361,27 @@ module Unexpanded = struct include Past module E = struct - let string ~dir ~f = function - | Inl x -> x - | Inr template -> - SW.expand template ~f:(fun loc var -> - match f loc var with - | None -> None - | Some e -> Some (VE.to_string ~dir e)) - let expand ~generic ~special ~map ~dir ~f = function | Inl x -> map x - | Inr template as x -> - match SW.unquoted_var template with - | None -> generic ~dir (string ~dir ~f x) - | Some var -> - match f (SW.loc template) var with - | None -> generic ~dir (SW.to_string template) - | Some e -> special ~dir e + | Inr template -> + match SW.expand_generic template ~f + ~is_multivalued:VE.is_multivalued + ~to_string:(VE.to_string_rel ~dir) + with + | Inl e -> special ~dir e + | Inr s -> generic ~dir s [@@inlined always] + let string ~dir ~f x = + expand ~dir ~f x + ~generic:(fun ~dir:_ x -> x) + ~special:VE.to_string_rel + ~map:(fun x -> x) + let strings ~dir ~f x = expand ~dir ~f x ~generic:(fun ~dir:_ x -> [x]) - ~special:VE.to_strings + ~special:VE.to_strings_rel ~map:(fun x -> [x]) let path ~dir ~f x = @@ -445,28 +452,23 @@ module Unexpanded = struct end module E = struct - let string ~dir ~f template = - SW.partial_expand template ~f:(fun loc var -> - match f loc var with - | None -> None - | Some e -> Some (VE.to_string ~dir e)) - let expand ~generic ~special ~dir ~f template = - match SW.unquoted_var template with - | None -> begin - match string ~dir ~f template with - | Inl x -> Inl (generic ~dir x) - | Inr _ as x -> x - end - | Some var -> - match f (SW.loc template) var with - | None -> Inr template - | Some e -> Inl (special ~dir e) + match SW.partial_expand_generic template ~f + ~is_multivalued:VE.is_multivalued + ~to_string:(VE.to_string_rel ~dir) with + | Inl (Inl e) -> Inl(special ~dir e) + | Inl (Inr s) -> Inl(generic ~dir s) + | Inr _ as x -> x + + let string ~dir ~f x = + expand ~dir ~f x + ~generic:(fun ~dir:_ x -> x) + ~special:VE.to_string_rel let strings ~dir ~f x = expand ~dir ~f x ~generic:(fun ~dir:_ x -> [x]) - ~special:VE.to_strings + ~special:VE.to_strings_rel let path ~dir ~f x = expand ~dir ~f x diff --git a/src/action.mli b/src/action.mli index 93a77c73..e9cb8f2f 100644 --- a/src/action.mli +++ b/src/action.mli @@ -3,13 +3,15 @@ open! Import module Var_expansion : sig module Concat_or_split : sig type t = - | Concat (* default *) - | Split (* the variable is a "split" list of items *) + | 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 + + val to_string : t -> string end module Outputs : module type of struct include Action_intf.Outputs end diff --git a/src/string_with_vars.ml b/src/string_with_vars.ml index 30b4eeb3..b0ceeec1 100644 --- a/src/string_with_vars.ml +++ b/src/string_with_vars.ml @@ -59,11 +59,6 @@ let rec of_tokens : Token.t list -> item list = function let items_of_string s = of_tokens (Token.tokenise s) -let unquoted_var t = - match t.quoted, t.items with - | true, [Var(_, s)] -> Some s - | _ -> None - let t : Sexp.Of_sexp.ast -> t = function | Atom(loc, s) -> { items = items_of_string s; loc; quoted = false } | Quoted_string (loc, s) -> @@ -72,9 +67,9 @@ let t : Sexp.Of_sexp.ast -> t = function let loc t = t.loc -let virt ?(quoted=true) pos s = +let virt ?(quoted=false) pos s = { items = items_of_string s; loc = Loc.of_pos pos; quoted } -let virt_var ?(quoted=true) pos s = +let virt_var ?(quoted=false) pos s = { items = [Var (Braces, s)]; loc = Loc.of_pos pos; quoted } let virt_text pos s = { items = [Text s]; loc = Loc.of_pos pos; quoted = true } @@ -108,21 +103,41 @@ let string_of_var syntax v = | Parens -> sprintf "$(%s)" v | Braces -> sprintf "${%s}" v +let expand_generic t ~f ~is_multivalued ~to_string = + match t.items with + | [Var (syntax, v)] when not t.quoted -> + (* Unquoted single var *) + (match f t.loc v with + | Some e -> Inl e + | None -> Inr(string_of_var syntax v)) + | _ -> + Inr(List.map t.items ~f:(function + | Text s -> s + | Var (syntax, v) -> + match f t.loc v with + | Some x -> + if not t.quoted && is_multivalued x then + Loc.fail t.loc "please quote the string \ + containing the list variable %s" + (string_of_var syntax v) + else to_string x + | None -> string_of_var syntax v) + |> String.concat ~sep:"") + +let always_false _ = false +let identity_string (s: string) = s + let expand t ~f = - List.map t.items ~f:(function - | Text s -> s - | Var (syntax, v) -> - match f t.loc v with - | Some x -> x - | None -> string_of_var syntax v) - |> String.concat ~sep:"" + match expand_generic t ~f ~is_multivalued:always_false + ~to_string:identity_string with + | Inl s | Inr s -> s let concat_rev = function | [] -> "" | [s] -> s | l -> String.concat (List.rev l) ~sep:"" -let partial_expand t ~f = +let partial_expand_generic t ~f ~is_multivalued ~to_string = let commit_text acc_text acc = let s = concat_rev acc_text in if s = "" then acc else Text s :: acc @@ -131,17 +146,32 @@ let partial_expand t ~f = match items with | [] -> begin match acc with - | [] -> Inl (concat_rev acc_text) - | _ -> - Inr { t with items = List.rev (commit_text acc_text acc) } + | [] -> Inl (Inr(concat_rev acc_text)) + | _ -> Inr { t with items = List.rev (commit_text acc_text acc) } end | Text s :: items -> loop (s :: acc_text) acc items - | Var (_, v) as it :: items -> + | Var (syntax, v) as it :: items -> match f t.loc v with | None -> loop [] (it :: commit_text acc_text acc) items - | Some s -> loop (s :: acc_text) acc items + | Some x -> + if not t.quoted && is_multivalued x then + Loc.fail t.loc "please quote the string containing the \ + list variable %s" (string_of_var syntax v) + else loop (to_string x :: acc_text) acc items in - loop [] [] t.items + match t.items with + | [Var (_, v)] when not t.quoted -> + (* Unquoted single var *) + (match f t.loc v with + | Some e -> Inl (Inl e) + | None -> Inr t) + | _ -> loop [] [] t.items + +let partial_expand t ~f = + match partial_expand_generic t ~f ~is_multivalued:always_false + ~to_string:identity_string with + | Inl(Inl s | Inr s) -> Inl s + | Inr _ as x -> x let to_string t = match t.items with diff --git a/src/string_with_vars.mli b/src/string_with_vars.mli index 5249f8cf..a14cfc6a 100644 --- a/src/string_with_vars.mli +++ b/src/string_with_vars.mli @@ -22,15 +22,12 @@ val to_string : t -> string (** [t] generated by the OCaml code. The first argument should be [__POS__]. The second is either a string to parse, a variable name - or plain text. *) + or plain text. [quoted] says whether the string is quoted ([false] + by default). *) val virt : ?quoted: bool -> (string * int * int * int) -> string -> t val virt_var : ?quoted: bool -> (string * int * int * int) -> string -> t val virt_text : (string * int * int * int) -> string -> t -val unquoted_var : t -> string option -(** [unquoted_var t] return the [Some name] where [name] is the name of - the variable if [t] is solely made of a variable and [None] otherwise. *) - val vars : t -> String_set.t (** [vars t] returns the set of all variables in [t]. *) @@ -42,18 +39,38 @@ val iter : t -> f:(Loc.t -> string -> unit) -> unit (** [iter t ~f] iterates [f] over all variables of [t], the text portions being ignored. *) -val expand : t -> f:(Loc.t -> string -> string option) -> string -(** [expand t ~f] return [t] where all variables have been expanded - using [f]. If [f] returns [Some x], the variable is replaced by - [x]; if [f] returns [None], the variable is inserted as [${v}] or - [$(v)] — depending on the original concrete syntax used — where [v] - is the name if the variable. *) +val expand_generic : + t -> f:(Loc.t -> string -> 'a option) -> is_multivalued:('a -> bool) -> + to_string:('a -> string) -> ('a, string) either +(** [expand_generic 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 as [${var}] or + [$(var)] — depending on the original concrete syntax used. -val partial_expand : t -> f:(Loc.t -> string -> string option) - -> (string, t) either -(** [partial_expand t ~f] is like [expand] 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. *) + - [is_multivalued]: says whether the variables is a multivalued + one (such as for example ${@}) which much be in quoted strings to + be concatenated to text or other variables. + - [to_string]: For single unquoted variables, the outcome of [f] is + directly returned. For variables containing text portions or which + are quoted, the value returned by [f] is converted to a string + using [to_string]. *) + +val expand : + t -> f:(Loc.t -> string -> string option) -> string +(** Specialized version [expand_generic] that returns a string (so + variables are assumed to expand to a single value). *) + +val partial_expand_generic : + t -> f:(Loc.t -> string -> 'a option) -> is_multivalued:('a -> bool) -> + to_string:('a -> string) -> (('a, string) either, t) either +(** [partial_expand_generic 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. *) + +val partial_expand : + t -> f:(Loc.t -> string -> string option) -> (string, t) either +(** [partial_expand] is a specialized version of + [partial_expand_generic] that returns a string. *) diff --git a/src/super_context.ml b/src/super_context.ml index 6197c215..b6ec5c9f 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -50,12 +50,8 @@ let expand_vars t ~(scope : Lib_db.Scope.t) ~dir s = | "SCOPE_ROOT" -> Some (Path.reach ~from:dir (Lib_db.Scope.root scope)) | var -> - let open Action.Var_expansion in expand_var_no_root t var - |> Option.map ~f:(function - | Paths(p,_) -> let p = List.map p ~f:Path.to_string in - String.concat ~sep:" " p - | Strings(s,_) -> String.concat ~sep:" " s)) + |> Option.map ~f:(fun e -> Action.Var_expansion.to_string e)) let resolve_program t ?hint bin = Artifacts.binary ?hint t.artifacts bin @@ -139,7 +135,6 @@ let create | Some p -> p in let open Action.Var_expansion in - let open Action.Var_expansion.Concat_or_split in let make = match Bin.make with | None -> Strings (["make"], Split) @@ -657,9 +652,9 @@ module Action = struct | [] -> Loc.warn loc "Variable '<' used with no explicit \ dependencies@."; - Strings ([""], Split) + Strings ([""], Concat) | dep :: _ -> - Paths ([dep], Split)) + Paths ([dep], Concat)) | "^" -> Some (Paths (deps_written_by_user, Split)) | _ -> None)