From a8cc85c63c30f12b5182104d9c9578fe0778348a Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Sun, 5 Jul 2026 10:45:12 -0700 Subject: [PATCH 01/12] native-multi-image: structural house-keeping Add a helper module Add implicit none --- app/native-multi-image.F90 | 90 +++++++++++++++++++++----------------- 1 file changed, 50 insertions(+), 40 deletions(-) diff --git a/app/native-multi-image.F90 b/app/native-multi-image.F90 index d5c028d9..cc49ba7d 100644 --- a/app/native-multi-image.F90 +++ b/app/native-multi-image.F90 @@ -4,8 +4,6 @@ ! This program is NOT designed to evaluate runtime correctness, just to exercise ! some basic calls to the features. -program native_multi_image - #if HAVE_MULTI_IMAGE ! feature control: #ifndef HAVE_SYNC @@ -76,9 +74,53 @@ program native_multi_image storage_size(subject)/8, bytes); \ END BLOCK -! Main program +module helpers + USE, INTRINSIC :: ISO_FORTRAN_ENV + USE, INTRINSIC :: ISO_C_BINDING, only: c_int8_t + implicit none + public + integer :: fail_count = 0 + contains + function tostring(int) result(res) + integer :: int + character(len=128) :: str + character(len=:), allocatable :: res + write(str, *) int + res = trim(adjustl(str)) + end function + + function hexdump(arr) result(res) + integer(c_int8_t), intent(in) :: arr(:) + character(len=:), allocatable :: res + character(len=4096) :: buf + write(buf, '(*(Z2, 1X))') arr + res = trim(buf) + end function + subroutine sync_all +# if HAVE_SYNC_ALL + SYNC ALL +# endif + end subroutine + subroutine flush_all + flush output_unit + flush error_unit + end subroutine + subroutine status(str) + character(len=*) :: str + call flush_all + call sync_all + if (THIS_IMAGE() == 1) write(*,'(A)') str + call flush_all + call sync_all + end subroutine + +end module ! helpers + +program native_multi_image USE, INTRINSIC :: ISO_FORTRAN_ENV USE, INTRINSIC :: ISO_C_BINDING, only: c_int8_t + use helpers + implicit none type :: dummy_team_descriptor end type @@ -86,7 +128,7 @@ program native_multi_image type(dummy_team_descriptor), pointer :: info => null() end type - integer :: me, ni, peer, tmp, fail_count = 0 + integer :: me, ni, peer, tmp character(len=5) :: c # if HAVE_TEAM integer :: team_id @@ -224,24 +266,6 @@ program native_multi_image stop fail_count contains - subroutine sync_all -# if HAVE_SYNC_ALL - SYNC ALL -# endif - end subroutine - subroutine flush_all - flush output_unit - flush error_unit - end subroutine - subroutine status(str) - character(len=*) :: str - call flush_all - call sync_all - if (THIS_IMAGE() == 1) write(*,'(A)') str - call flush_all - call sync_all - end subroutine - subroutine test_allocatable_coarray() # if HAVE_ALLOC_COARRAY # define CHECK_ALLOC(coarray, expect) \ @@ -251,6 +275,7 @@ subroutine test_allocatable_coarray() fail_count = fail_count + 1 ; \ end if + implicit none logical, save :: once = .true. integer, allocatable :: aca_int_1[:] integer, allocatable :: aca_int_2[:,:] @@ -271,22 +296,6 @@ subroutine test_allocatable_coarray() # endif end subroutine - function tostring(int) result(res) - integer :: int - character(len=128) :: str - character(len=:), allocatable :: res - write(str, *) int - res = trim(adjustl(str)) - end function - - function hexdump(arr) result(res) - integer(c_int8_t), intent(in) :: arr(:) - character(len=:), allocatable :: res - character(len=4096) :: buf - write(buf, '(*(Z2, 1X))') arr - res = trim(buf) - end function - subroutine check_type(type_name, is_team, min_size, subject_size, default_bytes) character(len=*), intent(in) :: type_name logical, intent(in) :: is_team @@ -349,8 +358,9 @@ subroutine check_type(type_name, is_team, min_size, subject_size, default_bytes) call status(" Default init of " // type_name // " ==> " // diag) end if end subroutine - +end program #else +program native_multi_image stop "Native multi-image test disabled" -#endif end program +#endif From 67541a6d0e5678d5a02b5c490f991a04e72ea588 Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Sun, 5 Jul 2026 10:46:57 -0700 Subject: [PATCH 02/12] CI: Enable LFortran testing of co_min/co_max --- .github/workflows/build.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index d1240055..2978d9ff 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -122,7 +122,7 @@ jobs: version: latest container: ghcr.io/lfortran/lfortran:latest native_multi_image: true - FFLAGS: --coarray=true -DHAVE_SYNC=0 -DHAVE_COLLECTIVES=0 -DHAVE_TEAM=0 -DHAVE_EVENT_TYPE=0 -DHAVE_LOCK_TYPE=0 -DHAVE_NOTIFY_TYPE=0 -DHAVE_CO_SUM -DHAVE_SYNC_ALL -DHAVE_MAIN_COARRAY + FFLAGS: --coarray=true -DHAVE_SYNC=0 -DHAVE_COLLECTIVES=0 -DHAVE_TEAM=0 -DHAVE_EVENT_TYPE=0 -DHAVE_LOCK_TYPE=0 -DHAVE_NOTIFY_TYPE=0 -DHAVE_CO_SUM -DHAVE_CO_MIN -DHAVE_CO_MAX -DHAVE_SYNC_ALL -DHAVE_MAIN_COARRAY - os: ubuntu-22.04 compiler: lfortran From aa74d545522c60082a82953d110d2e2317a886f0 Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Sun, 5 Jul 2026 10:50:25 -0700 Subject: [PATCH 03/12] native-multi-image: Expand collective tests to include array of intrinsics --- app/native-multi-image.F90 | 34 ++++++++++++++++++++++++---------- 1 file changed, 24 insertions(+), 10 deletions(-) diff --git a/app/native-multi-image.F90 b/app/native-multi-image.F90 index cc49ba7d..f4490e3a 100644 --- a/app/native-multi-image.F90 +++ b/app/native-multi-image.F90 @@ -128,8 +128,8 @@ program native_multi_image type(dummy_team_descriptor), pointer :: info => null() end type - integer :: me, ni, peer, tmp - character(len=5) :: c + integer :: me, ni, peer, i, ia(3) + character(len=5) :: c, ca(3) # if HAVE_TEAM integer :: team_id type(TEAM_TYPE) :: subteam, res @@ -184,31 +184,45 @@ program native_multi_image if (me /= peer) SYNC IMAGES([me, peer]) #endif - tmp = me + i = me + ia = me c = "hello" + ca = c # if HAVE_CO_SUM call status("Testing CO_SUM...") - call CO_SUM(tmp) - call CO_SUM(tmp,1) + call CO_SUM(i) + call CO_SUM(i,1) + call CO_SUM(ia) + call CO_SUM(ia,1) # endif # if HAVE_CO_MIN call status("Testing CO_MIN...") - call CO_MIN(tmp) - call CO_MIN(tmp,1) + call CO_MIN(i) + call CO_MIN(i,1) + call CO_MIN(ia) + call CO_MIN(ia,1) call CO_MIN(c) call CO_MIN(c,1) + call CO_MIN(ca) + call CO_MIN(ca,1) # endif # if HAVE_CO_MAX call status("Testing CO_MAX...") - call CO_MAX(tmp) - call CO_MAX(tmp,1) + call CO_MAX(i) + call CO_MAX(i,1) + call CO_MAX(ia) + call CO_MAX(ia,1) call CO_MAX(c) call CO_MAX(c,1) + call CO_MAX(ca) + call CO_MAX(ca,1) # endif # if HAVE_CO_BROADCAST call status("Testing CO_BROADCAST...") - call CO_BROADCAST(tmp,1) + call CO_BROADCAST(i,1) + call CO_BROADCAST(ia,1) call CO_BROADCAST(c,1) + call CO_BROADCAST(ca,1) # endif # if HAVE_TEAM From ca05684829bb7573fb0683600e95f5caff372601 Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Sun, 5 Jul 2026 11:03:57 -0700 Subject: [PATCH 04/12] native-multi-image: Add a test for save coarrays in external subroutine --- .github/workflows/build.yml | 4 ++-- app/native-multi-image.F90 | 41 +++++++++++++++++++++++++++++++++++++ 2 files changed, 43 insertions(+), 2 deletions(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 2978d9ff..4dc6541a 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -122,7 +122,7 @@ jobs: version: latest container: ghcr.io/lfortran/lfortran:latest native_multi_image: true - FFLAGS: --coarray=true -DHAVE_SYNC=0 -DHAVE_COLLECTIVES=0 -DHAVE_TEAM=0 -DHAVE_EVENT_TYPE=0 -DHAVE_LOCK_TYPE=0 -DHAVE_NOTIFY_TYPE=0 -DHAVE_CO_SUM -DHAVE_CO_MIN -DHAVE_CO_MAX -DHAVE_SYNC_ALL -DHAVE_MAIN_COARRAY + FFLAGS: --coarray=true -DHAVE_SYNC=0 -DHAVE_COLLECTIVES=0 -DHAVE_TEAM=0 -DHAVE_EVENT_TYPE=0 -DHAVE_LOCK_TYPE=0 -DHAVE_NOTIFY_TYPE=0 -DHAVE_CO_SUM -DHAVE_CO_MIN -DHAVE_CO_MAX -DHAVE_SYNC_ALL -DHAVE_COARRAY -DHAVE_ALLOC_COARRAY=0 - os: ubuntu-22.04 compiler: lfortran @@ -329,7 +329,7 @@ jobs: fi if [ "${NATIVE_MULTI_IMAGE}" == true ] ; then if [[ $COMPILER_VERSION == latest ]] ; then - echo "FFLAGS=$FFLAGS -fcoarray -DHAVE_COARRAY -DIGNORE_FAILURES=9" >> "$GITHUB_ENV" + echo "FFLAGS=$FFLAGS -fcoarray -DHAVE_COARRAY -DHAVE_SAVE_COARRAY=0 -DIGNORE_FAILURES=9" >> "$GITHUB_ENV" else echo "FFLAGS=$FFLAGS -fcoarray -DIGNORE_FAILURES=8" >> "$GITHUB_ENV" fi diff --git a/app/native-multi-image.F90 b/app/native-multi-image.F90 index f4490e3a..afd58162 100644 --- a/app/native-multi-image.F90 +++ b/app/native-multi-image.F90 @@ -64,6 +64,9 @@ #ifndef HAVE_ALLOC_COARRAY #define HAVE_ALLOC_COARRAY HAVE_COARRAY #endif +#ifndef HAVE_SAVE_COARRAY +#define HAVE_SAVE_COARRAY HAVE_COARRAY +#endif ! Helper macros #define CHECK_TYPE_COMPLIANCE(subject_type, subject, is_team, min_size) \ @@ -73,6 +76,17 @@ call check_type(#subject_type, is_team, min_size, \ storage_size(subject)/8, bytes); \ END BLOCK +#define CHECK_VALI(expr, expect) \ + BLOCK ; \ + use helpers ; \ + integer :: cvi_tmp ; \ + cvi_tmp = (expr) ; \ + if (cvi_tmp /= (expect)) then ; \ + if (THIS_IMAGE() == 1) write(*,'(A,I)') __FILE__//":"//tostring(__LINE__)//": ERROR: " // \ + #expr // " = ", cvi_tmp ; \ + fail_count = fail_count + 1 ; \ + end if ; \ + END BLOCK module helpers USE, INTRINSIC :: ISO_FORTRAN_ENV @@ -116,6 +130,29 @@ subroutine status(str) end module ! helpers +subroutine test_save_extern_coarray() +#if HAVE_SAVE_COARRAY + use helpers + implicit none + logical, save :: once = .true. + integer, save :: esc_int_1[*] + integer, save :: esc_int_2[2,*] + integer, save :: esc_int_3[2:3,4:5,*] + + if (once) then + once = .false. + call status("Testing external SAVE coarrays...") + esc_int_1 = 1 + esc_int_2 = 2 + esc_int_3 = 3 + else + CHECK_VALI(esc_int_1, 1) + CHECK_VALI(esc_int_2, 2) + CHECK_VALI(esc_int_3, 3) + end if +#endif +end subroutine + program native_multi_image USE, INTRINSIC :: ISO_FORTRAN_ENV USE, INTRINSIC :: ISO_C_BINDING, only: c_int8_t @@ -262,6 +299,10 @@ program native_multi_image call test_allocatable_coarray call test_allocatable_coarray + call sync_all + call test_save_extern_coarray + call test_save_extern_coarray + call sync_all write(*,'(A,I1,A,I1,A)') "Goodbye from image ", me, " of ", ni, " images" From 87005bb59fffac0999995d275b71ec39c448d3bb Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Sun, 5 Jul 2026 12:33:48 -0700 Subject: [PATCH 05/12] native-multi-image: Add a test for coarrays in a module --- .github/workflows/build.yml | 2 +- app/native-multi-image.F90 | 38 +++++++++++++++++++++++++++++++++++++ 2 files changed, 39 insertions(+), 1 deletion(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 4dc6541a..b1031766 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -329,7 +329,7 @@ jobs: fi if [ "${NATIVE_MULTI_IMAGE}" == true ] ; then if [[ $COMPILER_VERSION == latest ]] ; then - echo "FFLAGS=$FFLAGS -fcoarray -DHAVE_COARRAY -DHAVE_SAVE_COARRAY=0 -DIGNORE_FAILURES=9" >> "$GITHUB_ENV" + echo "FFLAGS=$FFLAGS -fcoarray -DHAVE_COARRAY -DHAVE_SAVE_COARRAY=0 -DHAVE_MODULE_COARRAY=0 -DIGNORE_FAILURES=9" >> "$GITHUB_ENV" else echo "FFLAGS=$FFLAGS -fcoarray -DIGNORE_FAILURES=8" >> "$GITHUB_ENV" fi diff --git a/app/native-multi-image.F90 b/app/native-multi-image.F90 index afd58162..75b5f323 100644 --- a/app/native-multi-image.F90 +++ b/app/native-multi-image.F90 @@ -67,6 +67,9 @@ #ifndef HAVE_SAVE_COARRAY #define HAVE_SAVE_COARRAY HAVE_COARRAY #endif +#ifndef HAVE_MODULE_COARRAY +#define HAVE_MODULE_COARRAY HAVE_COARRAY +#endif ! Helper macros #define CHECK_TYPE_COMPLIANCE(subject_type, subject, is_team, min_size) \ @@ -153,10 +156,41 @@ subroutine test_save_extern_coarray() #endif end subroutine +module coarrays + use helpers + implicit none +# if HAVE_MODULE_COARRAY + integer :: msc_int_1[*] + integer :: msc_int_2[2,*] + integer :: msc_int_3[2:3,4:5,*] +# endif + public + contains + subroutine test_module_coarray() +# if HAVE_MODULE_COARRAY + implicit none + logical, save :: once = .true. + + if (once) then + once = .false. + call status("Testing module SAVE coarrays...") + msc_int_1 = 1 + msc_int_2 = 2 + msc_int_3 = 3 + else + CHECK_VALI(msc_int_1, 1) + CHECK_VALI(msc_int_2, 2) + CHECK_VALI(msc_int_3, 3) + end if +# endif + end subroutine +end module + program native_multi_image USE, INTRINSIC :: ISO_FORTRAN_ENV USE, INTRINSIC :: ISO_C_BINDING, only: c_int8_t use helpers + use coarrays implicit none type :: dummy_team_descriptor @@ -303,6 +337,10 @@ program native_multi_image call test_save_extern_coarray call test_save_extern_coarray + call sync_all + call test_module_coarray + call test_module_coarray + call sync_all write(*,'(A,I1,A,I1,A)') "Goodbye from image ", me, " of ", ni, " images" From da18434c3a2a2918879b58d406f1a5e80a01d8ab Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Sun, 5 Jul 2026 12:56:48 -0700 Subject: [PATCH 06/12] native-multi-image: Improve HAVE_ALLOC_COARRAY reporting * fix an incorrect test for aca_int_3 * Add a partially-effective workaround for a flang optimizer bug that caused spurious failures * Disable the HAVE_ALLOC_COARRAY test for flang, as its behavior remains unstable --- .github/workflows/build.yml | 2 +- app/native-multi-image.F90 | 35 ++++++++++++++++++++++++++--------- 2 files changed, 27 insertions(+), 10 deletions(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index b1031766..fb6391f4 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -329,7 +329,7 @@ jobs: fi if [ "${NATIVE_MULTI_IMAGE}" == true ] ; then if [[ $COMPILER_VERSION == latest ]] ; then - echo "FFLAGS=$FFLAGS -fcoarray -DHAVE_COARRAY -DHAVE_SAVE_COARRAY=0 -DHAVE_MODULE_COARRAY=0 -DIGNORE_FAILURES=9" >> "$GITHUB_ENV" + echo "FFLAGS=$FFLAGS -fcoarray -DHAVE_COARRAY -DHAVE_ALLOC_COARRAY=0 -DHAVE_SAVE_COARRAY=0 -DHAVE_MODULE_COARRAY=0 -DIGNORE_FAILURES=6" >> "$GITHUB_ENV" else echo "FFLAGS=$FFLAGS -fcoarray -DIGNORE_FAILURES=8" >> "$GITHUB_ENV" fi diff --git a/app/native-multi-image.F90 b/app/native-multi-image.F90 index 75b5f323..6a194f7f 100644 --- a/app/native-multi-image.F90 +++ b/app/native-multi-image.F90 @@ -362,23 +362,35 @@ program native_multi_image subroutine test_allocatable_coarray() # if HAVE_ALLOC_COARRAY # define CHECK_ALLOC(coarray, expect) \ - if (ALLOCATED(coarray) .neqv. expect) then ; \ - if (THIS_IMAGE() == 1) write(*,'(A)') __FILE__//":"//tostring(__LINE__)//": ERROR: " // \ - " ALLOCATED(" // #coarray // ") = " // MERGE("true ","false",ALLOCATED(coarray)) ; \ - fail_count = fail_count + 1 ; \ - end if + BLOCK ; \ + logical :: ca_a, ca_e ; \ + ca_a = ALLOCATED(coarray) ; \ + ca_e = (expect) ; \ + if (ca_a .neqv. ca_e) then ; \ + if (THIS_IMAGE() == 1) write(*,'(A)') __FILE__//":"//tostring(__LINE__)//": ERROR: " // \ + " ALLOCATED(" // #coarray // ") = " // MERGE("true ","false",ca_a) // \ + ", expected = " // MERGE("true ","false",ca_e) ; \ + fail_count = fail_count + 1 ; \ + end if ; \ + END BLOCK implicit none - logical, save :: once = .true. + logical, volatile, save :: once = .true. ! volatile is workaround for flang optimizer bug integer, allocatable :: aca_int_1[:] integer, allocatable :: aca_int_2[:,:] integer, save, allocatable :: aca_int_3[:,:,:] + if (once) then + call status("Testing ALLOCATABLE coarrays...") + end if +# if VERBOSE + if (THIS_IMAGE() == 1) & + write (*,*) once, "ENTRY:", ALLOCATED(aca_int_1), ALLOCATED(aca_int_2), ALLOCATED(aca_int_3) +# endif CHECK_ALLOC(aca_int_1, .false.) CHECK_ALLOC(aca_int_2, .false.) - CHECK_ALLOC(aca_int_3, .false.) + CHECK_ALLOC(aca_int_3, .not. once) + if (once) then - once = .false. - call status("Testing ALLOCATABLE coarrays...") ALLOCATE(aca_int_1[*]) ALLOCATE(aca_int_2[2,*]) ALLOCATE(aca_int_3[2,3,*]) @@ -386,6 +398,11 @@ subroutine test_allocatable_coarray() CHECK_ALLOC(aca_int_2, .true.) CHECK_ALLOC(aca_int_3, .true.) end if +# if VERBOSE + if (THIS_IMAGE() == 1) & + write (*,*) once, "EXIT: ", ALLOCATED(aca_int_1), ALLOCATED(aca_int_2), ALLOCATED(aca_int_3) +# endif + once = .false. # endif end subroutine From cb26975cb018e15da634129c95613c68ab94c938 Mon Sep 17 00:00:00 2001 From: Katherine Rasmussen Date: Tue, 23 Jun 2026 18:24:58 -0700 Subject: [PATCH 07/12] Add more multi image intrinsic function calls to the integration test. (cherry picked from commit 7604fa5fd4ffc476cee3b62d9ee9fb001f7c4c8b) (cherry picked from commit fa39daa6046c0656712c031074a22167c9134c02) --- app/native-multi-image.F90 | 57 +++++++++++++++++++++++++++++++++++++- 1 file changed, 56 insertions(+), 1 deletion(-) diff --git a/app/native-multi-image.F90 b/app/native-multi-image.F90 index 6a194f7f..573e8d8e 100644 --- a/app/native-multi-image.F90 +++ b/app/native-multi-image.F90 @@ -56,7 +56,7 @@ #endif #ifndef HAVE_COARRAY -#define HAVE_COARRAY 0 +#define HAVE_COARRAY 1 #endif #ifndef HAVE_MAIN_COARRAY #define HAVE_MAIN_COARRAY HAVE_COARRAY @@ -71,6 +71,23 @@ #define HAVE_MODULE_COARRAY HAVE_COARRAY #endif +! coarray query intrinsics +#ifndef HAVE_COARRAY_QUERY +#define HAVE_COARRAY_QUERY HAVE_COARRAY +#endif +#ifndef HAVE_COBOUND +#define HAVE_COBOUND HAVE_COARRAY_QUERY +#endif +#ifndef HAVE_COSHAPE +#define HAVE_COSHAPE HAVE_COARRAY_QUERY +#endif +#ifndef HAVE_IMAGE_INDEX +#define HAVE_IMAGE_INDEX HAVE_COARRAY_QUERY +#endif +#ifndef HAVE_THIS_IMAGE_COARRAY +#define HAVE_THIS_IMAGE_COARRAY HAVE_COARRAY_QUERY +#endif + ! Helper macros #define CHECK_TYPE_COMPLIANCE(subject_type, subject, is_team, min_size) \ BLOCK ; \ @@ -317,6 +334,44 @@ program native_multi_image write(*,'(A,I3)') "After END TEAM statement, TEAM_NUMBER() is ", TEAM_NUMBER() # endif +# if HAVE_MAIN_COARRAY +# if HAVE_COBOUND + call status("Testing LCOBOUND/UCOBOUND...") + write(*,'(A,2I3)') "lcobound(sca_int_2) = ", LCOBOUND(sca_int_2) + write(*,'(A,2I3)') "ucobound(sca_int_2) = ", UCOBOUND(sca_int_2) + write(*,'(A,3I3)') "lcobound(sca_int_3) = ", LCOBOUND(sca_int_3) + write(*,'(A,3I3)') "ucobound(sca_int_3) = ", UCOBOUND(sca_int_3) + write(*,'(A,I3)') "lcobound(sca_int_3, dim=2) = ", LCOBOUND(sca_int_3, dim=2) + write(*,'(A,I3)') "ucobound(sca_int_3, dim=2) = ", UCOBOUND(sca_int_3, dim=2) + write(*,'(A,I3)') "lcobound(sca_int_3, dim=2, kind=8) = ", LCOBOUND(sca_int_3, dim=2, kind=8) + write(*,'(A,I3)') "ucobound(sca_int_3, dim=2, kind=8) = ", UCOBOUND(sca_int_3, dim=2, kind=8) +# endif +# if HAVE_COSHAPE + call status("Testing COSHAPE...") + write(*,'(A,3I3)') "coshape(sca_int_3) = ", COSHAPE(sca_int_3) + write(*,'(A,3I3)') "coshape(sca_int_3, kind=8) = ", COSHAPE(sca_int_3, kind=8) +# endif +# if HAVE_IMAGE_INDEX + call status("Testing IMAGE_INDEX...") + write(*,'(A,I3)') "image_index(sca_int_1, [1]) = ", IMAGE_INDEX(sca_int_1, [1]) + write(*,'(A,I3)') "image_index(sca_int_2, [1,1]) = ", IMAGE_INDEX(sca_int_2, [1,1]) + write(*,'(A,I3)') "image_index(sca_int_3, [1,1,1]) = ", IMAGE_INDEX(sca_int_3, [1,1,1]) +# if HAVE_TEAM +! write(*,'(A,I3)') "image_index(sca_int_1, [1], get_team()) = ", IMAGE_INDEX(sca_int_1, [1], GET_TEAM()) + write(*,'(A,I3)') "image_index(sca_int_1, [1], team_number=-1) = ", IMAGE_INDEX(sca_int_1, [1], TEAM_NUMBER=-1) +! write(*,'(A,I3)') "image_index(sca_int_3, [1,1,1], get_team()) = ", IMAGE_INDEX(sca_int_3, [1,1,1], GET_TEAM()) + write(*,'(A,I3)') "image_index(sca_int_3, [1,1,1], team_number=-1) = ", IMAGE_INDEX(sca_int_3, [1,1,1], TEAM_NUMBER=-1) +# endif +# endif +# if HAVE_THIS_IMAGE_COARRAY + call status("Testing THIS_IMAGE(coarray)...") + write(*,'(A,I3)') "this_image(sca_int_1) = ", THIS_IMAGE(sca_int_1) + write(*,'(A,2I3)') "this_image(sca_int_2) = ", THIS_IMAGE(sca_int_2) + write(*,'(A,3I3)') "this_image(sca_int_3) = ", THIS_IMAGE(sca_int_3) + write(*,'(A,I3)') "this_image(sca_int_3, dim=2) = ", THIS_IMAGE(sca_int_3, dim=2) +# endif +# endif + # if HAVE_EVENT_TYPE CHECK_TYPE_COMPLIANCE(EVENT_TYPE, default_event, .false., 64) # endif From 7f17345bc06f1b64ac9fbcced732a45828a224cd Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Sun, 5 Jul 2026 16:25:02 -0700 Subject: [PATCH 08/12] native-multi-image: Restrict printing to a single image Adjust enable logic Note output is currently incorrect due to https://github.com/llvm/llvm-project/issues/207858 --- .github/workflows/build.yml | 2 +- app/native-multi-image.F90 | 55 ++++++++++++++++++++++--------------- 2 files changed, 34 insertions(+), 23 deletions(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index fb6391f4..237bee23 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -122,7 +122,7 @@ jobs: version: latest container: ghcr.io/lfortran/lfortran:latest native_multi_image: true - FFLAGS: --coarray=true -DHAVE_SYNC=0 -DHAVE_COLLECTIVES=0 -DHAVE_TEAM=0 -DHAVE_EVENT_TYPE=0 -DHAVE_LOCK_TYPE=0 -DHAVE_NOTIFY_TYPE=0 -DHAVE_CO_SUM -DHAVE_CO_MIN -DHAVE_CO_MAX -DHAVE_SYNC_ALL -DHAVE_COARRAY -DHAVE_ALLOC_COARRAY=0 + FFLAGS: --coarray=true -DHAVE_SYNC=0 -DHAVE_COLLECTIVES=0 -DHAVE_TEAM=0 -DHAVE_EVENT_TYPE=0 -DHAVE_LOCK_TYPE=0 -DHAVE_NOTIFY_TYPE=0 -DHAVE_CO_SUM -DHAVE_CO_MIN -DHAVE_CO_MAX -DHAVE_SYNC_ALL -DHAVE_COARRAY -DHAVE_ALLOC_COARRAY=0 -DHAVE_COARRAY_QUERY=0 - os: ubuntu-22.04 compiler: lfortran diff --git a/app/native-multi-image.F90 b/app/native-multi-image.F90 index 573e8d8e..49e7ef34 100644 --- a/app/native-multi-image.F90 +++ b/app/native-multi-image.F90 @@ -56,7 +56,7 @@ #endif #ifndef HAVE_COARRAY -#define HAVE_COARRAY 1 +#define HAVE_COARRAY 0 #endif #ifndef HAVE_MAIN_COARRAY #define HAVE_MAIN_COARRAY HAVE_COARRAY @@ -337,38 +337,49 @@ program native_multi_image # if HAVE_MAIN_COARRAY # if HAVE_COBOUND call status("Testing LCOBOUND/UCOBOUND...") - write(*,'(A,2I3)') "lcobound(sca_int_2) = ", LCOBOUND(sca_int_2) - write(*,'(A,2I3)') "ucobound(sca_int_2) = ", UCOBOUND(sca_int_2) - write(*,'(A,3I3)') "lcobound(sca_int_3) = ", LCOBOUND(sca_int_3) - write(*,'(A,3I3)') "ucobound(sca_int_3) = ", UCOBOUND(sca_int_3) - write(*,'(A,I3)') "lcobound(sca_int_3, dim=2) = ", LCOBOUND(sca_int_3, dim=2) - write(*,'(A,I3)') "ucobound(sca_int_3, dim=2) = ", UCOBOUND(sca_int_3, dim=2) - write(*,'(A,I3)') "lcobound(sca_int_3, dim=2, kind=8) = ", LCOBOUND(sca_int_3, dim=2, kind=8) - write(*,'(A,I3)') "ucobound(sca_int_3, dim=2, kind=8) = ", UCOBOUND(sca_int_3, dim=2, kind=8) + if (THIS_IMAGE() == 1) then + ! Note output is affected by llvm-project issue #207858 + write(*,'(A,2I3)') "lcobound(sca_int_2) = ", LCOBOUND(sca_int_2) + write(*,'(A,2I3)') "ucobound(sca_int_2) = ", UCOBOUND(sca_int_2) + write(*,'(A,3I3)') "lcobound(sca_int_3) = ", LCOBOUND(sca_int_3) + write(*,'(A,3I3)') "ucobound(sca_int_3) = ", UCOBOUND(sca_int_3) + write(*,'(A,I3)') "lcobound(sca_int_3, dim=2) = ", LCOBOUND(sca_int_3, dim=2) + write(*,'(A,I3)') "ucobound(sca_int_3, dim=2) = ", UCOBOUND(sca_int_3, dim=2) + write(*,'(A,I3)') "lcobound(sca_int_3, dim=2, kind=8) = ", LCOBOUND(sca_int_3, dim=2, kind=8) + write(*,'(A,I3)') "ucobound(sca_int_3, dim=2, kind=8) = ", UCOBOUND(sca_int_3, dim=2, kind=8) + end if # endif # if HAVE_COSHAPE call status("Testing COSHAPE...") - write(*,'(A,3I3)') "coshape(sca_int_3) = ", COSHAPE(sca_int_3) - write(*,'(A,3I3)') "coshape(sca_int_3, kind=8) = ", COSHAPE(sca_int_3, kind=8) + if (THIS_IMAGE() == 1) then + ! Note output is affected by llvm-project issue #207858 + write(*,'(A,3I3)') "coshape(sca_int_3) = ", COSHAPE(sca_int_3) + write(*,'(A,3I3)') "coshape(sca_int_3, kind=8) = ", COSHAPE(sca_int_3, kind=8) + end if # endif # if HAVE_IMAGE_INDEX call status("Testing IMAGE_INDEX...") - write(*,'(A,I3)') "image_index(sca_int_1, [1]) = ", IMAGE_INDEX(sca_int_1, [1]) - write(*,'(A,I3)') "image_index(sca_int_2, [1,1]) = ", IMAGE_INDEX(sca_int_2, [1,1]) - write(*,'(A,I3)') "image_index(sca_int_3, [1,1,1]) = ", IMAGE_INDEX(sca_int_3, [1,1,1]) + if (THIS_IMAGE() == 1) then + write(*,'(A,I3)') "image_index(sca_int_1, [1]) = ", IMAGE_INDEX(sca_int_1, [1]) + write(*,'(A,I3)') "image_index(sca_int_2, [1,1]) = ", IMAGE_INDEX(sca_int_2, [1,1]) + write(*,'(A,I3)') "image_index(sca_int_3, [1,1,1]) = ", IMAGE_INDEX(sca_int_3, [1,1,1]) # if HAVE_TEAM -! write(*,'(A,I3)') "image_index(sca_int_1, [1], get_team()) = ", IMAGE_INDEX(sca_int_1, [1], GET_TEAM()) - write(*,'(A,I3)') "image_index(sca_int_1, [1], team_number=-1) = ", IMAGE_INDEX(sca_int_1, [1], TEAM_NUMBER=-1) -! write(*,'(A,I3)') "image_index(sca_int_3, [1,1,1], get_team()) = ", IMAGE_INDEX(sca_int_3, [1,1,1], GET_TEAM()) - write(*,'(A,I3)') "image_index(sca_int_3, [1,1,1], team_number=-1) = ", IMAGE_INDEX(sca_int_3, [1,1,1], TEAM_NUMBER=-1) + write(*,'(A,I3)') "image_index(sca_int_1, [1], team_number=-1) = ", IMAGE_INDEX(sca_int_1, [1], TEAM_NUMBER=-1) + write(*,'(A,I3)') "image_index(sca_int_3, [1,1,1], team_number=-1) = ", IMAGE_INDEX(sca_int_3, [1,1,1], TEAM_NUMBER=-1) + ! disabled for llvm-project issue #205953 + !write(*,'(A,I3)') "image_index(sca_int_1, [1], get_team()) = ", IMAGE_INDEX(sca_int_1, [1], GET_TEAM()) + !write(*,'(A,I3)') "image_index(sca_int_3, [1,1,1], get_team()) = ", IMAGE_INDEX(sca_int_3, [1,1,1], GET_TEAM()) # endif + end if # endif # if HAVE_THIS_IMAGE_COARRAY call status("Testing THIS_IMAGE(coarray)...") - write(*,'(A,I3)') "this_image(sca_int_1) = ", THIS_IMAGE(sca_int_1) - write(*,'(A,2I3)') "this_image(sca_int_2) = ", THIS_IMAGE(sca_int_2) - write(*,'(A,3I3)') "this_image(sca_int_3) = ", THIS_IMAGE(sca_int_3) - write(*,'(A,I3)') "this_image(sca_int_3, dim=2) = ", THIS_IMAGE(sca_int_3, dim=2) + if (THIS_IMAGE() == NUM_IMAGES()-1) then + write(*,'(A,I3)') "this_image(sca_int_1) = ", THIS_IMAGE(sca_int_1) + write(*,'(A,2I3)') "this_image(sca_int_2) = ", THIS_IMAGE(sca_int_2) + write(*,'(A,3I3)') "this_image(sca_int_3) = ", THIS_IMAGE(sca_int_3) + write(*,'(A,I3)') "this_image(sca_int_3, dim=2) = ", THIS_IMAGE(sca_int_3, dim=2) + end if # endif # endif From b6aceec17c392d6c2ded86b913cb419f76c5dede Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Sun, 5 Jul 2026 19:32:23 -0700 Subject: [PATCH 09/12] prif_coarray_inquiry_test: Factor and strengthen cobounds test coverage --- test/prif_coarray_inquiry_test.F90 | 91 +++++++++++++++++++++--------- 1 file changed, 65 insertions(+), 26 deletions(-) diff --git a/test/prif_coarray_inquiry_test.F90 b/test/prif_coarray_inquiry_test.F90 index faa3de58..965e8e66 100644 --- a/test/prif_coarray_inquiry_test.F90 +++ b/test/prif_coarray_inquiry_test.F90 @@ -1,9 +1,10 @@ +#include "julienne-assert-macros.h" #include "test-utils.F90" module prif_coarray_inquiry_test_m # include "test-uses-alloc.F90" use prif, only : & - prif_coarray_handle, prif_num_images, & + prif_coarray_handle, prif_this_image_no_coarray, prif_num_images, & prif_local_data_pointer, prif_size_bytes, & prif_lcobound_no_dim, prif_lcobound_with_dim, & prif_ucobound_no_dim, prif_ucobound_with_dim, & @@ -14,6 +15,7 @@ module prif_coarray_inquiry_test_m ,operator(.all.) & ,operator(.also.) & ,operator(.equalsExpected.) & + ,call_julienne_assert_ & ,usher & ,string_t & ,test_description_t & @@ -68,47 +70,42 @@ function check_prif_local_data_pointer() result(diag) call prif_deallocate_coarray(coarray_handle) end function - impure elemental function check_cobound(corank, omit_trailing) result(diag) - type(test_diagnosis_t) :: diag - integer(c_int), intent(in) :: corank + function check_cobound(lcobounds, ucobounds, omit_trailing) result(diag) + !! Allocate a coarray with given cobounds and test some queries on it + integer(kind=c_int64_t), intent(in) :: lcobounds(:), ucobounds(:) logical, intent(in) :: omit_trailing - ! Allocate memory for an integer scalar coarray with given corank - ! and then test some queries on it - - integer :: num_imgs, i - integer(kind=c_int64_t), dimension(corank) :: lcobounds, ucobounds, tmp_bounds - integer(kind=c_int64_t), dimension(corank-1) :: leading_ucobounds + integer(kind=c_int64_t) :: tmp_bounds(size(lcobounds)), actual_ucobounds(size(lcobounds)), leading_ucobounds(size(lcobounds)-1) integer(kind=c_int64_t) :: tmp_bound - integer(kind=c_size_t), dimension(corank) :: sizes + integer(kind=c_size_t) :: sizes(size(lcobounds)) type(prif_coarray_handle) :: coarray_handle type(c_ptr) :: allocated_memory integer(c_size_t) :: data_size, query_size + integer :: i, corank, num_imgs + type(test_diagnosis_t) :: diag diag = .true. + call_julienne_assert(size(lcobounds) == size(ucobounds)) + corank = size(lcobounds) call prif_num_images(num_images=num_imgs) - lcobounds(1) = 1 - ucobounds(1) = num_imgs - do i = 2,corank - lcobounds(i) = i - ucobounds(i) = i + merge(1,0,mod(i,2)==0) - end do + + ! compute trailing ucobound + actual_ucobounds = ucobounds + tmp_bound = product(ucobounds(1:corank-1) - lcobounds(1:corank-1) + 1) + actual_ucobounds(corank) = lcobounds(corank) + (num_imgs + tmp_bound - 1) / tmp_bound - 1 allocated_memory = c_null_ptr data_size = 64 * corank - if (omit_trailing) then leading_ucobounds = ucobounds(1:corank-1) call prif_allocate_coarray( lcobounds, leading_ucobounds, data_size, null_final_proc, & coarray_handle, allocated_memory) else - call prif_allocate_coarray( lcobounds, ucobounds, data_size, null_final_proc, & + call prif_allocate_coarray( lcobounds, actual_ucobounds, data_size, null_final_proc, & coarray_handle, allocated_memory) end if - if (corank > 1) ucobounds(corank) = lcobounds(corank) ! trailing ucobound gets rounded down - ALSO(c_associated(allocated_memory)) call prif_size_bytes(coarray_handle, data_size=query_size) @@ -118,30 +115,72 @@ impure elemental function check_cobound(corank, omit_trailing) result(diag) ALSO2(.all. (tmp_bounds .equalsExpected. lcobounds), "prif_lcobound_no_dim is valid") call prif_ucobound_no_dim(coarray_handle, tmp_bounds) - ALSO2(.all. (tmp_bounds .equalsExpected. ucobounds), "prif_ucobound_no_dim is valid") + ALSO2(.all. (tmp_bounds .equalsExpected. actual_ucobounds), "prif_ucobound_no_dim is valid") do i = 1, corank call prif_lcobound_with_dim(coarray_handle, i, tmp_bound) ALSO2(tmp_bound .equalsExpected. lcobounds(i), "prif_lcobound_with_dim is valid") call prif_ucobound_with_dim(coarray_handle, i, tmp_bound) - ALSO2(tmp_bound .equalsExpected. ucobounds(i), "prif_ucobound_with_dim is valid") + ALSO2(tmp_bound .equalsExpected. actual_ucobounds(i), "prif_ucobound_with_dim is valid") end do call prif_coshape(coarray_handle, sizes) - ALSO2(.all. ((ucobounds - lcobounds + 1) .equalsExpected. sizes), "prif_coshape is valid") + ALSO2(.all. ((actual_ucobounds - lcobounds + 1) .equalsExpected. sizes), "prif_coshape is valid") + +# if VERBOSE + block + integer :: me + call prif_this_image_no_coarray(this_image=me) + if (me == 1) then + write(*,'(A,*(I4))') "lcobounds=" , lcobounds + write(*,'(A,*(I4))') "ucobounds=" , actual_ucobounds + write(*,'(A,*(I4))') "sizes= " , sizes + end if + end block +# endif call prif_deallocate_coarray(coarray_handle) end function + impure elemental function check_corank(corank, omit_trailing) result(diag) + !! Allocate a coarray with given corank and test some queries on it + type(test_diagnosis_t) :: diag + integer(c_int), intent(in) :: corank + logical, intent(in) :: omit_trailing + + integer :: i + integer(kind=c_int64_t), dimension(corank) :: lcobounds, ucobounds + + lcobounds(1) = 10 + ucobounds(1) = 11 + do i = 2,corank + lcobounds(i) = 10*i + ucobounds(i) = 10*i + merge(1,0,mod(i,2)==0) + end do + + diag = check_cobound(lcobounds, ucobounds, omit_trailing) + + end function + function check_cobounds() result(diag) type(test_diagnosis_t) :: diag integer(c_int) :: corank diag = .true. - ALSO(.all. check_cobound([(corank, corank = 1_c_int, 15_c_int)], .false.)) - ALSO(.all. check_cobound([(corank, corank = 1_c_int, 15_c_int)], .true.)) + ! check some simple cases + ALSO(check_cobound([integer(c_int64_t) :: 1], [integer(c_int64_t) :: 0], .true.)) + + ALSO(check_cobound([integer(c_int64_t) :: 1, 1], [integer(c_int64_t) :: 2, 0], .true.)) + + ALSO(check_cobound([integer(c_int64_t) :: 1, 1, 1], [integer(c_int64_t) :: 2, 3, 0], .true.)) + + ALSO(check_cobound([integer(c_int64_t) :: 101, 101, 101], [integer(c_int64_t) :: 104, 102, 0], .true.)) + + ! cover all the possible coranks + ALSO(.all. check_corank([(corank, corank = 1_c_int, 15_c_int)], .false.)) + ALSO(.all. check_corank([(corank, corank = 1_c_int, 15_c_int)], .true.)) end function end module prif_coarray_inquiry_test_m From 0d3ee2393646e48035da480233bf4a784b225794 Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Mon, 6 Jul 2026 16:54:04 -0700 Subject: [PATCH 10/12] CI: Enable `sync memory` for LFortran --- .github/workflows/build.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 237bee23..c3a614fe 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -122,7 +122,7 @@ jobs: version: latest container: ghcr.io/lfortran/lfortran:latest native_multi_image: true - FFLAGS: --coarray=true -DHAVE_SYNC=0 -DHAVE_COLLECTIVES=0 -DHAVE_TEAM=0 -DHAVE_EVENT_TYPE=0 -DHAVE_LOCK_TYPE=0 -DHAVE_NOTIFY_TYPE=0 -DHAVE_CO_SUM -DHAVE_CO_MIN -DHAVE_CO_MAX -DHAVE_SYNC_ALL -DHAVE_COARRAY -DHAVE_ALLOC_COARRAY=0 -DHAVE_COARRAY_QUERY=0 + FFLAGS: --coarray=true -DHAVE_SYNC=0 -DHAVE_COLLECTIVES=0 -DHAVE_TEAM=0 -DHAVE_EVENT_TYPE=0 -DHAVE_LOCK_TYPE=0 -DHAVE_NOTIFY_TYPE=0 -DHAVE_CO_SUM -DHAVE_CO_MIN -DHAVE_CO_MAX -DHAVE_SYNC_ALL -DHAVE_SYNC_MEMORY -DHAVE_COARRAY -DHAVE_ALLOC_COARRAY=0 -DHAVE_COARRAY_QUERY=0 - os: ubuntu-22.04 compiler: lfortran From 2b8599d27a5e9dfc2c1e1c3034d3270742522eb5 Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Mon, 6 Jul 2026 19:53:21 -0700 Subject: [PATCH 11/12] prif_co_broadcast_test: Adjust LFortran check LFortran issue 11191 remains unresolved for now --- test/prif_co_broadcast_test.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/prif_co_broadcast_test.F90 b/test/prif_co_broadcast_test.F90 index a4541608..3a737e40 100644 --- a/test/prif_co_broadcast_test.F90 +++ b/test/prif_co_broadcast_test.F90 @@ -52,7 +52,7 @@ function results() result(test_results) test_description_t("broadcasting a default integer scalar with no optional arguments present", usher(broadcast_default_integer_scalar)) & ,test_description_t("prif_co_broadcast of a derived type scalar with no allocatable components", usher(broadcast_derived_type)) & ,test_description_t("prif_co_broadcast_cptr of a derived type scalar with no allocatable components" & -# if __LFORTRAN__ && __LFORTRAN_MAJOR__ == 0 && __LFORTRAN_MINOR__ <= 63 +# if __LFORTRAN__ ! test disabled for LFortran issue 11191 # else , usher(broadcast_derived_type_cptr) & From eadd05b45737b8d70b2b8cb225110fd0245a54b9 Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Mon, 6 Jul 2026 20:09:59 -0700 Subject: [PATCH 12/12] CI: ignore intermittent INEXACT exceptions from AMUDP at exit time --- .github/workflows/build.yml | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index c3a614fe..9aafedad 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -434,7 +434,10 @@ jobs: if: ${{ env.NATIVE_MULTI_IMAGE == 'true' }} run: | ./run-fpm.sh run --verbose 2>&1 | tee output - ! grep -q "IEEE arithmetic exceptions signaled" output + if [[ "${{ matrix.network }}" != "udp" ]] ; then + # ignore intermittent INEXACT exceptions from AMUDP at exit time + ! grep -q "IEEE arithmetic exceptions signaled" output + fi - name: Run unit tests run: |