matthieu
/
dune
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' into rename-build-profile

This commit is contained in:
Rudi Grinberg 2018-07-02 13:45:00 +07:00 committed by GitHub
parent 5f6e0f658f d53179a56e
commit f163f6197a
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
18 changed files with 318 additions and 133 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
CHANGES.md
View File

@ -93,7 +93,14 @@ next
- Make `dev` the default build profile (#920, @diml)
- Version `dune-workspace` and `~/.config/dune/config` files (#..., @diml)
- Version `dune-workspace` and `~/.config/dune/config` files (#932, @diml)
- Add the ability to build an alias non-recursively from the command
line by writing `@@alias` (#926, @diml)
- Add a special `default` alias that defaults to `(alias_rec install)`
when not defined by the user and make `@@default` be the default
target (#926, @diml)
- Add `%{profile}` variable. (#938, @rgrinberg)

2
README.md
View File

@ -85,7 +85,7 @@ $ jbuilder build --only-packages <package-name> @install
Jbuilder is able to build a given source code repository against
several configurations simultaneously. This helps maintaining packages
across several versions of OCaml as you can tests them all at once
across several versions of OCaml as you can test them all at once
without hassle.
This feature should make cross-compilation easy, see details in the

98
bin/main.ml
View File

@ -26,6 +26,7 @@ type common =
; (* Original arguments for the external-lib-deps hint *)
orig_args : string list
; config : Config.t
; default_target : string
}
let prefix_target common s = common.target_prefix ^ s
@ -114,8 +115,21 @@ end
type target =
| File of Path.t
| Alias of Path.t
| Alias_rec of Path.t
let parse_alias path ~contexts =
let dir = Path.parent_exn path in
let name = Path.basename path in
match Path.extract_build_context dir with
| None -> (contexts, dir, name)
| Some ("install", _) ->
die "Invalid alias: %s.\n\
There are no aliases in %s."
(Path.to_string_maybe_quoted Path.(relative build_dir "install"))
(Path.to_string_maybe_quoted path)
| Some (ctx, dir) -> ([ctx], dir, name)
let request_of_targets (setup : Main.setup) targets =
let open Build.O in
let contexts = List.map setup.contexts ~f:(fun c -> c.Context.name) in
@ -123,19 +137,12 @@ let request_of_targets (setup : Main.setup) targets =
acc >>>
match target with
| File path -> Build.path path
| Alias path ->
let contexts, dir, name = parse_alias path ~contexts in
Build_system.Alias.dep_multi_contexts ~dir ~name
~file_tree:setup.file_tree ~contexts
| Alias_rec path ->
let dir = Path.parent_exn path in
let name = Path.basename path in
let contexts, dir =
match Path.extract_build_context dir with
| None -> (contexts, dir)
| Some ("install", _) ->
die "Invalid alias: %s.\n\
There are no aliases in %s."
(Path.to_string_maybe_quoted Path.(relative build_dir "install"))
(Path.to_string_maybe_quoted path)
| Some (ctx, dir) -> ([ctx], dir)
in
let contexts, dir, name = parse_alias path ~contexts in
Build_system.Alias.dep_rec_multi_contexts ~dir ~name
~file_tree:setup.file_tree ~contexts)
@ -228,6 +235,7 @@ let common =
ignore_promoted_rules,
config_file,
profile,
default_target,
orig)
x
display
@ -290,6 +298,7 @@ let common =
; x
; config
; build_dir
; default_target
}
in
let docs = copts_sect in
@ -478,6 +487,20 @@ let common =
in
Term.(ret (const merge $ config_file $ no_config))
in
let default_target_default =
match Which_program.t with
| Dune -> "@@default"
| Jbuilder -> "@install"
in
let default_target =
Arg.(value
& opt (some string) None
& info ["default-target"] ~docs ~docv:"TARGET"
~doc:(sprintf
{|Set the default target that when none is specified to
$(b,dune build). It defaults to %s.|}
default_target_default))
in
let for_release = "for-release-of-packages" in
let frop =
Arg.(value
@ -490,33 +513,37 @@ let common =
packages as well as getting reproducible builds.|})
in
let merge root only_packages ignore_promoted_rules
(config_file_opt, config_file) profile release =
(config_file_opt, config_file) profile default_target release =
let fail opt = incompatible ("-p/--" ^ for_release) opt in
match release, root, only_packages, ignore_promoted_rules,
profile, config_file_opt with
| Some _, Some _, _, _, _, _ -> fail "--root"
| Some _, _, Some _, _, _, _ -> fail "--only-packages"
| Some _, _, _, true , _, _ -> fail "--ignore-promoted-rules"
| Some _, _, _, _, Some _, _ -> fail "--profile"
| Some _, _, _, _, _, Some s -> fail s
| Some pkgs, None, None, false, None, None ->
profile, default_target, config_file_opt with
| Some _, Some _, _, _, _, _, _ -> fail "--root"
| Some _, _, Some _, _, _, _, _ -> fail "--only-packages"
| Some _, _, _, true , _, _, _ -> fail "--ignore-promoted-rules"
| Some _, _, _, _, Some _, _, _ -> fail "--profile"
| Some _, _, _, _, _, Some s, _ -> fail s
| Some _, _, _, _, _, _, Some _ -> fail "--default-target"
| Some pkgs, None, None, false, None, None, None ->
`Ok (Some ".",
Some pkgs,
true,
No_config,
Some "release",
"@install",
["-p"; pkgs]
)
| None, _, _, _, _, _ ->
| None, _, _, _, _, _, _ ->
`Ok (root,
only_packages,
ignore_promoted_rules,
config_file,
profile,
Option.value default_target ~default:default_target_default,
List.concat
[ dump_opt "--root" root
; dump_opt "--only-packages" only_packages
; dump_opt "--profile" profile
; dump_opt "--default-target" default_target
; if ignore_promoted_rules then
["--ignore-promoted-rules"]
else
@ -534,6 +561,7 @@ let common =
$ ignore_promoted_rules
$ config_file
$ profile
$ default_target
$ frop))
in
let x =
@ -680,7 +708,13 @@ let resolve_targets ~log common (setup : Main.setup) user_targets =
let targets =
List.map user_targets ~f:(fun s ->
if String.is_prefix s ~prefix:"@" then begin
let s = String.sub s ~pos:1 ~len:(String.length s - 1) in
let pos, is_rec =
if String.length s >= 2 && s.[1] = '@' then
(2, false)
else
(1, true)
in
let s = String.sub s ~pos ~len:(String.length s - pos) in
let path = Path.relative Path.root (prefix_target common s) in
check_path path;
if Path.is_root path then
@ -688,7 +722,7 @@ let resolve_targets ~log common (setup : Main.setup) user_targets =
else if not (Path.is_managed path) then
die "@@ on the command line must be followed by a relative path"
else
Ok [Alias_rec path]
Ok [if is_rec then Alias_rec path else Alias path]
end else begin
let path = Path.relative Path.root (prefix_target common s) in
check_path path;
@ -725,6 +759,9 @@ let resolve_targets ~log common (setup : Main.setup) user_targets =
List.iter targets ~f:(function
| File path ->
Log.info log @@ "- " ^ (Path.to_string path)
| Alias path ->
Log.info log @@ "- alias " ^
(Path.to_string_maybe_quoted path)
| Alias_rec path ->
Log.info log @@ "- recursive alias " ^
(Path.to_string_maybe_quoted path));
@ -756,9 +793,14 @@ let build_targets =
(Main.setup ~log common >>= fun setup ->
let targets = resolve_targets_exn ~log common setup targets in
do_build setup targets) in
let default_target =
match Which_program.t with
| Dune -> "@@default"
| Jbuilder -> "@install"
in
( Term.(const go
$ common
$ Arg.(value & pos_all string ["@install"] name_))
$ Arg.(value & pos_all string [default_target] name_))
, Term.info "build" ~doc ~man)
let runtest =
@ -1316,7 +1358,7 @@ let utop =
match resolve_targets_exn ~log common setup [utop_target] with
| [] -> die "no libraries defined in %s" dir
| [File target] -> target
| [Alias_rec _] | _::_::_ -> assert false
| _ -> assert false
in
do_build setup [File target] >>| fun () ->
(setup.build_system, context, Path.to_string target)
@ -1426,10 +1468,10 @@ module Help = struct
Unix systems and $(b,Local Settings/dune/config) in the User home
directory on Windows. However, it is possible to specify an
alternative configuration file with the $(b,--config-file) option.|}
; `P {|The first line of the file must be of the form (lang dune X.Y) \
; `P {|The first line of the file must be of the form (lang dune X.Y)
where X.Y is the version of the dune language used in the file.|}
; `P {|The rest of the file must be written in S-expression syntax and be \
composed of a list of stanzas. The following sections describe \
; `P {|The rest of the file must be written in S-expression syntax and be
composed of a list of stanzas. The following sections describe
the stanzas available.|}
; `S "DISPLAY MODES"
; `P {|Syntax: $(b,\(display MODE\))|}

2
doc/jbuild.rst
View File

@ -531,6 +531,8 @@ menhir
A ``menhir`` stanza is available to support the menhir_ parser generator. See
the :ref:`menhir-main` section for details.
.. _alias-stanza:
alias
-----

2
doc/quick-start.rst
View File

@ -15,7 +15,7 @@ In a directory of your choice, write this ``jbuild`` file:
(jbuild_version 1)
;; This declare the hello_world executable implemented by hello_world.ml
;; This declares the hello_world executable implemented by hello_world.ml
(executable
((name hello_world)))

3
doc/terminology.rst
View File

@ -50,6 +50,9 @@ Terminology
alias in all children directories recursively. Jbuilder defines the
following standard aliases:
- ``default`` which is the alias build by default when no targets
are specified on the command line. See :ref:`default-alias` for
details
- ``runtest`` which runs user defined tests
- ``install`` which depends on everything that should be installed
- ``doc`` which depends on the generated HTML

40
doc/usage.rst
View File

@ -68,8 +68,9 @@ directory as this is normally the case.
Interpretation of targets
=========================
This section describes how ``jbuilder`` interprets the targets given on
the command line.
This section describes how ``dune`` interprets the targets given on
the command line. When no targets are specified, ``dune`` builds the
``default`` alias, see :ref:`default-alias` for more details.
Resolution
----------
@ -121,6 +122,38 @@ So for instance:
the ``foo`` build context
- ``jbuilder build @runtest`` will run the tests for all build contexts
You can also build an alias non-recursively by using ``@@`` instead of
``@``. For instance to run tests only from the current directory:
.. code::
dune build @@runtest
.. _default-alias:
Default alias
-------------
When no targets are given to ``dune build``, it builds the special
``default`` alias. Effectively ``dune build`` is equivalent to:
.. code::
dune build @@default
When a directory doesn't explicitly define what the ``default`` alias
means via an :ref:`alias-stanza` stanza, the following implicit
definition is assumed:
.. code::
(alias
(name default)
(deps (alias_rec install)))
Which means that by default ``dune build`` will build everything that
is installable.
Finding external libraries
==========================
@ -207,7 +240,7 @@ follows:
build: [["dune" "build" "-p" name "-j" jobs]]
``-p pkg`` is a shorthand for ``--root . --only-packages pkg --profile
release``. ``-p`` is the short version of
release --default-target @install``. ``-p`` is the short version of
``--for-release-of-packages``.
This has the following effects:
@ -217,6 +250,7 @@ This has the following effects:
- it sets the root to prevent jbuilder from looking it up
- it sets the build profile to ``release``
- it uses whatever concurrency option opam provides
- it sets the default target to ``@install`` rather than ``@@default``
Note that ``name`` and ``jobs`` are variables expanded by opam. ``name``
expands to the package name and ``jobs`` to the number of jobs available

3
src/build.ml
View File

@ -37,6 +37,7 @@ module Repr = struct
| Fail : fail -> (_, _) t
| Memo : 'a memo -> (unit, 'a) t
| Catch : ('a, 'b) t * (exn -> 'b) -> ('a, 'b) t
| Lazy_no_targets : ('a, 'b) t Lazy.t -> ('a, 'b) t
and 'a memo =
{ name : string
@ -132,6 +133,8 @@ let rec all = function
>>>
arr (fun (x, y) -> x :: y)
let lazy_no_targets t = Lazy_no_targets t
let path p = Paths (Path.Set.singleton p)
let paths ps = Paths (Path.Set.of_list ps)
let path_set ps = Paths ps

5
src/build.mli
View File

@ -34,6 +34,10 @@ val fanout4 : ('a, 'b) t -> ('a, 'c) t -> ('a, 'd) t -> ('a, 'e) t -> ('a, 'b *
val all : ('a, 'b) t list -> ('a, 'b list) t
(** Optimization to avoiding eagerly computing a [Build.t] value,
assume it contains no targets. *)
val lazy_no_targets : ('a, 'b) t Lazy.t -> ('a, 'b) t
(* CR-someday diml: this API is not great, what about:
{[
@ -202,6 +206,7 @@ module Repr : sig
| Fail : fail -> (_, _) t
| Memo : 'a memo -> (unit, 'a) t
| Catch : ('a, 'b) t * (exn -> 'b) -> ('a, 'b) t
| Lazy_no_targets : ('a, 'b) t Lazy.t -> ('a, 'b) t
and 'a memo =
{ name : string

46
src/build_interpret.ml
View File

@ -49,17 +49,23 @@ let inspect_path file_tree path =
else
None
let no_targets_allowed () =
Exn.code_error "No targets allowed under a [Build.lazy_no_targets] \
or [Build.if_file_exists]" []
[@@inline never]
let static_deps t ~all_targets ~file_tree =
let rec loop : type a b. (a, b) t -> Static_deps.t -> Static_deps.t = fun t acc ->
let rec loop : type a b. (a, b) t -> Static_deps.t -> bool -> Static_deps.t
= fun t acc targets_allowed ->
match t with
| Arr _ -> acc
| Targets _ -> acc
| Store_vfile _ -> acc
| Compose (a, b) -> loop a (loop b acc)
| First t -> loop t acc
| Second t -> loop t acc
| Split (a, b) -> loop a (loop b acc)
| Fanout (a, b) -> loop a (loop b acc)
| Targets _ -> if not targets_allowed then no_targets_allowed (); acc
| Store_vfile _ -> if not targets_allowed then no_targets_allowed (); acc
| Compose (a, b) -> loop a (loop b acc targets_allowed) targets_allowed
| First t -> loop t acc targets_allowed
| Second t -> loop t acc targets_allowed
| Split (a, b) -> loop a (loop b acc targets_allowed) targets_allowed
| Fanout (a, b) -> loop a (loop b acc targets_allowed) targets_allowed
| Paths fns -> { acc with action_deps = Path.Set.union fns acc.action_deps }
| Paths_for_rule fns ->
{ acc with rule_deps = Path.Set.union fns acc.rule_deps }
@ -93,28 +99,34 @@ let static_deps t ~all_targets ~file_tree =
end
| If_file_exists (p, state) -> begin
match !state with
| Decided (_, t) -> loop t acc
| Decided (_, t) -> loop t acc false
| Undecided (then_, else_) ->
let dir = Path.parent_exn p in
let targets = all_targets ~dir in
if Path.Set.mem targets p then begin
state := Decided (true, then_);
loop then_ acc
loop then_ acc false
end else begin
state := Decided (false, else_);
loop else_ acc
loop else_ acc false
end
end
| Dyn_paths t -> loop t acc
| Vpath (Vspec.T (p, _)) -> { acc with rule_deps = Path.Set.add acc.rule_deps p }
| Dyn_paths t -> loop t acc targets_allowed
| Vpath (Vspec.T (p, _)) ->
{ acc with rule_deps = Path.Set.add acc.rule_deps p }
| Contents p -> { acc with rule_deps = Path.Set.add acc.rule_deps p }
| Lines_of p -> { acc with rule_deps = Path.Set.add acc.rule_deps p }
| Record_lib_deps _ -> acc
| Fail _ -> acc
| Memo m -> loop m.t acc
| Catch (t, _) -> loop t acc
| Memo m -> loop m.t acc targets_allowed
| Catch (t, _) -> loop t acc targets_allowed
| Lazy_no_targets t -> loop (Lazy.force t) acc false
in
loop (Build.repr t) { rule_deps = Path.Set.empty; action_deps = Path.Set.empty }
loop (Build.repr t)
{ rule_deps = Path.Set.empty
; action_deps = Path.Set.empty
}
true
let lib_deps =
let rec loop : type a b. (a, b) t -> Build.lib_deps -> Build.lib_deps
@ -141,6 +153,7 @@ let lib_deps =
loop (get_if_file_exists_exn state) acc
| Memo m -> loop m.t acc
| Catch (t, _) -> loop t acc
| Lazy_no_targets t -> loop (Lazy.force t) acc
in
fun t -> loop (Build.repr t) String.Map.empty
@ -183,6 +196,7 @@ let targets =
end
| Memo m -> loop m.t acc
| Catch (t, _) -> loop t acc
| Lazy_no_targets _ -> acc
in
fun t -> loop (Build.repr t) []

161
src/build_system.ml
View File

@ -164,8 +164,7 @@ module Internal_rule = struct
type t =
{ id : Id.t
; rule_deps : Path.Set.t
; static_deps : Path.Set.t
; static_deps : Build_interpret.Static_deps.t Lazy.t
; targets : Path.Set.t
; context : Context.t option
; build : (unit, Action.t) Build.t
@ -178,6 +177,12 @@ module Internal_rule = struct
let compare a b = Id.compare a.id b.id
let loc ~file_tree ~dir t = rule_loc ~file_tree ~dir ~loc:t.loc
let lib_deps t =
(* Forcing this lazy ensures that the various globs and
[if_file_exists] are resolved inside the [Build.t] value. *)
ignore (Lazy.force t.static_deps : Build_interpret.Static_deps.t);
Build_interpret.lib_deps t.build
end
module File_kind = struct
@ -250,59 +255,78 @@ module Alias0 = struct
let fully_qualified_name t = Path.relative t.dir t.name
let stamp_file t =
Path.relative (Path.insert_after_build_dir_exn t.dir ".aliases") (t.name ^ suffix)
Path.relative (Path.insert_after_build_dir_exn t.dir ".aliases")
(t.name ^ suffix)
let dep t = Build.path (stamp_file t)
let find_dir_specified_on_command_line ~dir ~file_tree =
match File_tree.find_dir file_tree dir with
| None ->
die "From the command line:\n\
@{<error>Error@}: Don't know about directory %s!"
(Path.to_string_maybe_quoted dir)
| Some dir -> dir
let dep_multi_contexts ~dir ~name ~file_tree ~contexts =
ignore
(find_dir_specified_on_command_line ~dir ~file_tree : File_tree.Dir.t);
Build.paths (List.map contexts ~f:(fun ctx ->
let dir = Path.append (Path.(relative build_dir) ctx) dir in
stamp_file (make ~dir name)))
let is_standard = function
| "runtest" | "install" | "doc" | "doc-private" | "lint" -> true
| "runtest" | "install" | "doc" | "doc-private" | "lint" | "default" -> true
| _ -> false
open Build.O
let dep_rec_internal ~name ~dir ~ctx_dir =
File_tree.Dir.fold dir ~traverse_ignored_dirs:false ~init:(Build.return true)
~f:(fun dir acc ->
let path = Path.append ctx_dir (File_tree.Dir.path dir) in
let fn = stamp_file (make ~dir:path name) in
acc
>>>
Build.if_file_exists fn
~then_:(Build.path fn >>^ fun _ -> false)
~else_:(Build.arr (fun x -> x)))
Build.lazy_no_targets (lazy (
File_tree.Dir.fold dir ~traverse_ignored_dirs:false
~init:(Build.return true)
~f:(fun dir acc ->
let path = Path.append ctx_dir (File_tree.Dir.path dir) in
let fn = stamp_file (make ~dir:path name) in
acc
>>>
Build.if_file_exists fn
~then_:(Build.path fn >>^ fun _ -> false)
~else_:(Build.arr (fun x -> x)))))
let dep_rec t ~loc ~file_tree =
let ctx_dir, src_dir = Path.extract_build_context_dir t.dir |> Option.value_exn in
let ctx_dir, src_dir =
Path.extract_build_context_dir t.dir |> Option.value_exn
in
match File_tree.find_dir file_tree src_dir with
| None -> Build.fail { fail = fun () ->
Loc.fail loc "Don't know about directory %s!" (Path.to_string_maybe_quoted src_dir) }
| None ->
Build.fail { fail = fun () ->
Loc.fail loc "Don't know about directory %s!"
(Path.to_string_maybe_quoted src_dir) }
| Some dir ->
dep_rec_internal ~name:t.name ~dir ~ctx_dir
>>^ fun is_empty ->
if is_empty && not (is_standard t.name) then
Loc.fail loc "This alias is empty.\n\
Alias %S is not defined in %s or any of its descendants."
Loc.fail loc
"This alias is empty.\n\
Alias %S is not defined in %s or any of its descendants."
t.name (Path.to_string_maybe_quoted src_dir)
let dep_rec_multi_contexts ~dir:src_dir ~name ~file_tree ~contexts =
match File_tree.find_dir file_tree src_dir with
| None ->
let open Build.O in
let dir = find_dir_specified_on_command_line ~dir:src_dir ~file_tree in
Build.all (List.map contexts ~f:(fun ctx ->
let ctx_dir = Path.(relative build_dir) ctx in
dep_rec_internal ~name ~dir ~ctx_dir))
>>^ fun is_empty_list ->
let is_empty = List.for_all is_empty_list ~f:(fun x -> x) in
if is_empty && not (is_standard name) then
die "From the command line:\n\
@{<error>Error@}: Don't know about directory %s!" (Path.to_string_maybe_quoted src_dir)
| Some dir ->
let open Build.O in
Build.all (List.map contexts ~f:(fun ctx ->
let ctx_dir = Path.(relative build_dir) ctx in
dep_rec_internal ~name ~dir ~ctx_dir))
>>^ fun is_empty_list ->
let is_empty = List.for_all is_empty_list ~f:(fun x -> x) in
if is_empty && not (is_standard name) then
die "From the command line:\n\
@{<error>Error@}: Alias %s is empty.\n\
It is not defined in %s or any of its descendants."
name (Path.to_string_maybe_quoted src_dir)
@{<error>Error@}: Alias %S is empty.\n\
It is not defined in %s or any of its descendants."
name (Path.to_string_maybe_quoted src_dir)
let default = make "DEFAULT"
let default = make "default"
let runtest = make "runtest"
let install = make "install"
let doc = make "doc"
@ -502,6 +526,8 @@ module Build_exec = struct
with exn ->
on_error exn
end
| Lazy_no_targets t ->
exec dyn_deps (Lazy.force t) x
| Memo m ->
match m.state with
| Evaluated (x, deps) ->
@ -659,9 +685,9 @@ let no_rule_found =
die "No rule found for %s" (Utils.describe_target fn)
in
fun t fn ->
match Path.extract_build_context fn with
| None -> fail fn
| Some (ctx, _) ->
match Utils.analyse_target fn with
| Other _ -> fail fn
| Regular (ctx, _) ->
if String.Map.mem t.contexts ctx then
fail fn
else
@ -669,6 +695,15 @@ let no_rule_found =
(Path.to_string_maybe_quoted fn)
ctx
(hint ctx (String.Map.keys t.contexts))
| Alias (ctx, fn') ->
if String.Map.mem t.contexts ctx then
fail fn
else
let fn = Path.append (Path.relative Path.build_dir ctx) fn' in
die "Trying to build alias %s but build context %s doesn't exist.%s"
(Path.to_string_maybe_quoted fn)
ctx
(hint ctx (String.Map.keys t.contexts))
let rec compile_rule t ?(copy_source=false) pre_rule =
let { Pre_rule.
@ -684,20 +719,19 @@ let rec compile_rule t ?(copy_source=false) pre_rule =
pre_rule
in
let targets = Target.paths target_specs in
let { Build_interpret.Static_deps.
rule_deps
; action_deps = static_deps
} = Build_interpret.static_deps build ~all_targets:(targets_of t)
~file_tree:t.file_tree
let static_deps =
lazy (Build_interpret.static_deps build ~all_targets:(targets_of t)
~file_tree:t.file_tree)
in
let eval_rule () =
t.hook Rule_started;
wait_for_deps t rule_deps
wait_for_deps t (Lazy.force static_deps).rule_deps
>>| fun () ->
Build_exec.exec t build ()
in
let exec_rule (rule_evaluation : Exec_status.rule_evaluation) =
let static_deps = (Lazy.force static_deps).action_deps in
Fiber.fork_and_join_unit
(fun () ->
wait_for_deps t static_deps)
@ -801,7 +835,6 @@ let rec compile_rule t ?(copy_source=false) pre_rule =
{ Internal_rule.
id = Internal_rule.Id.gen ()
; static_deps
; rule_deps
; targets
; build
; context
@ -889,7 +922,27 @@ and load_dir_step2_exn t ~dir ~collector ~lazy_generators =
let alias_dir = Path.append (Path.relative alias_dir context_name) sub_dir in
let alias_rules, alias_stamp_files =
let open Build.O in
String.Map.foldi collector.aliases ~init:([], Path.Set.empty)
let aliases = collector.aliases in
let aliases =
if String.Map.mem collector.aliases "default" then
aliases
else
match Path.extract_build_context_dir dir with
| None -> aliases
| Some (ctx_dir, src_dir) ->
match File_tree.find_dir t.file_tree src_dir with
| None -> aliases
| Some dir ->
String.Map.add aliases "default"
{ deps = Path.Set.empty
; dyn_deps =
(Alias0.dep_rec_internal ~name:"install" ~dir ~ctx_dir
>>^ fun (_ : bool) ->
Path.Set.empty)
; actions = []
}
in
String.Map.foldi aliases ~init:([], Path.Set.empty)
~f:(fun name { Dir_status. deps; dyn_deps; actions } (rules, alias_stamp_files) ->
let base_path = Path.relative alias_dir name in
let rules, deps =
@ -1251,7 +1304,8 @@ let rules_for_targets t targets =
Internal_rule.Id.Top_closure.top_closure (rules_for_files t targets)
~key:(fun (r : Internal_rule.t) -> r.id)
~deps:(fun (r : Internal_rule.t) ->
rules_for_files t (Path.Set.union r.static_deps r.rule_deps))
let x = Lazy.force r.static_deps in
rules_for_files t (Path.Set.union x.action_deps x.rule_deps))
with
| Ok l -> l
| Error cycle ->
@ -1273,8 +1327,8 @@ let static_deps_of_request t request =
let all_lib_deps t ~request =
let targets = static_deps_of_request t request in
List.fold_left (rules_for_targets t targets) ~init:Path.Map.empty
~f:(fun acc (rule : Internal_rule.t) ->
let deps = Build_interpret.lib_deps rule.build in
~f:(fun acc rule ->
let deps = Internal_rule.lib_deps rule in
if String.Map.is_empty deps then
acc
else
@ -1288,8 +1342,8 @@ let all_lib_deps t ~request =
let all_lib_deps_by_context t ~request =
let targets = static_deps_of_request t request in
let rules = rules_for_targets t targets in
List.fold_left rules ~init:[] ~f:(fun acc (rule : Internal_rule.t) ->
let deps = Build_interpret.lib_deps rule.build in
List.fold_left rules ~init:[] ~f:(fun acc rule ->
let deps = Internal_rule.lib_deps rule in
if String.Map.is_empty deps then
acc
else
@ -1358,9 +1412,10 @@ let build_rules_internal ?(recursive=false) t ~request =
Fiber.fork (fun () ->
Fiber.Future.wait rule_evaluation
>>| fun (action, dyn_deps) ->
let static_deps = (Lazy.force ir.static_deps).action_deps in
{ Rule.
id = ir.id
; deps = Path.Set.union ir.static_deps dyn_deps
; deps = Path.Set.union static_deps dyn_deps
; targets = ir.targets
; context = ir.context
; action = action
@ -1437,7 +1492,9 @@ let package_deps t pkg files =
Option.value_exn (Fiber.Future.peek rule_evaluation)
| Not_started _ -> assert false
in
Path.Set.fold (Path.Set.union ir.static_deps dyn_deps) ~init:acc ~f:loop
Path.Set.fold
(Path.Set.union (Lazy.force ir.static_deps).action_deps dyn_deps)
~init:acc ~f:loop
end
in
let open Build.O in

8
src/build_system.mli
View File

@ -129,6 +129,14 @@ module Alias : sig
(** [dep t = Build.path (stamp_file t)] *)
val dep : t -> ('a, 'a) Build.t
(** Implements [@@alias] on the command line *)
val dep_multi_contexts
: dir:Path.t
-> name:string
-> file_tree:File_tree.t
-> contexts:string list
-> (unit, unit) Build.t
(** Implements [(alias_rec ...)] in dependency specification *)
val dep_rec
: t

20
src/ordered_set_lang.ml
View File

@ -271,6 +271,26 @@ module Unexpanded = struct
in
loop t.ast
type position = Pos | Neg
let fold_strings t ~init ~f =
let rec loop (t : ast) pos acc =
let open Ast in
match t with
| Standard | Include _ -> acc
| Element x -> f pos x acc
| Union l -> List.fold_left l ~init:acc ~f:(fun acc x -> loop x pos acc)
| Diff (l, r) ->
let acc = loop l pos acc in
let pos =
match pos with
| Pos -> Neg
| Neg -> Pos
in
loop r pos acc
in
loop t.ast Pos init
let expand t ~files_contents ~f =
let context = t.context in
let rec expand (t : ast) : ast_expanded =

11
src/ordered_set_lang.mli
View File

@ -76,6 +76,17 @@ module Unexpanded : sig
-> files_contents:Sexp.Ast.t String.Map.t
-> f:(String_with_vars.t -> string)
-> expanded
type position = Pos | Neg
(** Fold a function over all strings in a set. The callback receive
whether the string is in position or negative position, i.e. on
the left or right of a [\] operator. *)
val fold_strings
: t
-> init:'a
-> f:(position -> String_with_vars.t -> 'a -> 'a)
-> 'a
end with type expanded := t
module String : S with type value = string and type 'a map = 'a String.Map.t

5
src/string_with_vars.ml
View File

@ -272,3 +272,8 @@ let is_var { template; syntax_version = _ } ~name =
match template.parts with
| [Var n] -> name = Var.full_name n
| _ -> false
let text_only t =
match t.template.parts with
| [Text s] -> Some s
| _ -> None

3
src/string_with_vars.mli
View File

@ -30,6 +30,9 @@ val virt_text : (string * int * int * int) -> string -> t
val is_var : t -> name:string -> bool
(** If [t] contains no variable, returns the contents of [t]. *)
val text_only : t -> string option
module Mode : sig
type 'a t =
| Single : Value.t t

2
test/blackbox-tests/test-cases/aliases/run.t
View File

@ -13,7 +13,7 @@
running in src
$ dune build --display short @plop
From the command line:
Error: Alias plop is empty.
Error: Alias "plop" is empty.
It is not defined in . or any of its descendants.
[1]
$ dune build --display short @truc/x

31
test/blackbox-tests/test-cases/gen-opam-install-file/run.t
View File

@ -1,33 +1,4 @@
$ dune runtest --display short
ocamldep .bar.eobjs/bar.ml.d
ocamldep .foo.objs/foo.ml.d
ocamldep .foo.objs/foo.mli.d
ocamlc .foo.objs/foo.{cmi,cmti}
ocamlopt .foo.objs/foo.{cmx,o}
ocamlopt foo.{a,cmxa}
ocamlopt foo.cmxs
ocamldep .foo_byte.objs/foo_byte.ml.d
ocamlc .foo_byte.objs/foo_byte.{cmi,cmo,cmt}
ocamlc foo_byte.cma
ocamldep ppx-new/.foo_ppx_rewriter_dune.objs/foo_ppx_rewriter_dune.ml.d
ocamlc ppx-new/.foo_ppx_rewriter_dune.objs/foo_ppx_rewriter_dune.{cmi,cmo,cmt}
ocamlopt ppx-new/.foo_ppx_rewriter_dune.objs/foo_ppx_rewriter_dune.{cmx,o}
ocamlopt ppx-new/foo_ppx_rewriter_dune.{a,cmxa}
ocamlopt ppx-new/foo_ppx_rewriter_dune.cmxs
ocamldep ppx-old/.foo_ppx_rewriter_jbuild.objs/foo_ppx_rewriter_jbuild.ml.d
ocamlc ppx-old/.foo_ppx_rewriter_jbuild.objs/foo_ppx_rewriter_jbuild.{cmi,cmo,cmt}
ocamlopt ppx-old/.foo_ppx_rewriter_jbuild.objs/foo_ppx_rewriter_jbuild.{cmx,o}
ocamlopt ppx-old/foo_ppx_rewriter_jbuild.{a,cmxa}
ocamlopt ppx-old/foo_ppx_rewriter_jbuild.cmxs
ocamlc .foo.objs/foo.{cmo,cmt}
ocamlc foo.cma
ocamlc .bar.eobjs/bar.{cmi,cmo,cmt}
ocamlopt .bar.eobjs/bar.{cmx,o}
ocamlopt bar.exe
ocamlc ppx-new/foo_ppx_rewriter_dune.cma
ocamlopt .ppx/foo.ppx_rewriter_dune/ppx.exe
ocamlc ppx-old/foo_ppx_rewriter_jbuild.cma
ocamlopt .ppx/jbuild/foo.ppx_rewriter_jbuild/ppx.exe
$ dune runtest
lib: [
"_build/install/default/lib/foo/META" {"META"}
"_build/install/default/lib/foo/opam" {"opam"}