Split apart alloc/non-alloc co_broadcast tests

Author: Damian Rouson

CMakeLists.txt

@@ -798,6 +798,7 @@ if(opencoarrays_aware_compiler)
   add_caf_test(co_sum 4 co_sum_test)
   add_caf_test(co_broadcast 4 co_broadcast_test)
   add_caf_test(co_broadcast_derived_type 4 co_broadcast_derived_type_test)
+  add_caf_test(co_broadcast_allocatable_components 4 co_broadcast_allocatable_components_test)
   add_caf_test(co_min 4 co_min_test)
   add_caf_test(co_max 4 co_max_test)
   add_caf_test(co_reduce 4 co_reduce_test)

src/tests/unit/collectives/CMakeLists.txt

@@ -1,6 +1,7 @@
 caf_compile_executable(co_sum_test co_sum.F90)
 caf_compile_executable(co_broadcast_test co_broadcast.F90)
 caf_compile_executable(co_broadcast_derived_type_test co_broadcast_derived_type.f90)
+caf_compile_executable(co_broadcast_allocatable_components_test co_broadcast_allocatable_components.f90)
 caf_compile_executable(co_min_test co_min.F90)
 caf_compile_executable(co_max_test co_max.F90)
 caf_compile_executable(co_reduce_test co_reduce.F90)

src/tests/unit/collectives/co_broadcast_allocatable_components.f90

@@ -0,0 +1,60 @@
+program main
+  !! author: Damian Rouson
+  !!
+  !! Test co_broadcast with derived-type actual arguments
+  implicit none
+
+  integer, parameter :: sender=1 !! co_broadcast source_image
+  character(len=*), parameter :: text="text" !! character message data
+
+  interface
+     function f(x) result(y)
+       real x, y
+     end function
+  end interface
+
+      type dynamic
+        character(len=:), allocatable :: string
+        character(len=len(text)), allocatable :: string_array(:)
+        complex, allocatable :: scalar
+        integer, allocatable :: vector(:)
+        logical, allocatable :: matrix(:,:)
+        real, allocatable ::  superstring(:,:,:, :,:,:, :,:,:, :,:,:, :,:,: )
+      end type
+
+      type(dynamic) alloc_message, alloc_content
+
+  associate(me=>this_image())
+
+      alloc_content = dynamic(                                               &
+        string=text,                                                         &
+        string_array=[text],                                                 &
+        scalar=(0.,1.),                                                      &
+        vector=reshape( [integer::], [0]),                                   &
+        matrix=reshape( [.true.], [1,1]),                                    &
+        superstring=reshape([1,2,3,4], [2,1,2, 1,1,1, 1,1,1, 1,1,1, 1,1,1 ]) &
+      )
+
+      if (me==sender) alloc_message = alloc_content
+
+     call co_broadcast(alloc_message,source_image=sender)
+
+     associate( failures => [                                    &
+       alloc_message%string /= alloc_content%string,             &
+       alloc_message%string_array /= alloc_content%string_array, &
+       alloc_message%scalar /= alloc_content%scalar,             &
+       alloc_message%vector /= alloc_content%vector,             &
+       alloc_message%matrix .neqv. alloc_content%matrix,         &
+       alloc_message%superstring /= alloc_content%superstring    &
+     ] )
+
+        if ( any(failures) ) error stop "Test failed."
+
+      end associate
+
+    sync all  ! Wait for each image to pass the test
+    if (me==sender) print *,"Test passed."
+
+  end associate
+
+end program main

src/tests/unit/collectives/co_broadcast_derived_type.f90

@@ -13,9 +13,6 @@ function f(x) result(y)
      end function
   end interface
 
-  associate(me=>this_image())
-
-    test_non_allocatable: block
       type parent
         integer :: heritable=0
       end type
@@ -52,6 +49,9 @@ function f(x) result(y)
         a=component(-3), b=reshape([component(-2),component(-1)], [1,2,1, 1,1,1, 1,1,1, 1,1,1, 1,1,1]),        & ! derived types
         c=text, z=[character(len=len(text))::], i=(0.,1.), j=(2.,3.), k=4, l=5, r=.true., s=.true., t=7., u=8. & ! intrinsic types
       )
+
+  associate(me=>this_image())
+
       if (me==sender) then
         message = content
         allocate(message%char_ptr, message%char_ptr_maxdim(1,1,2, 1,1,1, 1,1,1, 1,1,1, 1,1,1), source=text   )
@@ -87,52 +87,10 @@ function f(x) result(y)
         any( message%u /= content%u )                         &
       ] )
 
-        if ( any(failures) ) error stop "Test failed in non-allocatable block."
-
-      end associate
-
-    end block test_non_allocatable
-
-    test_allocatable: block
-      type dynamic
-        character(len=:), allocatable :: string
-        character(len=len(text)), allocatable :: string_array(:)
-        complex, allocatable :: scalar
-        integer, allocatable :: vector(:)
-        logical, allocatable :: matrix(:,:)
-        real, allocatable ::  superstring(:,:,:, :,:,:, :,:,:, :,:,:, :,:,: )
-      end type
-
-      type(dynamic) alloc_message, alloc_content
-
-      alloc_content = dynamic(                                               &
-        string=text,                                                         &
-        string_array=[text],                                                 &
-        scalar=(0.,1.),                                                      &
-        vector=reshape( [integer::], [0]),                                   &
-        matrix=reshape( [.true.], [1,1]),                                    &
-        superstring=reshape([1,2,3,4], [2,1,2, 1,1,1, 1,1,1, 1,1,1, 1,1,1 ]) &
-      )
-
-      if (me==sender) alloc_message = alloc_content
-
-     call co_broadcast(alloc_message,source_image=sender)
-
-     associate( failures => [                                    &
-       alloc_message%string /= alloc_content%string,             &
-       alloc_message%string_array /= alloc_content%string_array, &
-       alloc_message%scalar /= alloc_content%scalar,             &
-       alloc_message%vector /= alloc_content%vector,             &
-       alloc_message%matrix .neqv. alloc_content%matrix,         &
-       alloc_message%superstring /= alloc_content%superstring    &
-     ] )
-
-        if ( any(failures) ) error stop "Test failed in allocatable block."
+        if ( any(failures) ) error stop "Test failed. "
 
       end associate
 
-     end block test_allocatable
-
     sync all  ! Wait for each image to pass the test
     if (me==sender) print *,"Test passed."