Add support for dune files
This commit is contained in:
parent
cb4e167232
commit
70abc5544d
|
@ -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,
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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)
|
||||||
|
|
Loading…
Reference in New Issue