Add support for dune files

This commit is contained in:
Jeremie Dimino 2018-05-03 14:04:51 +01:00 committed by Jérémie Dimino
parent cb4e167232
commit 70abc5544d
3 changed files with 33 additions and 14 deletions

View File

@ -124,13 +124,22 @@ module Exec_status = struct
| Running of Running.t | Running of Running.t
end end
let rule_loc ~loc ~dir = let rule_loc ~file_tree ~loc ~dir =
match loc with match loc with
| Some loc -> loc | Some loc -> loc
| None -> | None ->
let dir = Path.drop_optional_build_context dir in
let fname =
if File_tree.file_exists file_tree dir "dune" then
"dune"
else if File_tree.file_exists file_tree dir "jbuild" then
"jbuild"
else
"_unknown_"
in
Loc.in_file Loc.in_file
(Path.to_string (Path.to_string
(Path.drop_optional_build_context (Path.relative dir "jbuild"))) (Path.drop_optional_build_context (Path.relative dir fname)))
module Internal_rule = struct module Internal_rule = struct
module Id : sig module Id : sig
@ -172,7 +181,7 @@ module Internal_rule = struct
let compare a b = Id.compare a.id b.id let compare a b = Id.compare a.id b.id
let loc ~dir t = rule_loc ~dir ~loc:t.loc let loc ~file_tree ~dir t = rule_loc ~file_tree ~dir ~loc:t.loc
end end
module File_kind = struct module File_kind = struct
@ -514,7 +523,8 @@ let add_spec t fn spec ~copy_source =
| Some (File_spec.T { rule; _ }) -> | Some (File_spec.T { rule; _ }) ->
match copy_source, rule.mode with match copy_source, rule.mode with
| true, (Standard | Not_a_rule_stanza) -> | true, (Standard | Not_a_rule_stanza) ->
Loc.warn (Internal_rule.loc rule ~dir:(Path.parent fn)) Loc.warn (Internal_rule.loc rule ~dir:(Path.parent fn)
~file_tree:t.file_tree)
"File %s is both generated by a rule and present in the source tree.\n\ "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 \ As a result, the rule is currently ignored, however this will become an error \
in the future.\n\ in the future.\n\
@ -989,7 +999,9 @@ and load_dir_step2_exn t ~dir ~collector ~lazy_generators =
Pset.diff source_files_for_targtes absent_targets Pset.diff source_files_for_targtes absent_targets
in in
Loc.fail Loc.fail
(rule_loc ~loc:rule.loc (rule_loc
~file_tree:t.file_tree
~loc:rule.loc
~dir:(Path.drop_optional_build_context dir)) ~dir:(Path.drop_optional_build_context dir))
"\ "\
Some of the targets of this fallback rule are present in the source tree, Some of the targets of this fallback rule are present in the source tree,

View File

@ -12,6 +12,7 @@ let filter_stanzas ~ignore_promoted_rules stanzas =
module Jbuilds = struct module Jbuilds = struct
type script = type script =
{ dir : Path.t { dir : Path.t
; file : Path.t
; scope : Scope_info.t ; scope : Scope_info.t
} }
@ -114,8 +115,7 @@ end
| Literal x -> Left x | Literal x -> Left x
| Script x -> Right x) | Script x -> Right x)
in in
Fiber.parallel_map dynamic ~f:(fun { dir; scope } -> Fiber.parallel_map dynamic ~f:(fun { dir; file; scope } ->
let file = Path.relative dir "jbuild" in
let generated_jbuild = let generated_jbuild =
Path.append (Path.relative generated_jbuilds_dir context.name) file Path.append (Path.relative generated_jbuilds_dir context.name) file
in in
@ -207,15 +207,15 @@ module Sexp_io = struct
loop0 Parser.Stack.empty 0) loop0 Parser.Stack.empty 0)
end end
let load ~dir ~scope ~ignore_promoted_rules = let load ~dir ~scope ~ignore_promoted_rules ~fname =
let file = Path.relative dir "jbuild" in let file = Path.relative dir fname in
match Sexp_io.load_many_or_ocaml_script file with match Sexp_io.load_many_or_ocaml_script file with
| Sexps sexps -> | Sexps sexps ->
Jbuilds.Literal (dir, scope, Jbuilds.Literal (dir, scope,
Stanzas.parse scope sexps ~file Stanzas.parse scope sexps ~file
|> filter_stanzas ~ignore_promoted_rules) |> filter_stanzas ~ignore_promoted_rules)
| Ocaml_script -> | Ocaml_script ->
Script { dir; scope } Script { dir; scope; file }
let load ?extra_ignored_subtrees ?(ignore_promoted_rules=false) () = let load ?extra_ignored_subtrees ?(ignore_promoted_rules=false) () =
let ftree = File_tree.load Path.root ?extra_ignored_subtrees in let ftree = File_tree.load Path.root ?extra_ignored_subtrees in
@ -303,8 +303,15 @@ let load ?extra_ignored_subtrees ?(ignore_promoted_rules=false) () =
let sub_dirs = File_tree.Dir.sub_dirs dir in let sub_dirs = File_tree.Dir.sub_dirs dir in
let scope = Option.value (Path.Map.find scopes path) ~default:scope in let scope = Option.value (Path.Map.find scopes path) ~default:scope in
let jbuilds = let jbuilds =
if String.Set.mem files "jbuild" then if String.Set.mem files "dune" then
let jbuild = load ~dir:path ~scope ~ignore_promoted_rules in let jbuild =
load ~dir:path ~scope ~ignore_promoted_rules ~fname:"dune"
in
jbuild :: jbuilds
else if String.Set.mem files "jbuild" then
let jbuild =
load ~dir:path ~scope ~ignore_promoted_rules ~fname:"jbuild"
in
jbuild :: jbuilds jbuild :: jbuilds
else else
jbuilds jbuilds

View File

@ -237,7 +237,7 @@ let run_internal ?dir ?(stdout_to=Terminal) ?(stderr_to=Terminal) ~env ~purpose
let output_filename, stdout_fd, stderr_fd, to_close = let output_filename, stdout_fd, stderr_fd, to_close =
match stdout_to, stderr_to with match stdout_to, stderr_to with
| (Terminal, _ | _, Terminal) when !Clflags.capture_outputs -> | (Terminal, _ | _, Terminal) when !Clflags.capture_outputs ->
let fn = Temp.create "jbuilder" ".output" in let fn = Temp.create "dune" ".output" in
let fd = Unix.openfile (Path.to_string fn) [O_WRONLY; O_SHARE_DELETE] 0 in let fd = Unix.openfile (Path.to_string fn) [O_WRONLY; O_SHARE_DELETE] 0 in
(Some fn, fd, fd, Some fd) (Some fn, fd, fd, Some fd)
| _ -> | _ ->
@ -329,7 +329,7 @@ let run ?dir ?stdout_to ?stderr_to ~env ?(purpose=Internal_job) fail_mode
~f:ignore ~f:ignore
let run_capture_gen ?dir ~env ?(purpose=Internal_job) fail_mode prog args ~f = let run_capture_gen ?dir ~env ?(purpose=Internal_job) fail_mode prog args ~f =
let fn = Temp.create "jbuild" ".output" in let fn = Temp.create "dune" ".output" in
map_result fail_mode map_result fail_mode
(run_internal ?dir ~stdout_to:(File fn) (run_internal ?dir ~stdout_to:(File fn)
~env ~purpose fail_mode prog args) ~env ~purpose fail_mode prog args)