From 5a092eb4e574240620e66869525e2d88bb17d6bc Mon Sep 17 00:00:00 2001 From: Andre Vehreschild Date: Mon, 10 Jan 2022 20:29:47 +0100 Subject: [PATCH 1/2] Add test case for issue 727 --- CMakeLists.txt | 3 + src/tests/unit/collectives/CMakeLists.txt | 3 + .../collectives/co_broadcast_alloc_mixed.f90 | 78 +++++++++++++++++++ 3 files changed, 84 insertions(+) create mode 100644 src/tests/unit/collectives/co_broadcast_alloc_mixed.f90 diff --git a/CMakeLists.txt b/CMakeLists.txt index 7e11a420..2d86a7ca 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -813,6 +813,9 @@ if(opencoarrays_aware_compiler) if((gfortran_compiler AND (NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 10.0.0)) OR (CAF_RUN_DEVELOPER_TESTS OR $ENV{OPENCOARRAYS_DEVELOPER})) add_caf_test(co_broadcast_allocatable_components 4 co_broadcast_allocatable_components_test) endif() + if((gfortran_compiler AND (NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 11.2.2)) OR (CAF_RUN_DEVELOPER_TESTS OR $ENV{OPENCOARRAYS_DEVELOPER})) + add_caf_test(co_broadcast_alloc_mixed 2 co_broadcast_alloc_mixed) + endif() 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) diff --git a/src/tests/unit/collectives/CMakeLists.txt b/src/tests/unit/collectives/CMakeLists.txt index af5ca628..090ebab4 100644 --- a/src/tests/unit/collectives/CMakeLists.txt +++ b/src/tests/unit/collectives/CMakeLists.txt @@ -4,6 +4,9 @@ caf_compile_executable(co_broadcast_derived_type_test co_broadcast_derived_type. if((gfortran_compiler AND (NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 10.0.0)) OR (CAF_RUN_DEVELOPER_TESTS OR $ENV{OPENCOARRAYS_DEVELOPER})) caf_compile_executable(co_broadcast_allocatable_components_test co_broadcast_allocatable_components.f90) endif() +if((gfortran_compiler AND (NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 11.2.2)) OR (CAF_RUN_DEVELOPER_TESTS OR $ENV{OPENCOARRAYS_DEVELOPER})) + caf_compile_executable(co_broadcast_alloc_mixed co_broadcast_alloc_mixed.f90) +endif() 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) diff --git a/src/tests/unit/collectives/co_broadcast_alloc_mixed.f90 b/src/tests/unit/collectives/co_broadcast_alloc_mixed.f90 new file mode 100644 index 00000000..d22bade2 --- /dev/null +++ b/src/tests/unit/collectives/co_broadcast_alloc_mixed.f90 @@ -0,0 +1,78 @@ +program co_broadcast_derived_with_allocs_test +!! author: Brad Richardson & Andre Vehreschild +!! category: regression +!! +!! [issue #727](/~https://github.com/sourceryinstitute/opencoarrays/issues/727) +!! broadcasting derived types with a mixture of scalar and allocatable +!! scalars or arrays lead to unexpected results + +implicit none + +type nsas_t + integer :: i + integer, allocatable :: j +end type + +type asas_t + integer, allocatable :: i + integer, allocatable :: j +end type + +type nsaa_t + integer :: i + integer, allocatable :: j(:) +end type + +type naaa_t + integer :: i(3) + integer, allocatable :: j(:) +end type + +type(nsas_t) nsas +type(asas_t) asas +type(nsaa_t) nsaa +type(naaa_t) naaa + +integer, parameter :: source_image = 1 + +if (this_image() == source_image) then + nsas = nsas_t(2, 3) + + asas = asas_t(4, 5) + + nsaa = nsaa_t(6, (/ 7, 8 /)) + + naaa = naaa_t((/ 9,10,11 /), (/ 12,13,14,15 /)) +else + allocate(nsas%j) + + allocate(asas%i); allocate(asas%j) + + allocate(nsaa%j(2)) + + allocate(naaa%j(4)) +end if + +print *, "nsas" +call co_broadcast(nsas, source_image) +if (nsas%i /= 2 .or. nsas%j /= 3) error stop "Test failed at 1." + +print *, "asas" +call co_broadcast(asas, source_image) +if (asas%i /= 4 .or. asas%j /= 5) error stop "Test failed at 2." + +print *, "nsaa" +call co_broadcast(nsaa, source_image) +if (nsaa%i /= 6 .or. any(nsaa%j(:) /= (/ 7, 8 /))) error stop "Test failed at 3." + +print *, "naaa" +call co_broadcast(naaa, source_image) +if (any(naaa%i(:) /= (/ 9,10,11 /)) .or. any(naaa%j(:) /= (/ 12,13,14,15 /))) then + error stop "Test failed at 3." +end if + +sync all + +print *, "Test passed." + +end From fb165fd8fd62d5fda91fdd41773f160ae9db0e58 Mon Sep 17 00:00:00 2001 From: Andre Vehreschild Date: Mon, 10 Jan 2022 20:30:05 +0100 Subject: [PATCH 2/2] Add more debug output for co_broadcast --- src/mpi/mpi_caf.c | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/mpi/mpi_caf.c b/src/mpi/mpi_caf.c index 4461aa94..76133f8f 100644 --- a/src/mpi/mpi_caf.c +++ b/src/mpi/mpi_caf.c @@ -7524,6 +7524,8 @@ PREFIX(co_broadcast) (gfc_descriptor_t *a, int source_image, int *stat, size *= dimextent; } + dprint("Using mpi-datatype: 0x%x in co_broadcast (base_addr=%p, rank= %d).\n", + datatype, a->base_addr, rank); if (rank == 0) { if( datatype == MPI_BYTE) @@ -7564,16 +7566,17 @@ PREFIX(co_broadcast) (gfc_descriptor_t *a, int source_image, int *stat, for (i = 0; i < size; ++i) { - ptrdiff_t array_offset_sr = 0, tot_ext = 1, extent = 1; + ptrdiff_t array_offset = 0, tot_ext = 1, extent = 1; for (j = 0; j < rank - 1; ++j) { extent = a->dim[j]._ubound - a->dim[j].lower_bound + 1; - array_offset_sr += ((i / tot_ext) % extent) * a->dim[j]._stride; + array_offset += ((i / tot_ext) % extent) * a->dim[j]._stride; tot_ext *= extent; } - array_offset_sr += (i / tot_ext) * a->dim[rank - 1]._stride; + array_offset += (i / tot_ext) * a->dim[rank - 1]._stride; + dprint("The array offset for element %d used in co_broadcast is %d\n", i, array_offset); void *sr = (void *)( - (char *)a->base_addr + array_offset_sr * GFC_DESCRIPTOR_SIZE(a)); + (char *)a->base_addr + array_offset * GFC_DESCRIPTOR_SIZE(a)); ierr = MPI_Bcast(sr, 1, datatype, source_image - 1, CAF_COMM_WORLD); chk_err(ierr);