Print all errors in get_convert_char_array.f90

    The previous version of this test error-terminated upon
    the first of 14 checks. The revised version prints all
    error messages before error-terminating if any were
    printed.

Author: Damian Rouson

src/tests/unit/send-get/get_convert_char_array.f90

@@ -4,7 +4,7 @@
 !!
 !! FOO = BAR [N]
 !!
-!! where 
+!! where
 !!
 !!  FOO                BAR                 images
 !! character(len=20) character(len=10)   N == me
@@ -41,6 +41,7 @@ program get_convert_char_array
   character(kind=1, len=5)                 :: str_k1_arr(1:4)
   character(kind=4, len=5), codimension[*] :: co_str_k4_arr(1:4)
   character(kind=4, len=5)                 :: str_k4_arr(1:4)
+  logical :: error_printed=.false.
 
   associate(me => this_image(), np => num_images())
     if (np < 2) error stop 'Can not run with less than 2 images.'
@@ -55,80 +56,103 @@ program get_convert_char_array
     if (me == 1) then
       str_k1_scal = co_str_k1_scal[1]
       print *, '#' // str_k1_scal // '#, len:', len(str_k1_scal)
-      if (co_str_k1_scal /= str_k1_scal // '          ') error stop 'get scalar kind=1 to kind=1 self failed.'
+      if (co_str_k1_scal /= str_k1_scal // '          ') call print_and_register( 'get scalar kind=1 to kind=1 self failed.')
 
       str_k4_scal = co_str_k4_scal[1]
       print *, 4_'#' // str_k4_scal // 4_'#, len:', len(str_k4_scal)
-      if (co_str_k4_scal /= str_k4_scal // 4_'          ') error stop 'get scalar kind=4 to kind=4 self failed.'
+      if (co_str_k4_scal /= str_k4_scal // 4_'          ') call print_and_register( 'get scalar kind=4 to kind=4 self failed.')
 
       str_k4_scal = co_str_k1_scal[1]
       print *, 4_'#' // str_k4_scal // 4_'#, len:', len(str_k4_scal)
-      if (co_str_k4_scal /= str_k4_scal // 4_'          ') error stop 'get scalar kind=1 to kind=4 self failed.'
+      if (co_str_k4_scal /= str_k4_scal // 4_'          ') call print_and_register( 'get scalar kind=1 to kind=4 self failed.')
 
       str_k1_scal = co_str_k4_scal[1]
       print *, '#' // str_k1_scal // '#, len:', len(str_k1_scal)
-      if (co_str_k1_scal /= str_k1_scal // '          ') error stop 'get scalar kind=4 to kind=1 self failed.'
+      if (co_str_k1_scal /= str_k1_scal // '          ') call print_and_register( 'get scalar kind=4 to kind=1 self failed.')
     end if
 
     ! Do the same for arrays but on image 2
     if (me == 2) then
       str_k1_arr(:) = co_str_k1_arr(:)[2]
       print *, '#' // str_k1_arr(:) // '#, len:', len(str_k1_arr(1))
-      if (any(str_k1_arr /= ['abc  ', 'EFG  ', 'klm  ', 'NOP  '])) error stop 'get array kind=1 to kind=1 self failed.'
-     
-      print *, str_k4_arr 
+      if (any(str_k1_arr /= ['abc  ', 'EFG  ', 'klm  ', 'NOP  '])) &
+        call print_and_register( 'get array kind=1 to kind=1 self failed.')
+
+      print *, str_k4_arr
       str_k4_arr(:) = co_str_k4_arr(:)[2]
       print *, 4_'#' // str_k4_arr(:) // 4_'#, len:', len(str_k4_arr(1))
-      if (any(str_k4_arr /= [4_'abc  ', 4_'EFG  ', 4_'klm  ', 4_'NOP  '])) error stop 'get array kind=4 to kind=4 self failed.'
+      if (any(str_k4_arr /= [4_'abc  ', 4_'EFG  ', 4_'klm  ', 4_'NOP  '])) &
+        call print_and_register( 'get array kind=4 to kind=4 self failed.')
 
       str_k4_arr(:) = co_str_k1_arr(:)[2]
       print *, 4_'#' // str_k4_arr(:) // 4_'#, len:', len(str_k4_arr(1))
-      if (any(str_k4_arr /= [ 4_'abc  ', 4_'EFG  ', 4_'klm  ', 4_'NOP  '])) error stop 'get array kind=1 to kind=4 self failed.'
+      if (any(str_k4_arr /= [ 4_'abc  ', 4_'EFG  ', 4_'klm  ', 4_'NOP  '])) &
+        call print_and_register( 'get array kind=1 to kind=4 self failed.')
 
       str_k1_arr(:) = co_str_k4_arr(:)[2]
       print *, '#' // str_k1_arr(:) // '#, len:', len(str_k1_arr(1))
-      if (any(str_k1_arr /= ['abc  ', 'EFG  ', 'klm  ', 'NOP  '])) error stop 'get array kind=4 to kind=1 self failed.'
+      if (any(str_k1_arr /= ['abc  ', 'EFG  ', 'klm  ', 'NOP  '])) &
+        call print_and_register( 'get array kind=4 to kind=1 self failed.')
     end if
 
     sync all
     if (me == 1) then
       str_k1_scal = co_str_k1_scal[2]
       print *, '#' // str_k1_scal // '#, len:', len(str_k1_scal)
-      if (co_str_k1_scal /= str_k1_scal // '          ') error stop 'get kind=1 to kind=1 image 2 failed.'
+      if (co_str_k1_scal /= str_k1_scal // '          ') call print_and_register( 'get kind=1 to kind=1 image 2 failed.')
 
       str_k4_scal = co_str_k4_scal[2]
       print *, 4_'#' // str_k4_scal // 4_'#, len:', len(str_k4_scal)
-      if (co_str_k4_scal /= str_k4_scal // 4_'          ') error stop 'get kind=4 to kind=4 image 2 failed.'
+      if (co_str_k4_scal /= str_k4_scal // 4_'          ') call print_and_register( 'get kind=4 to kind=4 image 2 failed.')
     else if (me == 2) then
       str_k4_scal = co_str_k1_scal[1]
       print *, 4_'#' // str_k4_scal // 4_'#, len:', len(str_k4_scal)
-      if (co_str_k4_scal /= str_k4_scal // 4_'          ') error stop 'get kind=1 to kind=4 from image 1 failed.'
+      if (co_str_k4_scal /= str_k4_scal // 4_'          ') call print_and_register( 'get kind=1 to kind=4 from image 1 failed.')
 
       str_k1_scal = co_str_k4_scal[1]
       print *, '#' // str_k1_scal // '#, len:', len(str_k1_scal)
-      if (co_str_k1_scal /= str_k1_scal // '          ') error stop 'get kind=4 to kind=1 from image 1 failed.'
+      if (co_str_k1_scal /= str_k1_scal // '          ') call print_and_register( 'get kind=4 to kind=1 from image 1 failed.')
     end if
 
     str_k1_arr(:) = '#####'
     str_k4_arr(:) = 4_'#####'
-    
+
     sync all
 
     if (me == 1) then
       str_k1_arr(1:2) = co_str_k1_arr(::2)[2]
       print *, str_k1_arr
       if (any(str_k1_arr /= ['abc  ', 'klm  ', '#####', '#####'])) &
-        & error stop "strided get char arr kind 1 to kind 1 failed."
+        & call print_and_register( "strided get char arr kind 1 to kind 1 failed.")
 
       str_k4_arr(1:2) = co_str_k4_arr(::2)[2]
       print *, str_k4_arr
       if (any(str_k4_arr /= [4_'abc  ', 4_'klm  ', 4_'#####', 4_'#####'] )) &
-        & error stop "strided get char arr kind 4 to kind 4 failed."
+        & call print_and_register( "strided get char arr kind 4 to kind 4 failed.")
     end if
 
-    sync all
-    if (me == 1) print *, 'Test passed.'
+    select case(me)
+     case(1)
+       if (error_printed) error stop
+       sync images(2)
+       print *, 'Test passed.'
+     case(2)
+       if (error_printed) error stop
+       sync images(1)
+    end select
+
   end associate
+
+contains
+
+  subroutine print_and_register(error_message)
+    use iso_fortran_env, only : error_unit
+    character(len=*), intent(in) :: error_message
+    write(error_unit,*) error_message
+    error_printed=.true.
+  end subroutine
+
 end program get_convert_char_array
 
 ! vim:ts=2:sts=2:sw=2:
+