Implement keep-going (-k) option.

diff --git a/docs/goals.pod b/docs/goals.pod
index cf67a45..ffea303 100644 (file)
--- a/docs/goals.pod
+++ b/docs/goals.pod
@@ -9,7 +9,7 @@ goals - an experimental tool that generalizes “make”
  goals ['TARGET'] ['VAR=VALUE']
        [-C|--directory DIRECTORY] [-d] [-f|--file Goalfile]
        [-I|--include DIRECTORY] [-j|--jobs JOBS] [--no-prelude]
  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
 
 
  goals --help
 


@@ -90,6 +90,15 @@ prelude is always loaded automatically before any initial goal file
 (but you can redefine prelude definitions in your goal file if you
 want).
 
 (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>
 =item B<-s>
 
 =item B<--silent>

diff --git a/src/cmdline.ml b/src/cmdline.ml
index 927dfdf..86e9dbf 100644 (file)
--- a/src/cmdline.ml
+++ b/src/cmdline.ml
@@ -53,6 +53,7 @@ let input_file = ref "Goalfile"
 let includes = ref [stdlibdir]
 let add_include dir = includes := dir :: !includes
 let nr_jobs = ref (nprocs ())
 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
 
 let silent = ref false
 let use_prelude = ref true
 


@@ -84,6 +85,10 @@ let parse () =
                    jobshelp;
     "--no-prelude",Arg.Clear use_prelude,
                    " Do not automatically use prelude.gl from stdlib";
                    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,
     "-s",          Arg.Set silent,
                    " Silent operation";
     "--silent",    Arg.Set silent,


@@ -136,5 +141,6 @@ let input_file () = !input_file
 let includes () = !includes
 
 let nr_jobs () = !nr_jobs
 let includes () = !includes
 
 let nr_jobs () = !nr_jobs

+let keep_going () = !keep_going

 let silent () = !silent
 let use_prelude () = !use_prelude
 let silent () = !silent
 let use_prelude () = !use_prelude

diff --git a/src/cmdline.mli b/src/cmdline.mli
index 9bc8ff9..5080993 100644 (file)
--- a/src/cmdline.mli
+++ b/src/cmdline.mli
@@ -51,6 +51,9 @@ val includes : unit -> string list
 val nr_jobs : unit -> int
 (** Number of jobs (-j option). *)
 
 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). *)
 
 val silent : unit -> bool
 (** Silent operation (-s option). *)
 

diff --git a/src/deps.ml b/src/deps.ml
index 6656e87..8acf658 100644 (file)
--- a/src/deps.ml
+++ b/src/deps.ml
@@ -481,10 +481,14 @@ type state = {
    * access we store a map node -> true.
    *)
   mutable complete : bool G.t;
    * 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 =
 }
 
 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.
 
 (* Called by [Jobs] when a node completes successfully.  We mark
  * it as done.


@@ -492,6 +496,13 @@ let new_state (dag, sorted_nodes) goal_runner exists_runner =
 let retire_job state node =
   state.complete <- G.add node true state.complete
 
 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 next_job state =
   (* Find the earliest node in the list which has all its
    * dependencies done.


@@ -499,25 +510,41 @@ let rec next_job state =
   let rec loop acc = function
     | [] ->
        if state.sorted_nodes = [] then Jobs.Complete else Jobs.Not_ready
   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
 
   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
 
 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
 let string_of_job  = string_of_node

diff --git a/src/deps.mli b/src/deps.mli
index 7cdcdab..759447e 100644 (file)
--- a/src/deps.mli
+++ b/src/deps.mli
@@ -46,6 +46,7 @@ val new_state : t -> goal_runner -> exists_runner -> state
 type node
 
 val retire_job : state -> node -> unit
 type node
 
 val retire_job : state -> node -> unit

+val fail_job : state -> node -> unit

 (** See {!Jobs.run}. *)
 
 val next_job : state -> node Jobs.next
 (** See {!Jobs.run}. *)
 
 val next_job : state -> node Jobs.next

diff --git a/src/jobs.ml b/src/jobs.ml
index f5aefa9..0a698ef 100644 (file)
--- a/src/jobs.ml
+++ b/src/jobs.ml
@@ -21,7 +21,7 @@ open Utils
 
 type 'a next = Job of 'a * (unit -> unit) | Complete | Not_ready
 
 
 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
 
   (* Number of running threads <= Cmdline.nr_jobs. *)
   let running = ref 0 in
 


@@ -38,7 +38,9 @@ let run next_job retire_job string_of_job =
     Mutex.lock lock;
     (match exn with
      | None -> retire_job job
     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;
     );
     decr running;
     Condition.signal cond;


@@ -46,7 +48,8 @@ let run next_job retire_job string_of_job =
   in
 
   let rec loop () =
   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 ->
       match next_job () with
       | Complete -> ()
       | Not_ready ->

diff --git a/src/jobs.mli b/src/jobs.mli
index a5b79bb..9be4186 100644 (file)
--- a/src/jobs.mli
+++ b/src/jobs.mli
@@ -21,18 +21,22 @@
 
 type 'a next = Job of 'a * (unit -> unit) | 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.
 
     [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
     [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 [next_job] returns [Not_ready] then [next_job] will be
     called again after a little while.


@@ -40,4 +44,5 @@ val run : (unit -> 'a next) -> ('a -> unit) -> ('a -> string) -> unit
     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
     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. *)

diff --git a/src/main.ml b/src/main.ml
index ba4a195..cee1dcf 100644 (file)
--- a/src/main.ml
+++ b/src/main.ml
@@ -84,8 +84,9 @@ let main () =
   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 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
   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 ()
 
 let () =
   try main ()

diff --git a/tests/20-option-keep-going.gl b/tests/20-option-keep-going.gl
new file mode 100644 (file)
index 0000000..ef1c4c7
--- /dev/null
+++ b/tests/20-option-keep-going.gl
@@ -0,0 +1,59 @@
+# 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 }

diff --git a/tests/20-option-keep-going.sh b/tests/20-option-keep-going.sh
new file mode 100755 (executable)
index 0000000..f684368
--- /dev/null
+++ b/tests/20-option-keep-going.sh
@@ -0,0 +1,50 @@
+#!/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