goals ['TARGET'] ['VAR=VALUE']
[-C|--directory DIRECTORY] [-d] [-f|--file Goalfile]
[-I|--include DIRECTORY] [-j|--jobs JOBS] [--no-prelude]
- [-s|--silent|--quiet]
+ [-k|--keep-going] [-s|--silent|--quiet]
goals --help
(but you can redefine prelude definitions in your goal file if you
want).
+=item B<-k>
+
+=item B<--keep-going>
+
+Continue as much as possible after an error. The target that failed
+and anything that depends on that target (recursively) will fail and
+the program as a whole will still exit with an error, but as many
+targets as can be built will be built.
+
=item B<-s>
=item B<--silent>
let includes = ref [stdlibdir]
let add_include dir = includes := dir :: !includes
let nr_jobs = ref (nprocs ())
+let keep_going = ref false
let silent = ref false
let use_prelude = ref true
jobshelp;
"--no-prelude",Arg.Clear use_prelude,
" Do not automatically use prelude.gl from stdlib";
+ "-k", Arg.Set keep_going,
+ " Keep going after an error";
+ "--keep-going",Arg.Set keep_going,
+ " Keep going after an error";
"-s", Arg.Set silent,
" Silent operation";
"--silent", Arg.Set silent,
let includes () = !includes
let nr_jobs () = !nr_jobs
+let keep_going () = !keep_going
let silent () = !silent
let use_prelude () = !use_prelude
val nr_jobs : unit -> int
(** Number of jobs (-j option). *)
+val keep_going : unit -> bool
+(** Keep-going mode (-k option). *)
+
val silent : unit -> bool
(** Silent operation (-s option). *)
* access we store a map node -> true.
*)
mutable complete : bool G.t;
+
+ (* List of nodes which failed. *)
+ mutable failed : bool G.t;
}
let new_state (dag, sorted_nodes) goal_runner exists_runner =
- { dag; goal_runner; exists_runner; sorted_nodes; complete = G.empty }
+ { dag; goal_runner; exists_runner; sorted_nodes;
+ complete = G.empty; failed = G.empty }
(* Called by [Jobs] when a node completes successfully. We mark
* it as done.
let retire_job state node =
state.complete <- G.add node true state.complete
+(* Called by [Jobs] when a node fails. We mark the node as
+ * failed and ensure that anything that depends on it will
+ * also be marked as failed (and never returned by next_job).
+ *)
+let fail_job state node =
+ state.failed <- G.add node true state.failed
+
let rec next_job state =
(* Find the earliest node in the list which has all its
* dependencies done.
let rec loop acc = function
| [] ->
if state.sorted_nodes = [] then Jobs.Complete else Jobs.Not_ready
- | node :: nodes ->
- if node_is_ready_to_run state node then (
- state.sorted_nodes <- List.rev acc @ nodes;
- match node with
- | Goal (env, loc, name, args, goal, extra_deps, debug_goal) ->
- Jobs.Job (node, fun () ->
- state.goal_runner env loc name args goal
- extra_deps debug_goal)
- | Exists (env, loc, p, debug_tactic) ->
- Jobs.Job (node, fun () ->
- state.exists_runner env loc p debug_tactic)
+ | node :: nodes when node_is_ready_to_run state node ->
+ (* Drop the node from the list of jobs and run it. *)
+ state.sorted_nodes <- List.rev acc @ nodes;
+ (match node with
+ | Goal (env, loc, name, args, goal, extra_deps, debug_goal) ->
+ Jobs.Job (node, fun () ->
+ state.goal_runner env loc name args goal
+ extra_deps debug_goal)
+ | Exists (env, loc, p, debug_tactic) ->
+ Jobs.Job (node, fun () ->
+ state.exists_runner env loc p debug_tactic)
)
- else
- loop (node :: acc) nodes
+ | node :: nodes when node_failed state node ->
+ (* Mark it as failed also, and drop it from the list of jobs. *)
+ fail_job state node;
+ state.sorted_nodes <- List.rev acc @ nodes;
+ loop acc nodes
+ | node :: nodes ->
+ (* All dependencies of this node are neither complete nor failed,
+ * continue down the list.
+ *)
+ loop (node :: acc) nodes
in
loop [] state.sorted_nodes
+(* All dependencies of this node are complete. *)
and node_is_ready_to_run { dag; complete } node =
let parents = try G.find node dag.edges with Not_found -> [] in
List.for_all (fun p -> G.mem p complete) parents
+(* This node or any dependency of this node failed. *)
+and node_failed { dag; failed } node =
+ G.mem node failed || (
+ let parents = try G.find node dag.edges with Not_found -> [] in
+ List.exists (fun p -> G.mem p failed) parents
+ )
+
let string_of_job = string_of_node
type node
val retire_job : state -> node -> unit
+val fail_job : state -> node -> unit
(** See {!Jobs.run}. *)
val next_job : state -> node Jobs.next
type 'a next = Job of 'a * (unit -> unit) | Complete | Not_ready
-let run next_job retire_job string_of_job =
+let run next_job retire_job fail_job string_of_job =
(* Number of running threads <= Cmdline.nr_jobs. *)
let running = ref 0 in
Mutex.lock lock;
(match exn with
| None -> retire_job job
- | Some exn -> last_exn := exn :: !last_exn
+ | Some exn ->
+ last_exn := exn :: !last_exn;
+ fail_job job
);
decr running;
Condition.signal cond;
in
let rec loop () =
- if !last_exn = [] then (
+ let continue = !last_exn = [] || Cmdline.keep_going () in
+ if continue then (
match next_job () with
| Complete -> ()
| Not_ready ->
type 'a next = Job of 'a * (unit -> unit) | Complete | Not_ready
-val run : (unit -> 'a next) -> ('a -> unit) -> ('a -> string) -> unit
-(** [run next_job retire_job to_string] runs jobs in parallel.
+val run : (unit -> 'a next) -> ('a -> unit) -> ('a -> unit) ->
+ ('a -> string) -> unit
+(** [run next_job retire_job fail_job to_string] runs jobs in parallel.
[next_job] is called to pick the next available job.
[retire_job] is called when a job finishes successfully.
+ [fail_job] is called when a job fails (only in keep-going
+ -k mode). All jobs that depend on this one must be marked
+ failed by the caller.
[to_string] is called if we need to print the job name.
If [next_job] returns [Job f] then that function is started
(usually in a thread if -j N > 1).
If [next_job] returns [Complete] then [run] waits until
- all parallel jobs are then returns.
+ all parallel jobs are finished then returns.
If [next_job] returns [Not_ready] then [next_job] will be
called again after a little while.
If any job throws an exception then the exception will be
reraised by [run], usually causing goals to exit with an error.
The exception is delayed until all currently running jobs
- finish, but no new jobs will be started during this time. *)
+ finish. In normal mode no new jobs will be started during
+ this time. In keep-going -k mode new jobs may be started. *)
let state = Deps.new_state dag Run.goal_runner Run.exists_runner in
let next_job () = Deps.next_job state in
let retire_job job = Deps.retire_job state job in
+ let fail_job job = Deps.fail_job state job in
let string_of_job job = Deps.string_of_job job in
- Jobs.run next_job retire_job string_of_job
+ Jobs.run next_job retire_job fail_job string_of_job
let () =
try main ()
--- /dev/null
+# Goals test.
+# Copyright (C) 2020 Richard W.M. Jones
+# Copyright (C) 2020 Red Hat Inc.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with this program; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+# This tests the behaviour of the keep-going (-k) option. This
+# should build as many targets as possible. The tree of goals
+# looks like this:
+#
+# fail3
+# /
+# fail1 good3 good6
+# / / /
+# all --- good1 --- good2 --- fail2
+# \ \
+# good4 --- good5 good7 -- good8..20
+#
+# The following goals should run:
+# fail2, fail3, good3, good4, good5, good6, good7, good8..20
+# The following goals should NOT run:
+# all, fail1, good1, good2
+
+goal all = : fail1, good1, good4 { echo ALL }
+goal fail1 = : fail3 { echo FAIL1; exit 1 }
+goal fail2 = : good6, good7 { echo FAIL2; exit 1 }
+goal fail3 = { echo FAIL3; exit 1 }
+goal good1 = : good2 { echo GOOD1 }
+goal good2 = : good3, fail2 { echo GOOD2 }
+goal good3 = { echo GOOD3 }
+goal good4 = : good5 { echo GOOD4 }
+goal good5 = { echo GOOD5 }
+goal good6 = { echo GOOD6 }
+goal good7 = : good8 { echo GOOD7 }
+goal good8 = : good9 { echo GOOD8 }
+goal good9 = : good10 { echo GOOD9 }
+goal good10 = : good11 { echo GOOD10 }
+goal good11 = : good12 { echo GOOD11 }
+goal good12 = : good13 { echo GOOD12 }
+goal good13 = : good14 { echo GOOD13 }
+goal good14 = : good15 { echo GOOD14 }
+goal good15 = : good16 { echo GOOD15 }
+goal good16 = : good17 { echo GOOD16 }
+goal good17 = : good18 { echo GOOD17 }
+goal good18 = : good19 { echo GOOD18 }
+goal good19 = : good20 { echo GOOD19 }
+goal good20 = { echo GOOD20 }
--- /dev/null
+#!/usr/bin/env bash
+# Goals test.
+# Copyright (C) 2020 Richard W.M. Jones
+# Copyright (C) 2020 Red Hat Inc.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with this program; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+set -e
+
+if goals -k -f 20-option-keep-going.gl > 20-option-keep-going.out 2>&1; then
+ echo "$0: expected goals to exit with an error"
+ exit 1
+fi
+fgrep FAIL2 20-option-keep-going.out
+fgrep FAIL3 20-option-keep-going.out
+fgrep GOOD3 20-option-keep-going.out
+fgrep GOOD4 20-option-keep-going.out
+fgrep GOOD5 20-option-keep-going.out
+fgrep GOOD6 20-option-keep-going.out
+fgrep GOOD7 20-option-keep-going.out
+fgrep GOOD8 20-option-keep-going.out
+fgrep GOOD9 20-option-keep-going.out
+fgrep GOOD10 20-option-keep-going.out
+fgrep GOOD11 20-option-keep-going.out
+fgrep GOOD12 20-option-keep-going.out
+fgrep GOOD13 20-option-keep-going.out
+fgrep GOOD14 20-option-keep-going.out
+fgrep GOOD15 20-option-keep-going.out
+fgrep GOOD16 20-option-keep-going.out
+fgrep GOOD17 20-option-keep-going.out
+fgrep GOOD18 20-option-keep-going.out
+fgrep GOOD19 20-option-keep-going.out
+fgrep GOOD20 20-option-keep-going.out
+! fgrep ALL 20-option-keep-going.out
+! fgrep FAIL1 20-option-keep-going.out
+! fgrep GOOD1 20-option-keep-going.out
+! fgrep GOOD2 20-option-keep-going.out
+rm 20-option-keep-going.out
git.annexia.org / goals.git / commitdiff