Handle failure mid block.

specs/build-test.md

@@ -16,7 +16,7 @@ We can then do the build and copy the result to a shark friendly location:
 
 ```shark-run:golang
 $ cd /data/littlejohn
-$ mkdir /data/build/
+$ mkdir -p /data/build/
 $ GOPATH=/data/build go install
 $ ls -laR /data/build
 ```

specs/synthetic/fail_1.md

@@ -0,0 +1,13 @@
+# Simple multistage test case 2
+
+Use alpline as a minimal image
+
+```shark-build:image
+((from ghcr.io/osgeo/gdal:ubuntu-small-3.8.5))
+```
+
+Now run multiple commands in one block:
+
+```shark-run:image
+false
+```

specs/synthetic/fail_2.md

@@ -0,0 +1,15 @@
+# Simple multistage test case 2
+
+Use alpline as a minimal image
+
+```shark-build:image
+((from ghcr.io/osgeo/gdal:ubuntu-small-3.8.5))
+```
+
+Now run multiple commands in one block:
+
+```shark-run:image
+true
+false
+true
+```

specs/synthetic/fail_3.md

@@ -0,0 +1,17 @@
+# Simple multistage test case 2
+
+Use alpline as a minimal image
+
+```shark-build:image
+((from ghcr.io/osgeo/gdal:ubuntu-small-3.8.5))
+```
+
+Now run multiple commands in one block:
+
+```shark-run:image
+false
+```
+
+```shark-run:image
+true
+```

specs/synthetic/succeed_1.md

@@ -0,0 +1,13 @@
+# Simple multistage test case 1
+
+Use alpline as a minimal image
+
+```shark-build:image
+((from ghcr.io/osgeo/gdal:ubuntu-small-3.8.5))
+```
+
+Now run multiple commands in one block:
+
+```shark-run:image
+/bin/true
+```

specs/synthetic/succeed_2.md

@@ -0,0 +1,17 @@
+# Simple multistage test case 2
+
+Use alpline as a minimal image
+
+```shark-build:image
+((from ghcr.io/osgeo/gdal:ubuntu-small-3.8.5))
+```
+
+Now run multiple commands in one block:
+
+```shark-run:image
+true
+```
+
+```shark-run:image
+true
+```

src/lib/md.ml

@@ -223,77 +223,80 @@ let process_run_block ?(environment_override = []) ~fs ~build_cache ~pool store
       in
 
       let process_single_command acc command_leaf =
-        let _, previous_state = acc in
-        let inputs = Leaf.inputs command_leaf in
-        let input_and_hashes =
-          List.map
-            (fun i -> (i, List.assoc_opt (Datafile.id i) input_map))
-              (* match List.assoc_opt (Datafile.id i) input_map with
-                 | None -> Some (i, (Run_block.ExecutionState.build_hash prev_state))
-                 | Some hash -> Some (i, hash)) *)
-            inputs
-        in
-        let hash_to_input_map =
-          List.fold_left
-            (fun a (df, hash) ->
-              match List.assoc_opt hash a with
-              | None -> (hash, ref [ df ]) :: a
-              | Some l ->
-                  l := df :: !l;
-                  a)
-            [] input_and_hashes
-        in
-        let paths =
-          List.map
-            (fun (hash_opt, ref_fd_list) ->
-              match hash_opt with
-              | Some hash -> get_paths ~fs store hash true !ref_fd_list
-              | None ->
-                  let current_hash =
-                    Run_block.ExecutionState.build_hash previous_state
+        let previous_results, previous_state = acc in
+        match Run_block.ExecutionState.success previous_state with
+        | false -> acc
+        | true ->
+            let inputs = Leaf.inputs command_leaf in
+            let input_and_hashes =
+              List.map
+                (fun i -> (i, List.assoc_opt (Datafile.id i) input_map))
+                  (* match List.assoc_opt (Datafile.id i) input_map with
+                     | None -> Some (i, (Run_block.ExecutionState.build_hash prev_state))
+                     | Some hash -> Some (i, hash)) *)
+                inputs
+            in
+            let hash_to_input_map =
+              List.fold_left
+                (fun a (df, hash) ->
+                  match List.assoc_opt hash a with
+                  | None -> (hash, ref [ df ]) :: a
+                  | Some l ->
+                      l := df :: !l;
+                      a)
+                [] input_and_hashes
+            in
+            let paths =
+              List.map
+                (fun (hash_opt, ref_fd_list) ->
+                  match hash_opt with
+                  | Some hash -> get_paths ~fs store hash true !ref_fd_list
+                  | None ->
+                      let current_hash =
+                        Run_block.ExecutionState.build_hash previous_state
+                      in
+                      get_paths ~fs store current_hash false !ref_fd_list)
+                hash_to_input_map
+            in
+            let l =
+              List.fold_left
+                (fun a v ->
+                  let s =
+                    List.map
+                      (fun (arg_path, targets) ->
+                        ( Fpath.to_string (Datafile.fullpath arg_path),
+                          List.map Fpath.to_string targets ))
+                      v
                   in
-                  get_paths ~fs store current_hash false !ref_fd_list)
-            hash_to_input_map
-        in
-        let l =
-          List.fold_left
-            (fun a v ->
-              let s =
-                List.map
-                  (fun (arg_path, targets) ->
-                    ( Fpath.to_string (Datafile.fullpath arg_path),
-                      List.map Fpath.to_string targets ))
-                  v
-              in
-              s @ a)
-            [] paths
-        in
-        (* Sanity check whether we found the matching inputs *)
-        List.iter
-          (fun (i, s) ->
-            match s with
-            | [] ->
-                Fmt.failwith "Failed to find source files for input %s of %s" i
-                  (Command.name (Leaf.command command_leaf))
-            | _ -> ())
-          l;
-        let inputs = Leaf.to_string_for_inputs command_leaf l in
-        let processed_blocks =
-          Fiber.List.map
-            (Run_block.process_single_command_execution ~previous_state
-               ~environment_override ~command_leaf ~file_subs_map:l
-               ~run_f:obuilder_command_runner)
-            inputs
-        in
-        let results, _es = acc in
-        let es =
-          match processed_blocks with
-          | hd :: _ -> hd
-          | [] ->
-              Fmt.failwith "There were no processed blocks for %s"
-                (Command.name (Leaf.command command_leaf))
-        in
-        (processed_blocks :: results, es)
+                  s @ a)
+                [] paths
+            in
+            (* Sanity check whether we found the matching inputs *)
+            List.iter
+              (fun (i, s) ->
+                match s with
+                | [] ->
+                    Fmt.failwith
+                      "Failed to find source files for input %s of %s" i
+                      (Command.name (Leaf.command command_leaf))
+                | _ -> ())
+              l;
+            let inputs = Leaf.to_string_for_inputs command_leaf l in
+            let processed_blocks =
+              Fiber.List.map
+                (Run_block.process_single_command_execution ~previous_state
+                   ~environment_override ~command_leaf ~file_subs_map:l
+                   ~run_f:obuilder_command_runner)
+                inputs
+            in
+            let es =
+              match processed_blocks with
+              | hd :: _ -> hd
+              | [] ->
+                  Fmt.failwith "There were no processed blocks for %s"
+                    (Command.name (Leaf.command command_leaf))
+            in
+            (processed_blocks :: previous_results, es)
       in
 
       let ids_and_output_and_cmd, _es =

src/lib/run_block.ml

@@ -42,12 +42,12 @@ module ExecutionState = struct
     { e with result; workdir = dst }
 
   let update_env e key value =
-    let res =
+    let result =
       CommandResult.v ~build_hash:e.build_hash
         (Fmt.str "export %s=%s" key value)
     in
     let updated_env = (key, value) :: List.remove_assoc key e.environment in
-    { e with result = res; environment = updated_env }
+    { e with result; environment = updated_env }
 
   let command_fail e result = { e with result; success = false }
   let result e = e.result

src/test/run_block.ml

@@ -133,6 +133,9 @@ let test_simple_command_execute () =
       ~environment_override:[] ~command_leaf ~file_subs_map:[] ~run_f:runner
       raw_command
   in
+  Alcotest.(check bool)
+    "Check success" true
+    (Shark.Run_block.ExecutionState.success updated);
   Alcotest.(check string)
     "Check id" "otherid"
     (Shark.Run_block.ExecutionState.build_hash updated);
@@ -144,6 +147,43 @@ let test_simple_command_execute () =
     (Shark.Run_block.ExecutionState.env updated);
   Alcotest.(check bool) "check runner was called" true !runner_called
 
+let test_simple_failed_command_execute () =
+  let raw_command = "mycommand.exe" in
+  let command = Shark.Command.of_string raw_command in
+  let command_leaf =
+    Shark.Leaf.v 42 (Option.get command) Shark.Leaf.Command [] []
+  in
+
+  let es =
+    Shark.Run_block.ExecutionState.init ~build_hash:"id" ~workdir:"/some/path"
+      ~environment:[]
+  in
+
+  let runner_called = ref false in
+  let runner _es _l _s _b =
+    runner_called := true;
+    Error (None, "error")
+  in
+
+  let updated =
+    Shark.Run_block.process_single_command_execution ~previous_state:es
+      ~environment_override:[] ~command_leaf ~file_subs_map:[] ~run_f:runner
+      raw_command
+  in
+  Alcotest.(check bool)
+    "Check success" false
+    (Shark.Run_block.ExecutionState.success updated);
+  Alcotest.(check string)
+    "Check id" "id"
+    (Shark.Run_block.ExecutionState.build_hash updated);
+  Alcotest.(check string)
+    "Check path" "/some/path"
+    (Shark.Run_block.ExecutionState.workdir updated);
+  Alcotest.(check (list (pair string string)))
+    "Check env" []
+    (Shark.Run_block.ExecutionState.env updated);
+  Alcotest.(check bool) "check runner was called" true !runner_called
+
 let tests =
   [
     ("Test create initial state", `Quick, test_initial_block);
@@ -153,4 +193,7 @@ let tests =
       `Quick,
       test_override_env_udpate );
     ("Test a simple command execution", `Quick, test_simple_command_execute);
+    ( "Test a failed command execution",
+      `Quick,
+      test_simple_failed_command_execute );
   ]