From 0ca3195d78065acc3d350fe0b4f23ec43b495335 Mon Sep 17 00:00:00 2001
From: Damian Rouson <rouson@lbl.gov>
Date: Mon, 25 Dec 2023 22:38:37 -0500
Subject: [PATCH] fix(test_result):pass only if all images pass test

---
 src/sourcery/sourcery_test_result_m.f90 |  4 ++--
 src/sourcery/sourcery_test_result_s.f90 |  2 ++
 test/test_result_test.f90               | 16 +++++++++++++++-
 3 files changed, 19 insertions(+), 3 deletions(-)

diff --git a/src/sourcery/sourcery_test_result_m.f90 b/src/sourcery/sourcery_test_result_m.f90
index 093b4348..048a8f7f 100644
--- a/src/sourcery/sourcery_test_result_m.f90
+++ b/src/sourcery/sourcery_test_result_m.f90
@@ -36,8 +36,8 @@ pure module function characterize(self) result(characterization)
       character(len=:), allocatable :: characterization
     end function
 
-    elemental module function passed(self) result(test_passed)
-      !! The result is a character description of the test and its outcome
+    impure elemental module function passed(self) result(test_passed)
+      !! The result is true if and only if the test passed on all images
       implicit none
       class(test_result_t), intent(in) :: self
       logical test_passed
diff --git a/src/sourcery/sourcery_test_result_s.f90 b/src/sourcery/sourcery_test_result_s.f90
index 170fe23b..6a30a079 100644
--- a/src/sourcery/sourcery_test_result_s.f90
+++ b/src/sourcery/sourcery_test_result_s.f90
@@ -1,4 +1,5 @@
 submodule(sourcery_test_result_m) sourcery_test_result_s
+  use sourcery_user_defined_collectives_m, only : co_all
   implicit none
 
 contains
@@ -14,6 +15,7 @@
 
     module procedure passed
       test_passed = self%passed_
+      call co_all(test_passed)
     end procedure
 
 end submodule sourcery_test_result_s
diff --git a/test/test_result_test.f90 b/test/test_result_test.f90
index 4df02a7c..302a84f1 100644
--- a/test/test_result_test.f90
+++ b/test/test_result_test.f90
@@ -23,7 +23,8 @@ function results() result(test_results)
     type(test_result_t), allocatable :: test_results(:)
 
     test_results = [ &
-      test_result_t("constructs and array of test_result_t objects elementally", check_array_result_construction()) &
+      test_result_t("constructing an array of test_result_t objects elementally", check_array_result_construction()), &
+      test_result_t("reporting failure if the test fails on one image", check_single_image_failure()) &
     ]
   end function
 
@@ -36,4 +37,17 @@ pure function check_array_result_construction() result(passed)
     passed = size(test_results)==2
   end function
 
+  function check_single_image_failure() result(passed)
+    type(test_result_t), allocatable :: test_result
+    logical passed
+
+    if (this_image()==1) then
+      test_result = test_result_t("image 1 fails", .false.)
+    else
+      test_result = test_result_t("all images other than 1 pass", .true.)
+    end if
+
+    passed = .not. test_result%passed()
+  end function
+
 end module test_result_test_m