From 785beeafac87b998d5358371bb29e8131eaeb4b1 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 28 Nov 2017 19:03:22 +0800 Subject: [PATCH] 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. --- bin/main.ml | 9 ++++++--- src/alias.ml | 12 ++++++++++++ src/alias.mli | 2 ++ src/gen_rules.ml | 3 ++- src/gen_rules.mli | 1 + src/import.ml | 7 +++++++ src/main.ml | 4 +++- src/main.mli | 1 + test/blackbox-tests/jbuild | 7 +++++++ test/blackbox-tests/test-cases/force-test/f.ml | 2 ++ test/blackbox-tests/test-cases/force-test/jbuild | 9 +++++++++ test/blackbox-tests/test-cases/force-test/run.t | 12 ++++++++++++ 12 files changed, 64 insertions(+), 5 deletions(-) create mode 100644 test/blackbox-tests/test-cases/force-test/f.ml create mode 100644 test/blackbox-tests/test-cases/force-test/jbuild create mode 100644 test/blackbox-tests/test-cases/force-test/run.t diff --git a/bin/main.ml b/bin/main.ml index 153fe74f..37aa8872 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -62,9 +62,10 @@ let execve = module Main = struct 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 ~log + ?unlink_aliases ?workspace_file:common.workspace_file ?only_packages:common.only_packages ?filter_out_optional_stanzas_with_missing_deps () @@ -468,7 +469,8 @@ let runtest = ] 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 ~targets:(List.map dirs ~f:(function | "" | "." -> "@runtest" @@ -476,7 +478,7 @@ let runtest = | dir -> sprintf "@%s/runtest" dir)); let log = Log.create () in Future.Scheduler.go ~log - (Main.setup ~log common >>= fun setup -> + (Main.setup ?unlink_aliases ~log common >>= fun setup -> let targets = List.map dirs ~f:(fun dir -> let dir = Path.(relative root) (prefix_target common dir) in @@ -485,6 +487,7 @@ let runtest = do_build setup targets) in ( Term.(const go $ common + $ Arg.(value & flag & info ["force"; "f"]) $ Arg.(value & pos_all string ["."] name_)) , Term.info "runtest" ~doc ~man) diff --git a/src/alias.ml b/src/alias.ml index c391aedd..0f4f6d41 100644 --- a/src/alias.ml +++ b/src/alias.ml @@ -138,6 +138,18 @@ module Store = struct Format.fprintf fmt "Store.t@ @[@<2>(%a)@]" pp_bindings bindings 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 let add_deps store t deps = diff --git a/src/alias.mli b/src/alias.mli index 2b0e39de..134cbea1 100644 --- a/src/alias.mli +++ b/src/alias.mli @@ -62,6 +62,8 @@ module Store : sig val pp : t Fmt.t val create : unit -> t + + val unlink : t -> string list -> unit end val add_deps : Store.t -> t -> Path.t list -> unit diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 9f65a57e..a83e547e 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -1104,7 +1104,7 @@ Add it to your jbuild file to remove this warning. end let gen ~contexts ?(filter_out_optional_stanzas_with_missing_deps=true) - ?only_packages conf = + ?only_packages ?(unlink_aliases=[]) conf = let open Future in let { Jbuild_load. file_tree; jbuilds; packages } = conf in let aliases = Alias.Store.create () in @@ -1152,5 +1152,6 @@ let gen ~contexts ?(filter_out_optional_stanzas_with_missing_deps=true) |> Future.all >>| fun l -> let rules, context_names_and_stanzas = List.split l in + Alias.Store.unlink aliases unlink_aliases; (Alias.rules aliases @ List.concat rules, String_map.of_alist_exn context_names_and_stanzas) diff --git a/src/gen_rules.mli b/src/gen_rules.mli index 91732799..5a8fd414 100644 --- a/src/gen_rules.mli +++ b/src/gen_rules.mli @@ -5,6 +5,7 @@ val gen : contexts:Context.t list -> ?filter_out_optional_stanzas_with_missing_deps:bool (* default: true *) -> ?only_packages:String_set.t + -> ?unlink_aliases:string list -> Jbuild_load.conf -> (Build_interpret.Rule.t list * (* Evaluated jbuilds per context names *) diff --git a/src/import.ml b/src/import.ml index 40059e43..0308ad37 100644 --- a/src/import.ml +++ b/src/import.ml @@ -553,4 +553,11 @@ end module Fmt = struct 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 diff --git a/src/main.ml b/src/main.ml index 6329704c..29fd3855 100644 --- a/src/main.ml +++ b/src/main.ml @@ -14,7 +14,8 @@ let package_install_file { packages; _ } pkg = | None -> Error () | 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") ?(use_findlib=true) ?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 -> Log.infof log "@[<1>Jbuilder context:@,%a@]@." Sexp.pp (Context.sexp_of_t ctx)); Gen_rules.gen conf ~contexts + ?unlink_aliases ?only_packages ?filter_out_optional_stanzas_with_missing_deps >>= fun (rules, stanzas) -> diff --git a/src/main.mli b/src/main.mli index 70ecf048..16821729 100644 --- a/src/main.mli +++ b/src/main.mli @@ -17,6 +17,7 @@ val package_install_file : setup -> string -> (Path.t, unit) result it. *) val setup : ?log:Log.t + -> ?unlink_aliases:string list -> ?filter_out_optional_stanzas_with_missing_deps:bool -> ?workspace:Workspace.t -> ?workspace_file:string diff --git a/test/blackbox-tests/jbuild b/test/blackbox-tests/jbuild index 7c5def1e..d1daa526 100644 --- a/test/blackbox-tests/jbuild +++ b/test/blackbox-tests/jbuild @@ -78,3 +78,10 @@ (action (chdir test-cases/aliases (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)))))) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/force-test/f.ml b/test/blackbox-tests/test-cases/force-test/f.ml new file mode 100644 index 00000000..f64082cf --- /dev/null +++ b/test/blackbox-tests/test-cases/force-test/f.ml @@ -0,0 +1,2 @@ + +let () = print_endline "Foo Bar" diff --git a/test/blackbox-tests/test-cases/force-test/jbuild b/test/blackbox-tests/test-cases/force-test/jbuild new file mode 100644 index 00000000..2e6c139b --- /dev/null +++ b/test/blackbox-tests/test-cases/force-test/jbuild @@ -0,0 +1,9 @@ +(jbuild_version 1) + +(executable + ((name f))) + +(alias + ((name runtest) + (deps (f.exe)) + (action (run ${<})))) diff --git a/test/blackbox-tests/test-cases/force-test/run.t b/test/blackbox-tests/test-cases/force-test/run.t new file mode 100644 index 00000000..f215f836 --- /dev/null +++ b/test/blackbox-tests/test-cases/force-test/run.t @@ -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