Merge pull request #42 from sourceryinstitute/image-1-reports

Image 1 reports test results + elemental co_all

Author: rouson

LICENSE

@@ -1,6 +1,6 @@
 BSD 3-Clause License
 
-Copyright (c) 2020, Sourcery Institute
+Copyright (c) 2020-2023, Sourcery Institute
 All rights reserved.
 
 Redistribution and use in source and binary forms, with or without

fpm.toml

@@ -1,9 +1,9 @@
 name = "sourcery"
-version = "3.7.0"
+version = "3.8.0"
 license = "BSD"
 author = ["Damian Rouson"]
 maintainer = "[email protected]"
-copyright = "2020-2022 Sourcery Institute"
+copyright = "2020-2023 Sourcery Institute"
 
 [dependencies]
 assert = {git = "https://github.com/sourceryinstitute/assert", tag = "1.4.0"}

src/sourcery/test_s.f90

@@ -1,22 +1,31 @@
 submodule(test_m) test_s
+  use user_defined_collectives_m, only : co_all
   implicit none
 
 contains
 
   module procedure report
     integer i
 
-    print *
-    print *, test%subject()
-    associate(test_results => test%results())
-      associate(num_tests => size(test_results))
-        tests = tests + num_tests
-        do i=1,num_tests
-          print *,"   ",test_results(i)%characterize()
-        end do
-        associate(num_passes => count(test_results%passed()))
-          print '(a,2(i0,a))'," ",num_passes," of ", num_tests," tests pass."
-          passes = passes + num_passes
+    associate(me => this_image())
+      if (me==1) print *, new_line('a'), test%subject()
+      associate(test_results => test%results())
+        associate(num_tests => size(test_results))
+          tests = tests + num_tests
+          if (me==1) then
+            do i=1,num_tests
+              if (me==1) print *,"   ",test_results(i)%characterize()
+            end do
+          end if
+          block 
+            logical, allocatable :: passing_tests(:)
+            passing_tests = test_results%passed()
+            call co_all(passing_tests)
+            associate(num_passes => count(passing_tests))
+              if (me==1) print '(a,2(i0,a))'," ",num_passes," of ", num_tests," tests pass."
+              passes = passes + num_passes
+            end associate
+          end block
         end associate
       end associate
     end associate

src/sourcery/user_defined_collectives_m.f90

@@ -12,7 +12,7 @@ module user_defined_collectives_m
 
   interface
 
-    module subroutine co_all(boolean)
+    impure elemental module subroutine co_all(boolean)
       !! If any image in a team calls this subroutine, then every image in the 
       !! the same team must call this subroutine.  This subroutine sets the
       !! "boolean" argument .true. if it is true in all participating images

test/main.f90

@@ -26,6 +26,6 @@ program main
   call command_line_test%report(passes, tests)
   call string_test%report(passes, tests)
 
-  print *
-  print *,"_________ In total, ",passes," of ",tests, " tests pass. _________"
+  if (this_image()==1) print *, new_line('a'), "_________ In total, ",passes," of ",tests, " tests pass. _________"
+  if (passes /= tests) error stop
 end program

test/test_result_test.f90

@@ -24,7 +24,7 @@ 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 elmentally", check_array_result_construction()) &
+      test_result_t("constructs and array of test_result_t objects elementally", check_array_result_construction()) &
     ]
   end function