Merge branch 'master' into no-private-module-name
This commit is contained in:
commit
08c46dff28
|
@ -62,6 +62,10 @@ next
|
||||||
- Make the output of Dune slightly more deterministic when run from
|
- Make the output of Dune slightly more deterministic when run from
|
||||||
inside Dune (#855, @diml)
|
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)
|
1.0+beta20 (10/04/2018)
|
||||||
-----------------------
|
-----------------------
|
||||||
|
|
||||||
|
|
166
src/action.ml
166
src/action.ml
|
@ -34,7 +34,7 @@ struct
|
||||||
; cstr "ignore-stderr" (t @> nil) (fun t -> Ignore (Stderr, t))
|
; cstr "ignore-stderr" (t @> nil) (fun t -> Ignore (Stderr, t))
|
||||||
; cstr "ignore-outputs" (t @> nil) (fun t -> Ignore (Outputs, t))
|
; cstr "ignore-outputs" (t @> nil) (fun t -> Ignore (Outputs, t))
|
||||||
; cstr "progn" (rest t) (fun l -> Progn l)
|
; 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 "cat" (path @> nil) (fun x -> Cat x)
|
||||||
; cstr "copy" (path @> path @> nil) (fun src dst -> Copy (src, dst))
|
; 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"
|
| Progn l -> List (Sexp.unsafe_atom_of_string "progn"
|
||||||
:: List.map l ~f:sexp_of_t)
|
:: 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]
|
| Cat x -> List [Sexp.unsafe_atom_of_string "cat"; path x]
|
||||||
| Copy (x, y) ->
|
| Copy (x, y) ->
|
||||||
List [Sexp.unsafe_atom_of_string "copy"; path x; path y]
|
List [Sexp.unsafe_atom_of_string "copy"; path x; path y]
|
||||||
|
@ -150,7 +151,7 @@ module Make_mapper
|
||||||
| Ignore (outputs, t) ->
|
| Ignore (outputs, t) ->
|
||||||
Ignore (outputs, map t ~dir ~f_program ~f_string ~f_path)
|
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))
|
| 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)
|
| Cat x -> Cat (f_path ~dir x)
|
||||||
| Copy (x, y) -> Copy (f_path ~dir x, f_path ~dir y)
|
| Copy (x, y) -> Copy (f_path ~dir x, f_path ~dir y)
|
||||||
| Symlink (x, y) ->
|
| Symlink (x, y) ->
|
||||||
|
@ -270,69 +271,13 @@ module Unresolved = struct
|
||||||
| Search s -> Ok (f s))
|
| Search s -> Ok (f s))
|
||||||
end
|
end
|
||||||
|
|
||||||
module Var_expansion = struct
|
let prog_and_args_of_values p ~dir =
|
||||||
module Concat_or_split = struct
|
match p with
|
||||||
type t =
|
| [] -> (Unresolved.Program.Search "", [])
|
||||||
| Concat (* default *)
|
| Value.Path p :: xs -> (This p, Value.L.to_strings ~dir xs)
|
||||||
| Split (* the variable is a "split" list of items *)
|
| String s :: xs ->
|
||||||
end
|
(Unresolved.Program.of_string ~dir s, Value.L.to_strings ~dir xs)
|
||||||
|
|
||||||
open Concat_or_split
|
|
||||||
|
|
||||||
type t =
|
|
||||||
| 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
|
|
||||||
|
|
||||||
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, 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: 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 ([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)
|
|
||||||
end
|
|
||||||
|
|
||||||
module VE = Var_expansion
|
|
||||||
module To_VE = String_with_vars.Expand_to(VE)
|
|
||||||
module SW = String_with_vars
|
module SW = String_with_vars
|
||||||
|
|
||||||
module Unexpanded = struct
|
module Unexpanded = struct
|
||||||
|
@ -370,37 +315,33 @@ module Unexpanded = struct
|
||||||
include Past
|
include Past
|
||||||
|
|
||||||
module E = struct
|
module E = struct
|
||||||
let expand ~generic ~special ~map ~dir ~f = function
|
let expand ~dir ~mode ~f ~l ~r =
|
||||||
| Left x -> map x
|
Either.map ~l
|
||||||
| Right template ->
|
~r:(fun s -> r (String_with_vars.expand s ~dir ~f ~mode) ~dir)
|
||||||
match To_VE.expand dir template ~f with
|
|
||||||
| Expansion e -> special dir e
|
|
||||||
| String s -> generic dir s
|
|
||||||
[@@inlined always]
|
|
||||||
|
|
||||||
let string ~dir ~f x =
|
let string =
|
||||||
expand ~dir ~f x
|
expand ~mode:Single
|
||||||
~generic:(fun _dir x -> x)
|
~l:(fun x -> x)
|
||||||
~special:VE.to_string
|
~r:Value.to_string
|
||||||
~map:(fun x -> x)
|
|
||||||
|
|
||||||
let strings ~dir ~f x =
|
let strings =
|
||||||
expand ~dir ~f x
|
expand ~mode:Many
|
||||||
~generic:(fun _dir x -> [x])
|
~l:(fun x -> [x])
|
||||||
~special:VE.to_strings
|
~r:Value.L.to_strings
|
||||||
~map:(fun x -> [x])
|
|
||||||
|
|
||||||
let path ~dir ~f x =
|
let path e =
|
||||||
expand ~dir ~f x
|
let error_loc =
|
||||||
~generic:VE.path_of_string
|
match e with
|
||||||
~special:VE.to_path
|
| Left _ -> None
|
||||||
~map:(fun x -> x)
|
| 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 =
|
let prog_and_args =
|
||||||
expand ~dir ~f x
|
expand ~mode:Many
|
||||||
~generic:(fun _dir s -> (Program.of_string ~dir s, []))
|
~l:(fun x -> (x, []))
|
||||||
~special:VE.to_prog_and_args
|
~r:prog_and_args_of_values
|
||||||
~map:(fun x -> (x, []))
|
|
||||||
end
|
end
|
||||||
|
|
||||||
let rec expand t ~dir ~map_exe ~f : Unresolved.t =
|
let rec expand t ~dir ~map_exe ~f : Unresolved.t =
|
||||||
|
@ -425,7 +366,7 @@ module Unexpanded = struct
|
||||||
| Ignore (outputs, t) ->
|
| Ignore (outputs, t) ->
|
||||||
Ignore (outputs, expand t ~dir ~map_exe ~f)
|
Ignore (outputs, expand t ~dir ~map_exe ~f)
|
||||||
| Progn l -> Progn (List.map l ~f:(fun t -> 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)
|
| Cat x -> Cat (E.path ~dir ~f x)
|
||||||
| Copy (x, y) ->
|
| Copy (x, y) ->
|
||||||
Copy (E.path ~dir ~f x, E.path ~dir ~f y)
|
Copy (E.path ~dir ~f x, E.path ~dir ~f y)
|
||||||
|
@ -463,31 +404,18 @@ module Unexpanded = struct
|
||||||
end
|
end
|
||||||
|
|
||||||
module E = struct
|
module E = struct
|
||||||
let expand ~generic ~special ~dir ~f template =
|
let expand ~dir ~mode ~f ~map x =
|
||||||
match To_VE.partial_expand dir template ~f with
|
match String_with_vars.partial_expand ~mode ~dir ~f x with
|
||||||
| Expansion e -> Left (special dir e)
|
| Expanded e -> Left (map e ~dir)
|
||||||
| String s -> Left (generic dir s)
|
|
||||||
| Unexpanded x -> Right x
|
| Unexpanded x -> Right x
|
||||||
|
|
||||||
let string ~dir ~f x =
|
let string = expand ~mode:Single ~map:Value.to_string
|
||||||
expand ~dir ~f x
|
let strings = expand ~mode:Many ~map:Value.L.to_strings
|
||||||
~generic:(fun _dir x -> x)
|
let cat_strings = expand ~mode:Many ~map:Value.L.concat
|
||||||
~special:VE.to_string
|
let path x =
|
||||||
|
let error_loc = String_with_vars.loc x in
|
||||||
let strings ~dir ~f x =
|
expand ~mode:Single ~map:(Value.to_path ~error_loc) x
|
||||||
expand ~dir ~f x
|
let prog_and_args = expand ~mode:Many ~map:prog_and_args_of_values
|
||||||
~generic:(fun _dir x -> [x])
|
|
||||||
~special:VE.to_strings
|
|
||||||
|
|
||||||
let path ~dir ~f x =
|
|
||||||
expand ~dir ~f x
|
|
||||||
~generic:VE.path_of_string
|
|
||||||
~special:VE.to_path
|
|
||||||
|
|
||||||
let prog_and_args ~dir ~f x =
|
|
||||||
expand ~dir ~f x
|
|
||||||
~generic:(fun dir s -> (Unresolved.Program.of_string ~dir s, []))
|
|
||||||
~special:VE.to_prog_and_args
|
|
||||||
end
|
end
|
||||||
|
|
||||||
let rec partial_expand t ~dir ~map_exe ~f : Partial.t =
|
let rec partial_expand t ~dir ~map_exe ~f : Partial.t =
|
||||||
|
@ -531,7 +459,7 @@ module Unexpanded = struct
|
||||||
| Ignore (outputs, t) ->
|
| Ignore (outputs, t) ->
|
||||||
Ignore (outputs, partial_expand t ~dir ~map_exe ~f)
|
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))
|
| 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)
|
| Cat x -> Cat (E.path ~dir ~f x)
|
||||||
| Copy (x, y) ->
|
| Copy (x, y) ->
|
||||||
Copy (E.path ~dir ~f x, E.path ~dir ~f y)
|
Copy (E.path ~dir ~f x, E.path ~dir ~f y)
|
||||||
|
@ -760,7 +688,7 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to =
|
||||||
exec t ~ectx ~dir ~stdout_to ~stderr_to
|
exec t ~ectx ~dir ~stdout_to ~stderr_to
|
||||||
~env:(Env.add env ~var ~value)
|
~env:(Env.add env ~var ~value)
|
||||||
| Redirect (Stdout, fn, Echo s) ->
|
| Redirect (Stdout, fn, Echo s) ->
|
||||||
Io.write_file fn s;
|
Io.write_file fn (String.concat s ~sep:" ");
|
||||||
Fiber.return ()
|
Fiber.return ()
|
||||||
| Redirect (outputs, fn, Run (Ok prog, args)) ->
|
| Redirect (outputs, fn, Run (Ok prog, args)) ->
|
||||||
let out = Process.File fn in
|
let out = Process.File fn in
|
||||||
|
@ -777,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
|
redirect ~ectx ~dir outputs Config.dev_null t ~env ~stdout_to ~stderr_to
|
||||||
| Progn l ->
|
| Progn l ->
|
||||||
exec_list l ~ectx ~dir ~env ~stdout_to ~stderr_to
|
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 ->
|
| Cat fn ->
|
||||||
Io.with_file_in fn ~f:(fun ic ->
|
Io.with_file_in fn ~f:(fun ic ->
|
||||||
let oc =
|
let oc =
|
||||||
|
|
|
@ -1,22 +1,5 @@
|
||||||
open! Import
|
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
|
|
||||||
|
|
||||||
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
|
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
|
(** result of the lookup of a program, the path to it or information about the
|
||||||
|
@ -99,7 +82,7 @@ module Unexpanded : sig
|
||||||
: t
|
: t
|
||||||
-> dir:Path.t
|
-> dir:Path.t
|
||||||
-> map_exe:(Path.t -> 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
|
-> Unresolved.t
|
||||||
end
|
end
|
||||||
|
|
||||||
|
@ -107,7 +90,7 @@ module Unexpanded : sig
|
||||||
: t
|
: t
|
||||||
-> dir:Path.t
|
-> dir:Path.t
|
||||||
-> map_exe:(Path.t -> 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
|
-> Partial.t
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
|
@ -29,7 +29,7 @@ module type Ast = sig
|
||||||
| Redirect of Outputs.t * path * t
|
| Redirect of Outputs.t * path * t
|
||||||
| Ignore of Outputs.t * t
|
| Ignore of Outputs.t * t
|
||||||
| Progn of t list
|
| Progn of t list
|
||||||
| Echo of string
|
| Echo of string list
|
||||||
| Cat of path
|
| Cat of path
|
||||||
| Copy of path * path
|
| Copy of path * path
|
||||||
| Symlink of path * path
|
| Symlink of path * path
|
||||||
|
@ -61,7 +61,7 @@ module type Helpers = sig
|
||||||
val ignore_stderr : t -> t
|
val ignore_stderr : t -> t
|
||||||
val ignore_outputs : t -> t
|
val ignore_outputs : t -> t
|
||||||
val progn : t list -> t
|
val progn : t list -> t
|
||||||
val echo : string -> t
|
val echo : string list -> t
|
||||||
val cat : path -> t
|
val cat : path -> t
|
||||||
val copy : path -> path -> t
|
val copy : path -> path -> t
|
||||||
val symlink : path -> path -> t
|
val symlink : path -> path -> t
|
||||||
|
|
|
@ -176,8 +176,7 @@ module Gen(P : Install_rules.Params) = struct
|
||||||
+-----------------------------------------------------------------+ *)
|
+-----------------------------------------------------------------+ *)
|
||||||
|
|
||||||
let interpret_locks ~dir ~scope locks =
|
let interpret_locks ~dir ~scope locks =
|
||||||
List.map locks ~f:(fun s ->
|
List.map locks ~f:(SC.expand_vars_path sctx ~dir ~scope)
|
||||||
Path.relative dir (SC.expand_vars sctx ~dir ~scope s))
|
|
||||||
|
|
||||||
let user_rule (rule : Rule.t) ~dir ~scope =
|
let user_rule (rule : Rule.t) ~dir ~scope =
|
||||||
let targets : SC.Action.targets =
|
let targets : SC.Action.targets =
|
||||||
|
|
|
@ -187,8 +187,7 @@ include Sub_system.Register_end_point(
|
||||||
in
|
in
|
||||||
|
|
||||||
let extra_vars =
|
let extra_vars =
|
||||||
String.Map.singleton "library-name"
|
String.Map.singleton "library-name" ([Value.String lib.name])
|
||||||
(Action.Var_expansion.Strings ([lib.name], Concat))
|
|
||||||
in
|
in
|
||||||
|
|
||||||
let runner_libs =
|
let runner_libs =
|
||||||
|
@ -210,10 +209,9 @@ include Sub_system.Register_end_point(
|
||||||
let target = Path.relative inline_test_dir main_module_filename in
|
let target = Path.relative inline_test_dir main_module_filename in
|
||||||
let source_modules = Module.Name.Map.values source_modules in
|
let source_modules = Module.Name.Map.values source_modules in
|
||||||
let files ml_kind =
|
let files ml_kind =
|
||||||
Action.Var_expansion.Paths (
|
Value.L.paths (
|
||||||
List.filter_map source_modules ~f:(fun m ->
|
List.filter_map source_modules ~f:(fun m ->
|
||||||
Module.file m ~dir ml_kind),
|
Module.file m ~dir ml_kind))
|
||||||
Split)
|
|
||||||
in
|
in
|
||||||
let extra_vars =
|
let extra_vars =
|
||||||
List.fold_left
|
List.fold_left
|
||||||
|
|
|
@ -475,8 +475,7 @@ let lint_module sctx ~dir ~dep_kind ~lint ~lib_name ~scope ~dir_kind =
|
||||||
>>| fun (exe, driver) ->
|
>>| fun (exe, driver) ->
|
||||||
(exe,
|
(exe,
|
||||||
let extra_vars =
|
let extra_vars =
|
||||||
String_map.singleton "corrected-suffix"
|
String_map.singleton "corrected-suffix" [Value.String corrected_suffix]
|
||||||
(Action.Var_expansion.Strings ([corrected_suffix], Split))
|
|
||||||
in
|
in
|
||||||
Build.memoize "ppx flags"
|
Build.memoize "ppx flags"
|
||||||
(SC.expand_and_eval_set sctx driver.info.lint_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) ->
|
get_ppx_driver sctx ~loc ~scope ~dir_kind pps >>| fun (exe, driver) ->
|
||||||
(exe,
|
(exe,
|
||||||
let extra_vars =
|
let extra_vars =
|
||||||
String_map.singleton "corrected-suffix"
|
String_map.singleton "corrected-suffix" [Value.String corrected_suffix]
|
||||||
(Action.Var_expansion.Strings ([corrected_suffix], Split))
|
|
||||||
in
|
in
|
||||||
Build.memoize "ppx flags"
|
Build.memoize "ppx flags"
|
||||||
(SC.expand_and_eval_set sctx driver.info.flags
|
(SC.expand_and_eval_set sctx driver.info.flags
|
||||||
|
|
|
@ -1,3 +1,8 @@
|
||||||
type ('a, 'b) t =
|
type ('a, 'b) t =
|
||||||
| Left of 'a
|
| Left of 'a
|
||||||
| Right of 'b
|
| Right of 'b
|
||||||
|
|
||||||
|
let map t ~l ~r =
|
||||||
|
match t with
|
||||||
|
| Left x -> l x
|
||||||
|
| Right x -> r x
|
||||||
|
|
|
@ -3,3 +3,5 @@
|
||||||
type ('a, 'b) t =
|
type ('a, 'b) t =
|
||||||
| Left of 'a
|
| Left of 'a
|
||||||
| Right of 'b
|
| Right of 'b
|
||||||
|
|
||||||
|
val map : ('a, 'b) t -> l:('a -> 'c) -> r:('b -> 'c) -> 'c
|
||||||
|
|
|
@ -214,3 +214,8 @@ let enumerate_gen s =
|
||||||
|
|
||||||
let enumerate_and = enumerate_gen "and"
|
let enumerate_and = enumerate_gen "and"
|
||||||
let enumerate_or = enumerate_gen "or"
|
let enumerate_or = enumerate_gen "or"
|
||||||
|
|
||||||
|
let concat ~sep = function
|
||||||
|
| [] -> ""
|
||||||
|
| [x] -> x
|
||||||
|
| xs -> concat ~sep xs
|
||||||
|
|
|
@ -104,105 +104,92 @@ let string_of_var syntax v =
|
||||||
| Parens -> sprintf "$(%s)" v
|
| Parens -> sprintf "$(%s)" v
|
||||||
| Braces -> sprintf "${%s}" v
|
| Braces -> sprintf "${%s}" v
|
||||||
|
|
||||||
module type EXPANSION = sig
|
|
||||||
type t
|
|
||||||
val is_multivalued : t -> bool
|
|
||||||
type context
|
|
||||||
val to_string : context -> t -> string
|
|
||||||
end
|
|
||||||
|
|
||||||
let concat_rev = function
|
let concat_rev = function
|
||||||
| [] -> ""
|
| [] -> ""
|
||||||
| [s] -> s
|
| [s] -> s
|
||||||
| l -> String.concat (List.rev l) ~sep:""
|
| l -> String.concat (List.rev l) ~sep:""
|
||||||
|
|
||||||
module Expand = struct
|
module Mode = struct
|
||||||
module Full = struct
|
type 'a t =
|
||||||
type nonrec 'a t =
|
| Single : Value.t t
|
||||||
| Expansion of 'a
|
| Many : Value.t list t
|
||||||
| String of string
|
|
||||||
end
|
let string
|
||||||
module Partial = struct
|
: type a. a t -> string -> a
|
||||||
type nonrec 'a t =
|
= fun t s ->
|
||||||
| Expansion of 'a
|
match t with
|
||||||
| String of string
|
| Single -> Value.String s
|
||||||
| Unexpanded of t
|
| Many -> [Value.String s]
|
||||||
end
|
|
||||||
|
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
|
end
|
||||||
|
|
||||||
module Expand_to(V: EXPANSION) = struct
|
module Partial = struct
|
||||||
|
type nonrec 'a t =
|
||||||
let expand ctx t ~f =
|
| Expanded of 'a
|
||||||
match t.items with
|
| Unexpanded of t
|
||||||
| [Var (syntax, v)] when not t.quoted ->
|
|
||||||
(* Unquoted single var *)
|
|
||||||
(match f t.loc v with
|
|
||||||
| 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:"")
|
|
||||||
|
|
||||||
let partial_expand ctx t ~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 ->
|
|
||||||
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
|
|
||||||
in
|
|
||||||
match t.items with
|
|
||||||
| [Var (_, v)] when not t.quoted ->
|
|
||||||
(* Unquoted single var *)
|
|
||||||
(match f t.loc v with
|
|
||||||
| Some e -> Expand.Partial.Expansion e
|
|
||||||
| None -> Expand.Partial.Unexpanded t)
|
|
||||||
| _ -> loop [] [] t.items
|
|
||||||
end
|
end
|
||||||
|
|
||||||
module String_expansion = struct
|
let invalid_multivalue syntax ~var t x =
|
||||||
type t = string
|
Loc.fail t.loc "Variable %s expands to %d values, \
|
||||||
let is_multivalued _ = false
|
however a single value is expected here. \
|
||||||
type context = unit
|
Please quote this atom."
|
||||||
let to_string () (s: string) = s
|
(string_of_var syntax var) (List.length x)
|
||||||
end
|
|
||||||
|
|
||||||
module S = Expand_to(String_expansion)
|
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, 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 (Value.L.concat ~dir t :: acc_text) acc items
|
||||||
|
| None -> loop [] (it :: commit_text acc_text acc) items
|
||||||
|
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
|
||||||
|
| 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 expand t ~f =
|
let expand t ~mode ~dir ~f =
|
||||||
match S.expand () t ~f with
|
match
|
||||||
| Expand.Full.String s
|
partial_expand t ~mode ~dir ~f:(fun syntax loc var ->
|
||||||
| Expansion s -> s
|
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 ~f =
|
let partial_expand t ~mode ~dir ~f =
|
||||||
match S.partial_expand () t ~f with
|
partial_expand t ~mode ~dir ~f:(fun _ loc v -> f loc v)
|
||||||
| Expand.Partial.Expansion s -> Left s
|
|
||||||
| String s -> Left s
|
|
||||||
| Unexpanded s -> Right s
|
|
||||||
|
|
||||||
let to_string t =
|
let to_string t =
|
||||||
match t.items with
|
match t.items with
|
||||||
|
|
|
@ -45,67 +45,28 @@ val iter : t -> f:(Loc.t -> string -> unit) -> unit
|
||||||
|
|
||||||
val is_var : t -> name:string -> bool
|
val is_var : t -> name:string -> bool
|
||||||
|
|
||||||
module type EXPANSION = sig
|
module Mode : sig
|
||||||
type t
|
type 'a t =
|
||||||
(** The value to which variables are expanded. *)
|
| Single : Value.t t
|
||||||
|
| Many : Value.t list t
|
||||||
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]. *)
|
|
||||||
end
|
end
|
||||||
|
|
||||||
module Expand : sig
|
module Partial : sig
|
||||||
module Full : sig
|
type nonrec 'a t =
|
||||||
type nonrec 'a t =
|
| Expanded of 'a
|
||||||
| Expansion of 'a
|
| Unexpanded of t
|
||||||
| String of string
|
|
||||||
end
|
|
||||||
module Partial : sig
|
|
||||||
type nonrec 'a t =
|
|
||||||
| Expansion of 'a
|
|
||||||
| String of string
|
|
||||||
| Unexpanded of t
|
|
||||||
end
|
|
||||||
end
|
end
|
||||||
|
|
||||||
module Expand_to(V : EXPANSION) : sig
|
val expand
|
||||||
val expand
|
: t
|
||||||
: V.context
|
-> mode:'a Mode.t
|
||||||
-> t
|
-> dir:Path.t
|
||||||
-> f:(Loc.t -> string -> V.t option)
|
-> f:(Loc.t -> string -> Value.t list option)
|
||||||
-> V.t Expand.Full.t
|
-> 'a
|
||||||
(** [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
|
val partial_expand
|
||||||
: V.context
|
: t
|
||||||
-> t
|
-> mode:'a Mode.t
|
||||||
-> f:(Loc.t -> string -> V.t option)
|
-> dir:Path.t
|
||||||
-> V.t Expand.Partial.t
|
-> f:(Loc.t -> string -> Value.t list option)
|
||||||
(** [partial_expand t ~f] is like [expand_generic] where all
|
-> 'a Partial.t
|
||||||
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
|
|
||||||
|
|
||||||
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
|
|
||||||
(** [partial_expand] is a specialized version of
|
|
||||||
[Expand_to.partial_expand] that returns a string. *)
|
|
||||||
|
|
|
@ -45,7 +45,7 @@ type t =
|
||||||
; artifacts : Artifacts.t
|
; artifacts : Artifacts.t
|
||||||
; stanzas_to_consider_for_install : Installable.t list
|
; stanzas_to_consider_for_install : Installable.t list
|
||||||
; cxx_flags : string list
|
; cxx_flags : string list
|
||||||
; vars : Action.Var_expansion.t String.Map.t
|
; vars : Value.t list String.Map.t
|
||||||
; chdir : (Action.t, Action.t) Build.t
|
; chdir : (Action.t, Action.t) Build.t
|
||||||
; host : t option
|
; host : t option
|
||||||
; libs_by_package : (Package.t * Lib.Set.t) Package.Name.Map.t
|
; libs_by_package : (Package.t * Lib.Set.t) Package.Name.Map.t
|
||||||
|
@ -86,16 +86,25 @@ 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_var_no_root t var = String.Map.find t.vars var
|
||||||
|
|
||||||
let expand_vars t ~scope ~dir ?(extra_vars=String.Map.empty) s =
|
let (expand_vars, expand_vars_path) =
|
||||||
String_with_vars.expand s ~f:(fun _loc -> function
|
let expand t ~scope ~dir ?(extra_vars=String.Map.empty) s =
|
||||||
| "ROOT" -> Some (Path.reach ~from:dir t.context.build_dir)
|
String_with_vars.expand ~mode:Single ~dir s ~f:(fun _loc -> function
|
||||||
| "SCOPE_ROOT" ->
|
| "ROOT" -> Some [Value.Path t.context.build_dir]
|
||||||
Some (Path.reach ~from:dir (Scope.root scope))
|
| "SCOPE_ROOT" -> Some [Value.Path (Scope.root scope)]
|
||||||
| var ->
|
| var ->
|
||||||
Option.map ~f:(fun e -> Action.Var_expansion.to_string dir e)
|
|
||||||
(match expand_var_no_root t var with
|
(match expand_var_no_root t var with
|
||||||
| Some _ as x -> x
|
| Some _ as x -> x
|
||||||
| None -> String.Map.find extra_vars var))
|
| 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 expand_and_eval_set t ~scope ~dir ?extra_vars set ~standard =
|
||||||
let open Build.O in
|
let open Build.O in
|
||||||
|
@ -270,18 +279,17 @@ let create
|
||||||
| None -> Path.relative context.ocaml_bin "ocamlopt"
|
| None -> Path.relative context.ocaml_bin "ocamlopt"
|
||||||
| Some p -> p
|
| Some p -> p
|
||||||
in
|
in
|
||||||
let open Action.Var_expansion in
|
let string s = [Value.String s] in
|
||||||
|
let path p = [Value.Path p] in
|
||||||
let make =
|
let make =
|
||||||
match Bin.make with
|
match Bin.make with
|
||||||
| None -> Strings (["make"], Split)
|
| None -> string "make"
|
||||||
| Some p -> Paths ([p], Split)
|
| Some p -> path p
|
||||||
in
|
in
|
||||||
let cflags = context.ocamlc_cflags in
|
let cflags = context.ocamlc_cflags in
|
||||||
let strings l = Strings (l , Split) in
|
let strings = Value.L.strings in
|
||||||
let string s = Strings ([s], Concat) in
|
|
||||||
let path p = Paths ([p], Split) in
|
|
||||||
let vars =
|
let vars =
|
||||||
[ "-verbose" , Strings ([] (*"-verbose";*), Concat)
|
[ "-verbose" , []
|
||||||
; "CPP" , strings (context.c_compiler :: cflags @ ["-E"])
|
; "CPP" , strings (context.c_compiler :: cflags @ ["-E"])
|
||||||
; "PA_CPP" , strings (context.c_compiler :: cflags
|
; "PA_CPP" , strings (context.c_compiler :: cflags
|
||||||
@ ["-undef"; "-traditional";
|
@ ["-undef"; "-traditional";
|
||||||
|
@ -482,13 +490,11 @@ module Deps = struct
|
||||||
|
|
||||||
let make_alias t ~scope ~dir s =
|
let make_alias t ~scope ~dir s =
|
||||||
let loc = String_with_vars.loc s in
|
let loc = String_with_vars.loc s in
|
||||||
Alias.of_user_written_path ~loc
|
Alias.of_user_written_path ~loc ((expand_vars_path t ~scope ~dir s))
|
||||||
(Path.relative ~error_loc:loc dir (expand_vars t ~scope ~dir s))
|
|
||||||
|
|
||||||
let dep t ~scope ~dir = function
|
let dep t ~scope ~dir = function
|
||||||
| File s ->
|
| File s ->
|
||||||
let path = Path.relative ~error_loc:(String_with_vars.loc s) dir
|
let path = expand_vars_path t ~scope ~dir s in
|
||||||
(expand_vars t ~scope ~dir s) in
|
|
||||||
Build.path path
|
Build.path path
|
||||||
>>^ fun () -> [path]
|
>>^ fun () -> [path]
|
||||||
| Alias s ->
|
| Alias s ->
|
||||||
|
@ -500,19 +506,17 @@ module Deps = struct
|
||||||
>>^ fun () -> []
|
>>^ fun () -> []
|
||||||
| Glob_files s -> begin
|
| Glob_files s -> begin
|
||||||
let loc = String_with_vars.loc s in
|
let loc = String_with_vars.loc s in
|
||||||
let path =
|
let path = expand_vars_path t ~scope ~dir s in
|
||||||
Path.relative ~error_loc:loc dir (expand_vars t ~scope ~dir s) in
|
|
||||||
match Glob_lexer.parse_string (Path.basename path) with
|
match Glob_lexer.parse_string (Path.basename path) with
|
||||||
| Ok re ->
|
| Ok re ->
|
||||||
let dir = Path.parent_exn path in
|
let dir = Path.parent_exn path in
|
||||||
Build.paths_glob ~loc ~dir (Re.compile re)
|
Build.paths_glob ~loc ~dir (Re.compile re)
|
||||||
>>^ Path.Set.to_list
|
>>^ Path.Set.to_list
|
||||||
| Error (_pos, msg) ->
|
| Error (_pos, msg) ->
|
||||||
Loc.fail loc "invalid glob: %s" msg
|
Loc.fail (String_with_vars.loc s) "invalid glob: %s" msg
|
||||||
end
|
end
|
||||||
| Files_recursively_in s ->
|
| Files_recursively_in s ->
|
||||||
let path = Path.relative ~error_loc:(String_with_vars.loc s)
|
let path = expand_vars_path t ~scope ~dir s in
|
||||||
dir (expand_vars t ~scope ~dir s) in
|
|
||||||
Build.files_recursively_in ~dir:path ~file_tree:t.file_tree
|
Build.files_recursively_in ~dir:path ~file_tree:t.file_tree
|
||||||
>>^ Path.Set.to_list
|
>>^ Path.Set.to_list
|
||||||
| Package p ->
|
| Package p ->
|
||||||
|
@ -588,7 +592,7 @@ module Action = struct
|
||||||
; (* Static deps from ${...} variables. For instance ${exe:...} *)
|
; (* Static deps from ${...} variables. For instance ${exe:...} *)
|
||||||
mutable sdeps : Path.Set.t
|
mutable sdeps : Path.Set.t
|
||||||
; (* Dynamic deps from ${...} variables. For instance ${read:...} *)
|
; (* Dynamic deps from ${...} variables. For instance ${read:...} *)
|
||||||
mutable ddeps : (unit, Action.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 =
|
let add_lib_dep acc lib kind =
|
||||||
|
@ -602,8 +606,8 @@ module Action = struct
|
||||||
acc.ddeps <- String.Map.add acc.ddeps key dep;
|
acc.ddeps <- String.Map.add acc.ddeps key dep;
|
||||||
None
|
None
|
||||||
|
|
||||||
let path_exp path = Action.Var_expansion.Paths ([path], Concat)
|
let path_exp path = [Value.Path path]
|
||||||
let str_exp path = Action.Var_expansion.Strings ([path], Concat)
|
let str_exp str = [Value.String str]
|
||||||
|
|
||||||
let map_exe sctx =
|
let map_exe sctx =
|
||||||
match sctx.host with
|
match sctx.host with
|
||||||
|
@ -630,7 +634,6 @@ module Action = struct
|
||||||
; ddeps = String.Map.empty
|
; ddeps = String.Map.empty
|
||||||
}
|
}
|
||||||
in
|
in
|
||||||
let open Action.Var_expansion in
|
|
||||||
let expand loc key var = function
|
let expand loc key var = function
|
||||||
| Some ("exe" , s) -> Some (path_exp (map_exe (Path.relative dir s)))
|
| Some ("exe" , s) -> Some (path_exp (map_exe (Path.relative dir s)))
|
||||||
| Some ("path" , s) -> Some (path_exp (Path.relative dir s) )
|
| Some ("path" , s) -> Some (path_exp (Path.relative dir s) )
|
||||||
|
@ -683,8 +686,8 @@ module Action = struct
|
||||||
| Some p ->
|
| Some p ->
|
||||||
let x =
|
let x =
|
||||||
Pkg_version.read sctx p >>^ function
|
Pkg_version.read sctx p >>^ function
|
||||||
| None -> Strings ([""], Concat)
|
| None -> [Value.String ""]
|
||||||
| Some s -> Strings ([s], Concat)
|
| Some s -> [String s]
|
||||||
in
|
in
|
||||||
add_ddep acc ~key x
|
add_ddep acc ~key x
|
||||||
| None ->
|
| None ->
|
||||||
|
@ -696,7 +699,7 @@ module Action = struct
|
||||||
let path = Path.relative dir s in
|
let path = Path.relative dir s in
|
||||||
let data =
|
let data =
|
||||||
Build.contents path
|
Build.contents path
|
||||||
>>^ fun s -> Strings ([s], Concat)
|
>>^ fun s -> [Value.String s]
|
||||||
in
|
in
|
||||||
add_ddep acc ~key data
|
add_ddep acc ~key data
|
||||||
end
|
end
|
||||||
|
@ -704,7 +707,7 @@ module Action = struct
|
||||||
let path = Path.relative dir s in
|
let path = Path.relative dir s in
|
||||||
let data =
|
let data =
|
||||||
Build.lines_of path
|
Build.lines_of path
|
||||||
>>^ fun l -> Strings (l, Split)
|
>>^ Value.L.strings
|
||||||
in
|
in
|
||||||
add_ddep acc ~key data
|
add_ddep acc ~key data
|
||||||
end
|
end
|
||||||
|
@ -712,7 +715,7 @@ module Action = struct
|
||||||
let path = Path.relative dir s in
|
let path = Path.relative dir s in
|
||||||
let data =
|
let data =
|
||||||
Build.strings path
|
Build.strings path
|
||||||
>>^ fun l -> Strings (l, Split)
|
>>^ Value.L.strings
|
||||||
in
|
in
|
||||||
add_ddep acc ~key data
|
add_ddep acc ~key data
|
||||||
end
|
end
|
||||||
|
@ -734,7 +737,7 @@ module Action = struct
|
||||||
match targets_written_by_user with
|
match targets_written_by_user with
|
||||||
| Infer -> Loc.fail loc "You cannot use ${@} with inferred rules."
|
| Infer -> Loc.fail loc "You cannot use ${@} with inferred rules."
|
||||||
| Alias -> Loc.fail loc "You cannot use ${@} in aliases."
|
| Alias -> Loc.fail loc "You cannot use ${@} in aliases."
|
||||||
| Static l -> Some (Paths (l, Split))
|
| Static l -> Some (Value.L.paths l)
|
||||||
end
|
end
|
||||||
| _ ->
|
| _ ->
|
||||||
match String.lsplit2 var ~on:':' with
|
match String.lsplit2 var ~on:':' with
|
||||||
|
@ -742,16 +745,15 @@ module Action = struct
|
||||||
Some (path_exp (Path.relative dir s))
|
Some (path_exp (Path.relative dir s))
|
||||||
| x ->
|
| x ->
|
||||||
let exp = expand loc key var x in
|
let exp = expand loc key var x in
|
||||||
(match exp with
|
Option.iter exp ~f:(fun vs ->
|
||||||
| Some (Paths (ps, _)) ->
|
acc.sdeps <- Path.Set.union (Path.Set.of_list
|
||||||
acc.sdeps <- Path.Set.union (Path.Set.of_list ps) acc.sdeps
|
(Value.L.paths_only vs)) acc.sdeps;
|
||||||
| _ -> ());
|
);
|
||||||
exp)
|
exp)
|
||||||
in
|
in
|
||||||
(t, acc)
|
(t, acc)
|
||||||
|
|
||||||
let expand_step2 ~dir ~dynamic_expansions ~deps_written_by_user ~map_exe t =
|
let expand_step2 ~dir ~dynamic_expansions ~deps_written_by_user ~map_exe t =
|
||||||
let open Action.Var_expansion in
|
|
||||||
U.Partial.expand t ~dir ~map_exe ~f:(fun loc key ->
|
U.Partial.expand t ~dir ~map_exe ~f:(fun loc key ->
|
||||||
match String.Map.find dynamic_expansions key with
|
match String.Map.find dynamic_expansions key with
|
||||||
| Some _ as opt -> opt
|
| Some _ as opt -> opt
|
||||||
|
@ -762,12 +764,12 @@ module Action = struct
|
||||||
Some
|
Some
|
||||||
(match deps_written_by_user with
|
(match deps_written_by_user with
|
||||||
| [] ->
|
| [] ->
|
||||||
Loc.warn loc "Variable '<' used with no explicit \
|
Loc.warn loc "Variable '<' used with no explicit \
|
||||||
dependencies@.";
|
dependencies@.";
|
||||||
Strings ([""], Concat)
|
[Value.String ""]
|
||||||
| dep :: _ ->
|
| dep :: _ ->
|
||||||
Paths ([dep], Concat))
|
[Path dep])
|
||||||
| "^" -> Some (Paths (deps_written_by_user, Split))
|
| "^" -> Some (Value.L.paths deps_written_by_user)
|
||||||
| _ -> None)
|
| _ -> None)
|
||||||
|
|
||||||
let run sctx ~loc ?(extra_vars=String.Map.empty)
|
let run sctx ~loc ?(extra_vars=String.Map.empty)
|
||||||
|
|
|
@ -82,15 +82,23 @@ val expand_vars
|
||||||
: t
|
: t
|
||||||
-> scope:Scope.t
|
-> scope:Scope.t
|
||||||
-> dir:Path.t
|
-> dir:Path.t
|
||||||
-> ?extra_vars:Action.Var_expansion.t String.Map.t
|
-> ?extra_vars:Value.t list String.Map.t
|
||||||
-> String_with_vars.t
|
-> String_with_vars.t
|
||||||
-> string
|
-> string
|
||||||
|
|
||||||
|
val expand_vars_path
|
||||||
|
: t
|
||||||
|
-> scope:Scope.t
|
||||||
|
-> dir:Path.t
|
||||||
|
-> ?extra_vars:Value.t list String.Map.t
|
||||||
|
-> String_with_vars.t
|
||||||
|
-> Path.t
|
||||||
|
|
||||||
val expand_and_eval_set
|
val expand_and_eval_set
|
||||||
: t
|
: t
|
||||||
-> scope:Scope.t
|
-> scope:Scope.t
|
||||||
-> dir:Path.t
|
-> dir:Path.t
|
||||||
-> ?extra_vars:Action.Var_expansion.t String.Map.t
|
-> ?extra_vars:Value.t list String.Map.t
|
||||||
-> Ordered_set_lang.Unexpanded.t
|
-> Ordered_set_lang.Unexpanded.t
|
||||||
-> standard:(unit, string list) Build.t
|
-> standard:(unit, string list) Build.t
|
||||||
-> (unit, string list) Build.t
|
-> (unit, string list) Build.t
|
||||||
|
@ -224,7 +232,7 @@ module Action : sig
|
||||||
val run
|
val run
|
||||||
: t
|
: t
|
||||||
-> loc:Loc.t
|
-> loc:Loc.t
|
||||||
-> ?extra_vars:Action.Var_expansion.t String.Map.t
|
-> ?extra_vars:Value.t list String.Map.t
|
||||||
-> Action.Unexpanded.t
|
-> Action.Unexpanded.t
|
||||||
-> dir:Path.t
|
-> dir:Path.t
|
||||||
-> dep_kind:Build.lib_dep_kind
|
-> dep_kind:Build.lib_dep_kind
|
||||||
|
|
|
@ -0,0 +1,34 @@
|
||||||
|
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_path ?error_loc t ~dir =
|
||||||
|
match t with
|
||||||
|
| String s -> Path.relative ?error_loc dir s
|
||||||
|
| Path p -> p
|
||||||
|
|
||||||
|
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 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
|
|
@ -0,0 +1,21 @@
|
||||||
|
open Stdune
|
||||||
|
|
||||||
|
type t =
|
||||||
|
| String of string
|
||||||
|
| Path of Path.t
|
||||||
|
|
||||||
|
val to_string : t -> dir:Path.t -> string
|
||||||
|
|
||||||
|
val to_path : ?error_loc:Loc.t -> t -> dir:Path.t -> Path.t
|
||||||
|
|
||||||
|
module L : sig
|
||||||
|
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
|
||||||
|
|
||||||
|
val to_strings : t list -> dir:Path.t -> string list
|
||||||
|
end
|
|
@ -1,13 +1,11 @@
|
||||||
(jbuild_version 1)
|
|
||||||
|
|
||||||
;; Test for ${^} with globs in rules
|
;; Test for ${^} with globs in rules
|
||||||
|
|
||||||
(rule
|
(rule
|
||||||
((targets (result expected))
|
((targets (result expected))
|
||||||
(deps (jbuild (glob_files *.txt)))
|
(deps (dune (glob_files *.txt)))
|
||||||
(action (progn
|
(action (progn
|
||||||
(with-stdout-to result (echo ${^}))
|
(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
|
(rule
|
||||||
((targets (result2 expected2))
|
((targets (result2 expected2))
|
||||||
|
@ -28,11 +26,11 @@
|
||||||
|
|
||||||
;; Test inferred rules
|
;; Test inferred rules
|
||||||
|
|
||||||
(rule (copy jbuild jbuild-plop))
|
(rule (copy dune dune-plop))
|
||||||
|
|
||||||
(alias
|
(alias
|
||||||
((name runtest)
|
((name runtest)
|
||||||
(deps (jbuild jbuild-plop))
|
(deps (dune dune-plop))
|
||||||
(action (run diff -u ${^}))))
|
(action (run diff -u ${^}))))
|
||||||
|
|
||||||
;; For some tests in subdirs
|
;; For some tests in subdirs
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
$ dune runtest --display short
|
$ 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.
|
Warning: Directory dir-that-doesnt-exist doesn't exist.
|
||||||
No rule found for jbuild
|
|
||||||
diff alias runtest
|
diff alias runtest
|
||||||
diff alias runtest
|
diff alias runtest
|
||||||
[1]
|
diff alias runtest
|
||||||
|
diff alias runtest
|
||||||
|
|
|
@ -0,0 +1,3 @@
|
||||||
|
foo
|
||||||
|
bar
|
||||||
|
baz
|
|
@ -0,0 +1,3 @@
|
||||||
|
|
||||||
|
let () =
|
||||||
|
Printf.printf "Number of args: %d\n" (Array.length Sys.argv - 1)
|
|
@ -0,0 +1,6 @@
|
||||||
|
(executable
|
||||||
|
((name count_args)))
|
||||||
|
|
||||||
|
(alias
|
||||||
|
((name runtest)
|
||||||
|
(action (run ./count_args.exe ${read-lines:args}))))
|
|
@ -0,0 +1,4 @@
|
||||||
|
|
||||||
|
(alias
|
||||||
|
((name runtest)
|
||||||
|
(action (echo "lines: ${read-lines:foo}"))))
|
|
@ -0,0 +1,3 @@
|
||||||
|
foo
|
||||||
|
bar
|
||||||
|
baz
|
|
@ -3,12 +3,10 @@ that ${@} is not quoted and doesn't contain exactly 1 element
|
||||||
|
|
||||||
$ dune build --root bad x
|
$ dune build --root bad x
|
||||||
Entering directory 'bad'
|
Entering directory 'bad'
|
||||||
Error: Rule failed to generate the following targets:
|
File "dune", line 3, characters 26-30:
|
||||||
- x
|
Error: Variable ${@} expands to 2 values, however a single value is expected here. Please quote this atom.
|
||||||
- y
|
|
||||||
[1]
|
[1]
|
||||||
|
|
||||||
|
|
||||||
The targets should only be interpreted as a single path when quoted
|
The targets should only be interpreted as a single path when quoted
|
||||||
|
|
||||||
$ dune build --root good s
|
$ dune build --root good s
|
||||||
|
@ -17,3 +15,12 @@ The targets should only be interpreted as a single path when quoted
|
||||||
- s
|
- s
|
||||||
- t
|
- t
|
||||||
[1]
|
[1]
|
||||||
|
|
||||||
|
$ dune runtest --root quote-from-context
|
||||||
|
Entering directory 'quote-from-context'
|
||||||
|
count_args alias runtest
|
||||||
|
Number of args: 3
|
||||||
|
|
||||||
|
$ dune runtest --root quotes-multi
|
||||||
|
Entering directory 'quotes-multi'
|
||||||
|
lines: foo bar baz
|
||||||
|
|
Loading…
Reference in New Issue