Add option to force running tests (#320)
Option to force running tests The mechanism allows for forcing any alias, but only forcing tests is exposed to the user. Aliases are forced by deleting all the alias files that belong to a particular alias. The option for forcing tests is called --force.
This commit is contained in:
parent
68ddb1251d
commit
785beeafac
|
@ -62,9 +62,10 @@ let execve =
|
||||||
module Main = struct
|
module Main = struct
|
||||||
include Jbuilder.Main
|
include Jbuilder.Main
|
||||||
|
|
||||||
let setup ~log ?filter_out_optional_stanzas_with_missing_deps common =
|
let setup ~log ?unlink_aliases ?filter_out_optional_stanzas_with_missing_deps common =
|
||||||
setup
|
setup
|
||||||
~log
|
~log
|
||||||
|
?unlink_aliases
|
||||||
?workspace_file:common.workspace_file
|
?workspace_file:common.workspace_file
|
||||||
?only_packages:common.only_packages
|
?only_packages:common.only_packages
|
||||||
?filter_out_optional_stanzas_with_missing_deps ()
|
?filter_out_optional_stanzas_with_missing_deps ()
|
||||||
|
@ -468,7 +469,8 @@ let runtest =
|
||||||
]
|
]
|
||||||
in
|
in
|
||||||
let name_ = Arg.info [] ~docv:"DIR" in
|
let name_ = Arg.info [] ~docv:"DIR" in
|
||||||
let go common dirs =
|
let go common force dirs =
|
||||||
|
let unlink_aliases = if force then Some ["runtest"] else None in
|
||||||
set_common common
|
set_common common
|
||||||
~targets:(List.map dirs ~f:(function
|
~targets:(List.map dirs ~f:(function
|
||||||
| "" | "." -> "@runtest"
|
| "" | "." -> "@runtest"
|
||||||
|
@ -476,7 +478,7 @@ let runtest =
|
||||||
| dir -> sprintf "@%s/runtest" dir));
|
| dir -> sprintf "@%s/runtest" dir));
|
||||||
let log = Log.create () in
|
let log = Log.create () in
|
||||||
Future.Scheduler.go ~log
|
Future.Scheduler.go ~log
|
||||||
(Main.setup ~log common >>= fun setup ->
|
(Main.setup ?unlink_aliases ~log common >>= fun setup ->
|
||||||
let targets =
|
let targets =
|
||||||
List.map dirs ~f:(fun dir ->
|
List.map dirs ~f:(fun dir ->
|
||||||
let dir = Path.(relative root) (prefix_target common dir) in
|
let dir = Path.(relative root) (prefix_target common dir) in
|
||||||
|
@ -485,6 +487,7 @@ let runtest =
|
||||||
do_build setup targets) in
|
do_build setup targets) in
|
||||||
( Term.(const go
|
( Term.(const go
|
||||||
$ common
|
$ common
|
||||||
|
$ Arg.(value & flag & info ["force"; "f"])
|
||||||
$ Arg.(value & pos_all string ["."] name_))
|
$ Arg.(value & pos_all string ["."] name_))
|
||||||
, Term.info "runtest" ~doc ~man)
|
, Term.info "runtest" ~doc ~man)
|
||||||
|
|
||||||
|
|
12
src/alias.ml
12
src/alias.ml
|
@ -138,6 +138,18 @@ module Store = struct
|
||||||
Format.fprintf fmt "Store.t@ @[@<2>(%a)@]" pp_bindings bindings
|
Format.fprintf fmt "Store.t@ @[@<2>(%a)@]" pp_bindings bindings
|
||||||
|
|
||||||
let create () = Hashtbl.create 1024
|
let create () = Hashtbl.create 1024
|
||||||
|
|
||||||
|
let unlink (store : t) = function
|
||||||
|
| [] -> ()
|
||||||
|
| alias_basenames ->
|
||||||
|
store
|
||||||
|
|> Hashtbl.fold ~init:Path.Set.empty ~f:(fun ~key:_ ~data:entry acc ->
|
||||||
|
if List.mem (name entry.alias) ~set:alias_basenames then (
|
||||||
|
Path.Set.union acc (Path.Set.add entry.alias.file entry.deps)
|
||||||
|
) else (
|
||||||
|
acc
|
||||||
|
))
|
||||||
|
|> Path.Set.iter ~f:Path.unlink_no_err
|
||||||
end
|
end
|
||||||
|
|
||||||
let add_deps store t deps =
|
let add_deps store t deps =
|
||||||
|
|
|
@ -62,6 +62,8 @@ module Store : sig
|
||||||
val pp : t Fmt.t
|
val pp : t Fmt.t
|
||||||
|
|
||||||
val create : unit -> t
|
val create : unit -> t
|
||||||
|
|
||||||
|
val unlink : t -> string list -> unit
|
||||||
end
|
end
|
||||||
|
|
||||||
val add_deps : Store.t -> t -> Path.t list -> unit
|
val add_deps : Store.t -> t -> Path.t list -> unit
|
||||||
|
|
|
@ -1104,7 +1104,7 @@ Add it to your jbuild file to remove this warning.
|
||||||
end
|
end
|
||||||
|
|
||||||
let gen ~contexts ?(filter_out_optional_stanzas_with_missing_deps=true)
|
let gen ~contexts ?(filter_out_optional_stanzas_with_missing_deps=true)
|
||||||
?only_packages conf =
|
?only_packages ?(unlink_aliases=[]) conf =
|
||||||
let open Future in
|
let open Future in
|
||||||
let { Jbuild_load. file_tree; jbuilds; packages } = conf in
|
let { Jbuild_load. file_tree; jbuilds; packages } = conf in
|
||||||
let aliases = Alias.Store.create () in
|
let aliases = Alias.Store.create () in
|
||||||
|
@ -1152,5 +1152,6 @@ let gen ~contexts ?(filter_out_optional_stanzas_with_missing_deps=true)
|
||||||
|> Future.all
|
|> Future.all
|
||||||
>>| fun l ->
|
>>| fun l ->
|
||||||
let rules, context_names_and_stanzas = List.split l in
|
let rules, context_names_and_stanzas = List.split l in
|
||||||
|
Alias.Store.unlink aliases unlink_aliases;
|
||||||
(Alias.rules aliases @ List.concat rules,
|
(Alias.rules aliases @ List.concat rules,
|
||||||
String_map.of_alist_exn context_names_and_stanzas)
|
String_map.of_alist_exn context_names_and_stanzas)
|
||||||
|
|
|
@ -5,6 +5,7 @@ val gen
|
||||||
: contexts:Context.t list
|
: contexts:Context.t list
|
||||||
-> ?filter_out_optional_stanzas_with_missing_deps:bool (* default: true *)
|
-> ?filter_out_optional_stanzas_with_missing_deps:bool (* default: true *)
|
||||||
-> ?only_packages:String_set.t
|
-> ?only_packages:String_set.t
|
||||||
|
-> ?unlink_aliases:string list
|
||||||
-> Jbuild_load.conf
|
-> Jbuild_load.conf
|
||||||
-> (Build_interpret.Rule.t list *
|
-> (Build_interpret.Rule.t list *
|
||||||
(* Evaluated jbuilds per context names *)
|
(* Evaluated jbuilds per context names *)
|
||||||
|
|
|
@ -553,4 +553,11 @@ end
|
||||||
|
|
||||||
module Fmt = struct
|
module Fmt = struct
|
||||||
type 'a t = Format.formatter -> 'a -> unit
|
type 'a t = Format.formatter -> 'a -> unit
|
||||||
|
|
||||||
|
let kstrf f fmt =
|
||||||
|
let buf = Buffer.create 17 in
|
||||||
|
let f fmt = Format.pp_print_flush fmt () ; f (Buffer.contents buf) in
|
||||||
|
Format.kfprintf f (Format.formatter_of_buffer buf) fmt
|
||||||
|
|
||||||
|
let failwith fmt = kstrf failwith fmt
|
||||||
end
|
end
|
||||||
|
|
|
@ -14,7 +14,8 @@ let package_install_file { packages; _ } pkg =
|
||||||
| None -> Error ()
|
| None -> Error ()
|
||||||
| Some p -> Ok (Path.relative p.path (p.name ^ ".install"))
|
| Some p -> Ok (Path.relative p.path (p.name ^ ".install"))
|
||||||
|
|
||||||
let setup ?(log=Log.no_log) ?filter_out_optional_stanzas_with_missing_deps
|
let setup ?(log=Log.no_log) ?unlink_aliases
|
||||||
|
?filter_out_optional_stanzas_with_missing_deps
|
||||||
?workspace ?(workspace_file="jbuild-workspace")
|
?workspace ?(workspace_file="jbuild-workspace")
|
||||||
?(use_findlib=true)
|
?(use_findlib=true)
|
||||||
?only_packages
|
?only_packages
|
||||||
|
@ -47,6 +48,7 @@ let setup ?(log=Log.no_log) ?filter_out_optional_stanzas_with_missing_deps
|
||||||
List.iter contexts ~f:(fun ctx ->
|
List.iter contexts ~f:(fun ctx ->
|
||||||
Log.infof log "@[<1>Jbuilder context:@,%a@]@." Sexp.pp (Context.sexp_of_t ctx));
|
Log.infof log "@[<1>Jbuilder context:@,%a@]@." Sexp.pp (Context.sexp_of_t ctx));
|
||||||
Gen_rules.gen conf ~contexts
|
Gen_rules.gen conf ~contexts
|
||||||
|
?unlink_aliases
|
||||||
?only_packages
|
?only_packages
|
||||||
?filter_out_optional_stanzas_with_missing_deps
|
?filter_out_optional_stanzas_with_missing_deps
|
||||||
>>= fun (rules, stanzas) ->
|
>>= fun (rules, stanzas) ->
|
||||||
|
|
|
@ -17,6 +17,7 @@ val package_install_file : setup -> string -> (Path.t, unit) result
|
||||||
it. *)
|
it. *)
|
||||||
val setup
|
val setup
|
||||||
: ?log:Log.t
|
: ?log:Log.t
|
||||||
|
-> ?unlink_aliases:string list
|
||||||
-> ?filter_out_optional_stanzas_with_missing_deps:bool
|
-> ?filter_out_optional_stanzas_with_missing_deps:bool
|
||||||
-> ?workspace:Workspace.t
|
-> ?workspace:Workspace.t
|
||||||
-> ?workspace_file:string
|
-> ?workspace_file:string
|
||||||
|
|
|
@ -78,3 +78,10 @@
|
||||||
(action
|
(action
|
||||||
(chdir test-cases/aliases
|
(chdir test-cases/aliases
|
||||||
(setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} run.t))))))
|
(setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} run.t))))))
|
||||||
|
|
||||||
|
(alias
|
||||||
|
((name runtest)
|
||||||
|
(deps ((files_recursively_in test-cases/force-test)))
|
||||||
|
(action
|
||||||
|
(chdir test-cases/force-test
|
||||||
|
(setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} run.t))))))
|
|
@ -0,0 +1,2 @@
|
||||||
|
|
||||||
|
let () = print_endline "Foo Bar"
|
|
@ -0,0 +1,9 @@
|
||||||
|
(jbuild_version 1)
|
||||||
|
|
||||||
|
(executable
|
||||||
|
((name f)))
|
||||||
|
|
||||||
|
(alias
|
||||||
|
((name runtest)
|
||||||
|
(deps (f.exe))
|
||||||
|
(action (run ${<}))))
|
|
@ -0,0 +1,12 @@
|
||||||
|
$ $JBUILDER clean -j1 --root .
|
||||||
|
$ $JBUILDER runtest -j1 --root .
|
||||||
|
ocamldep f.depends.ocamldep-output
|
||||||
|
ocamlc f.{cmi,cmo,cmt}
|
||||||
|
ocamlopt f.{cmx,o}
|
||||||
|
ocamlopt f.exe
|
||||||
|
f alias runtest
|
||||||
|
Foo Bar
|
||||||
|
$ $JBUILDER runtest -j1 --root .
|
||||||
|
$ $JBUILDER runtest --force -j1 --root .
|
||||||
|
f alias runtest
|
||||||
|
Foo Bar
|
Loading…
Reference in New Issue