diff --git a/CHANGES.md b/CHANGES.md index 5479b745..94aaac97 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -29,6 +29,11 @@ was renamed `per_module` and it is planned to reuse `per_file` for another purpose +- Warn when a file is both present in the source tree and generated by + a rule. Before, jbuilder would silently ignore the rule. One now has + to add a field `(fallback)` to custom rules to keep the current + behavior (#218) + 1.0+beta11 (21/07/2017) ----------------------- diff --git a/doc/jbuild.rst b/doc/jbuild.rst index 8fe84ed8..630d10fa 100644 --- a/doc/jbuild.rst +++ b/doc/jbuild.rst @@ -280,18 +280,27 @@ The syntax is as follows: (rule ((targets ()) - (deps ()) - (action ))) + (action ) + )) ```` is a list of file names. Note that currently Jbuilder only support user rules with targets in the current directory. -```` specifies the dependencies of the rule. See the `Dependency -specification`_ section for more details. - ```` is the action to run to produce the targets from the dependencies. See the `User actions`_ section for more details. +```` are: + +- ``(deps ())`` to specify the dependencies of the + rule. See the `Dependency specification`_ section for more details. + +- ``(fallback)`` to specify that this is a fallback rule. A fallback + rule means that if the targets are already present in the source + tree, jbuilder will ignore the rule. It is an error if only a subset + of the targets are present in the tree. The common use of fallback + rules is to generate default configuration files that may be + generated by a configure script. + Note that contrary to makefiles or other build systems, user rules currently don't support patterns, such as a rule to produce ``%.y`` from ``%.x`` for any given ``%``. This might be supported in the future. diff --git a/example/sample-projects/with-configure-step/jbuild b/example/sample-projects/with-configure-step/jbuild index 869e14a5..9333cbb3 100644 --- a/example/sample-projects/with-configure-step/jbuild +++ b/example/sample-projects/with-configure-step/jbuild @@ -1,7 +1,8 @@ (jbuild_version 1) (rule - ((targets (config)) + ((fallback) + (targets (config)) (deps (config.defaults)) (action (copy ${<} ${@})))) diff --git a/src/build_interpret.ml b/src/build_interpret.ml index 7cf496d3..3ab28a4b 100644 --- a/src/build_interpret.ml +++ b/src/build_interpret.ml @@ -149,16 +149,21 @@ let targets = module Rule = struct type t = - { context : Context.t option - ; build : (unit, Action.t) Build.t - ; targets : Target.t list - ; sandbox : bool + { context : Context.t option + ; build : (unit, Action.t) Build.t + ; targets : Target.t list + ; sandbox : bool + ; fallback : Jbuild.Rule.Fallback.t + ; loc : Loc.t option } - let make ?(sandbox=false) ?context build = + let make ?(sandbox=false) ?(fallback=Jbuild.Rule.Fallback.Not_possible) + ?context ?loc build = { context ; build ; targets = targets build ; sandbox + ; fallback + ; loc } end diff --git a/src/build_interpret.mli b/src/build_interpret.mli index 34839c03..c1e76fb0 100644 --- a/src/build_interpret.mli +++ b/src/build_interpret.mli @@ -11,13 +11,21 @@ end module Rule : sig type t = - { context : Context.t option - ; build : (unit, Action.t) Build.t - ; targets : Target.t list - ; sandbox : bool + { context : Context.t option + ; build : (unit, Action.t) Build.t + ; targets : Target.t list + ; sandbox : bool + ; fallback : Jbuild.Rule.Fallback.t + ; loc : Loc.t option } - val make : ?sandbox:bool -> ?context:Context.t -> (unit, Action.t) Build.t -> t + val make + : ?sandbox:bool + -> ?fallback:Jbuild.Rule.Fallback.t + -> ?context:Context.t + -> ?loc:Loc.t + -> (unit, Action.t) Build.t + -> t end module Static_deps : sig diff --git a/src/build_system.ml b/src/build_system.ml index f456fd16..8135371e 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -58,17 +58,36 @@ module Internal_rule = struct n end + module Fallback_status = struct + type t = + (* The argument is the set of targets that are already present in the source + tree. *) + | Yes of Pset.t + | No + | Not_possible + end + type t = - { id : Id.t - ; rule_deps : Pset.t - ; static_deps : Pset.t - ; targets : Pset.t - ; context : Context.t option - ; build : (unit, Action.t) Build.t - ; mutable exec : Exec_status.t + { id : Id.t + ; rule_deps : Pset.t + ; static_deps : Pset.t + ; targets : Pset.t + ; context : Context.t option + ; build : (unit, Action.t) Build.t + ; mutable fallback : Fallback_status.t + ; loc : Loc.t option + ; mutable exec : Exec_status.t } let compare a b = Id.compare a.id b.id + + let loc ~dir t = + match t.loc with + | Some loc -> loc + | None -> + Loc.in_file + (Path.to_string + (Path.drop_build_context (Path.relative dir "jbuild"))) end module File_kind = struct @@ -324,17 +343,50 @@ module Build_exec = struct (action, !dyn_deps) end -let add_spec t fn spec ~allow_override = - if not allow_override && Hashtbl.mem t.files fn then - die "multiple rules generated for %s" (Path.to_string fn); - Hashtbl.add t.files ~key:fn ~data:spec +(* This variable is filled during the creation of the build system. Once the build system + is created, we check that all the fallback rules that got disabled are completely + disabled, i.e. that all their targets already exist in the source tree. *) +let disabled_fallback_rules = ref [] -let create_file_specs t targets rule ~allow_override = +(* [copy_source] is [true] for rules copying files from the source directory *) +let add_spec t fn spec ~copy_source = + match Hashtbl.find t.files fn with + | None -> + Hashtbl.add t.files ~key:fn ~data:spec + | Some (File_spec.T { rule; _ }) -> + match copy_source, rule.fallback with + | true, Yes already_present -> + if Pset.is_empty already_present then + disabled_fallback_rules := rule :: !disabled_fallback_rules; + rule.fallback <- Yes (Pset.add fn already_present); + Hashtbl.add t.files ~key:fn ~data:spec + | true, (No | Not_possible) -> + Loc.warn (Internal_rule.loc rule ~dir:(Path.parent fn)) + "File %s is both generated by a rule and present in the source tree.\n\ + As a result, the rule is currently ignored, however this will become an error \ + in the future.\n\ + %t" + (maybe_quoted (Path.basename fn)) + (fun ppf -> + match rule.fallback with + | Yes _ -> assert false + | Not_possible -> + Format.fprintf ppf "Delete file %s to get rid of this warning." + (Path.to_string_maybe_quoted (Path.drop_build_context fn)) + | No -> + Format.fprintf ppf + "To keep the current behavior and get rid of this warning, add a field \ + (fallback) to the rule."); + Hashtbl.add t.files ~key:fn ~data:spec + | false, _ -> + die "multiple rules generated for %s" (Path.to_string_maybe_quoted fn) + +let create_file_specs t targets rule ~copy_source = List.iter targets ~f:(function | Target.Normal fn -> - add_spec t fn (File_spec.create rule Ignore_contents) ~allow_override + add_spec t fn (File_spec.create rule Ignore_contents) ~copy_source | Target.Vfile (Vspec.T (fn, kind)) -> - add_spec t fn (File_spec.create rule (Sexp_file kind)) ~allow_override) + add_spec t fn (File_spec.create rule (Sexp_file kind)) ~copy_source) module Pre_rule = Build_interpret.Rule @@ -391,8 +443,17 @@ let make_local_parent_dirs t paths ~map_path = let sandbox_dir = Path.of_string "_build/.sandbox" -let compile_rule t ~all_targets_by_dir ?(allow_override=false) pre_rule = - let { Pre_rule. context; build; targets = target_specs; sandbox } = pre_rule in +let compile_rule t ~all_targets_by_dir ?(copy_source=false) pre_rule = + let { Pre_rule. + context + ; build + ; targets = target_specs + ; sandbox + ; fallback + ; loc + } = + pre_rule + in let targets = Target.paths target_specs in let { Build_interpret.Static_deps. rule_deps @@ -509,9 +570,14 @@ let compile_rule t ~all_targets_by_dir ?(allow_override=false) pre_rule = ; build ; context ; exec = Not_started { eval_rule; exec_rule } + ; fallback = (match fallback with + | Yes -> Yes Pset.empty + | No -> No + | Not_possible -> Not_possible) + ; loc } in - create_file_specs t target_specs rule ~allow_override + create_file_specs t target_specs rule ~copy_source let setup_copy_rules t ~all_non_target_source_files ~all_targets_by_dir = List.iter t.contexts ~f:(fun (ctx : Context.t) -> @@ -532,7 +598,7 @@ let setup_copy_rules t ~all_non_target_source_files ~all_targets_by_dir = should allow it on a case-by-case basis though. *) compile_rule t (Pre_rule.make build) ~all_targets_by_dir - ~allow_override:true)) + ~copy_source:true)) module Trace = struct type t = (Path.t, Digest.t) Hashtbl.t @@ -613,10 +679,45 @@ let create ~contexts ~file_tree ~rules = ; timestamps = Hashtbl.create 1024 ; local_mkdirs = Path.Local.Set.empty } in - List.iter rules ~f:(compile_rule t ~all_targets_by_dir ~allow_override:false); + List.iter rules ~f:(compile_rule t ~all_targets_by_dir ~copy_source:false); setup_copy_rules t ~all_targets_by_dir ~all_non_target_source_files: (Pset.diff all_source_files all_other_targets); + + (let l = !disabled_fallback_rules in + disabled_fallback_rules := []; + List.iter l ~f:(fun rule -> + let disabled_for = + match rule.Internal_rule.fallback with + | No | Not_possible -> assert false + | Yes paths -> paths + in + let leftover_targets = Pset.diff rule.targets disabled_for in + if not (Pset.is_empty leftover_targets) then begin + let list_paths set = + Pset.elements set + |> List.map ~f:(fun p -> sprintf "- %s" + (Path.to_string_maybe_quoted + (Path.drop_build_context p))) + |> String.concat ~sep:"\n" + in + Loc.fail (Internal_rule.loc rule ~dir:(Path.parent (Pset.choose leftover_targets))) + "\ +Some of the targets of this fallback rule are present in the source tree, +and some are not. This is not allowed. Either none of the targets must +be present in the source tree, either they must all be. + +The following targets are present: +%s + +The following targets are not: +%s +" + (list_paths disabled_for) + (list_paths leftover_targets) + end + )); + at_exit (fun () -> dump_trace t); t diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 7cfc2553..8a109458 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -528,7 +528,7 @@ module Gen(P : Params) = struct | Infer -> Infer | Static fns -> Static (List.map fns ~f:(Path.relative dir)) in - SC.add_rule sctx + SC.add_rule sctx ~fallback:rule.fallback ~loc:rule.loc (SC.Deps.interpret sctx ~scope ~dir rule.deps >>> SC.Action.run diff --git a/src/import.ml b/src/import.ml index 31f1b9d7..29f5ee59 100644 --- a/src/import.ml +++ b/src/import.ml @@ -191,6 +191,10 @@ module String_map = Map.Make(String) module String = struct include StringLabels + let break s ~pos = + (sub s ~pos:0 ~len:pos, + sub s ~pos ~len:(String.length s - pos)) + let is_prefix s ~prefix = let len = length s in let prefix_len = length prefix in diff --git a/src/jbuild.ml b/src/jbuild.ml index 8b3e0f37..74de14ce 100644 --- a/src/jbuild.ml +++ b/src/jbuild.ml @@ -710,28 +710,45 @@ module Rule = struct | Infer end + module Fallback = struct + type t = + | Yes + | No + | Not_possible + end + type t = - { targets : Targets.t - ; deps : Dep_conf.t list - ; action : Action.Unexpanded.t + { targets : Targets.t + ; deps : Dep_conf.t list + ; action : Action.Unexpanded.t + ; fallback : Fallback.t + ; loc : Loc.t } let v1 sexp = match sexp with | List (_, (Atom _ :: _)) -> - { targets = Infer - ; deps = [] - ; action = Action.Unexpanded.t sexp + { targets = Infer + ; deps = [] + ; action = Action.Unexpanded.t sexp + ; fallback = No + ; loc = Loc.none } | _ -> record (field "targets" (list file_in_current_dir) >>= fun targets -> field "deps" (list Dep_conf.t) ~default:[] >>= fun deps -> field "action" Action.Unexpanded.t >>= fun action -> - return { targets = Static targets; deps; action }) + field_b "fallback" >>= fun fallback -> + return { targets = Static targets + ; deps + ; action + ; fallback = if fallback then Yes else No + ; loc = Loc.none + }) sexp - let ocamllex_v1 names = + let ocamllex_v1 loc names = let module S = String_with_vars in List.map names ~f:(fun name -> let src = name ^ ".mll" in @@ -747,9 +764,11 @@ module Rule = struct ; S.virt_var __POS__ "@" ; S.virt_var __POS__"<" ])) + ; fallback = Not_possible + ; loc }) - let ocamlyacc_v1 names = + let ocamlyacc_v1 loc names = let module S = String_with_vars in List.map names ~f:(fun name -> let src = name ^ ".mly" in @@ -760,6 +779,8 @@ module Rule = struct (S.virt_var __POS__ "ROOT", Run (S.virt_text __POS__ "ocamlyacc", [S.virt_var __POS__ "<"])) + ; fallback = Not_possible + ; loc }) end @@ -782,7 +803,7 @@ module Menhir = struct } ) - let v1_to_rule t = + let v1_to_rule loc t = let module S = String_with_vars in let targets n = [n ^ ".ml"; n ^ ".mli"] in match t.merge_into with @@ -797,7 +818,9 @@ module Menhir = struct (S.virt_var __POS__ "ROOT", Run (S.virt_text __POS__ "menhir", t.flags @ [S.virt_var __POS__ "<"])) - }) + ; fallback = Not_possible + ; loc + }) | Some merge_into -> let mly m = S.virt_text __POS__ (m ^ ".mly") in [{ Rule. @@ -813,6 +836,8 @@ module Menhir = struct @ t.flags @ (List.map ~f:mly t.modules)) ) + ; fallback = Not_possible + ; loc }] end @@ -882,10 +907,10 @@ module Stanza = struct [ cstr "library" (Library.v1 pkgs @> nil) (fun x -> [Library x]) ; cstr "executable" (Executables.v1_single pkgs @> nil) execs ; cstr "executables" (Executables.v1_multi pkgs @> nil) execs - ; cstr "rule" (Rule.v1 @> nil) (fun x -> [Rule x]) - ; cstr "ocamllex" (list string @> nil) (fun x -> rules (Rule.ocamllex_v1 x)) - ; cstr "ocamlyacc" (list string @> nil) (fun x -> rules (Rule.ocamlyacc_v1 x)) - ; cstr "menhir" (Menhir.v1 @> nil) (fun x -> rules (Menhir.v1_to_rule x)) + ; cstr_loc "rule" (Rule.v1 @> nil) (fun loc x -> [Rule { x with loc }]) + ; cstr_loc "ocamllex" (list string @> nil) (fun loc x -> rules (Rule.ocamllex_v1 loc x)) + ; cstr_loc "ocamlyacc" (list string @> nil) (fun loc x -> rules (Rule.ocamlyacc_v1 loc x)) + ; cstr_loc "menhir" (Menhir.v1 @> nil) (fun loc x -> rules (Menhir.v1_to_rule loc x)) ; cstr "install" (Install_conf.v1 pkgs @> nil) (fun x -> [Install x]) ; cstr "alias" (Alias_conf.v1 pkgs @> nil) (fun x -> [Alias x]) (* Just for validation and error messages *) diff --git a/src/jbuild.mli b/src/jbuild.mli index 583825b3..15e1828b 100644 --- a/src/jbuild.mli +++ b/src/jbuild.mli @@ -188,10 +188,21 @@ module Rule : sig | Infer end + module Fallback : sig + type t = + | Yes + | No + | Not_possible + (** It is not possible to add a [(fallback)] field to the rule. For instance for + [ocamllex], ... *) + end + type t = - { targets : Targets.t - ; deps : Dep_conf.t list - ; action : Action.Unexpanded.t + { targets : Targets.t + ; deps : Dep_conf.t list + ; action : Action.Unexpanded.t + ; fallback : Fallback.t + ; loc : Loc.t } end diff --git a/src/super_context.ml b/src/super_context.ml index 02f44dd3..749a17cb 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -213,9 +213,9 @@ let create | _ -> Chdir (context.build_dir, action)) } -let add_rule t ?sandbox build = +let add_rule t ?sandbox ?fallback ?loc build = let build = Build.O.(>>>) build t.chdir in - let rule = Build_interpret.Rule.make ?sandbox ~context:t.context build in + let rule = Build_interpret.Rule.make ?sandbox ?fallback ?loc ~context:t.context build in t.rules <- rule :: t.rules; t.known_targets_by_src_dir_so_far <- List.fold_left rule.targets ~init:t.known_targets_by_src_dir_so_far diff --git a/src/super_context.mli b/src/super_context.mli index 71cb8747..f54c4569 100644 --- a/src/super_context.mli +++ b/src/super_context.mli @@ -41,8 +41,18 @@ val cxx_flags : t -> string list val expand_vars : t -> scope:Scope.t -> dir:Path.t -> String_with_vars.t -> string -val add_rule : t -> ?sandbox:bool -> (unit, Action.t) Build.t -> unit -val add_rules : t -> ?sandbox:bool -> (unit, Action.t) Build.t list -> unit +val add_rule + : t + -> ?sandbox:bool + -> ?fallback:Jbuild.Rule.Fallback.t + -> ?loc:Loc.t + -> (unit, Action.t) Build.t + -> unit +val add_rules + : t + -> ?sandbox:bool + -> (unit, Action.t) Build.t list + -> unit val rules : t -> Build_interpret.Rule.t list val sources_and_targets_known_so_far : t -> src_path:Path.t -> String_set.t