diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index d1240055..9aafedad 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_SYNC_MEMORY -DHAVE_COARRAY -DHAVE_ALLOC_COARRAY=0 -DHAVE_COARRAY_QUERY=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_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 @@ -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: | diff --git a/app/native-multi-image.F90 b/app/native-multi-image.F90 index d5c028d9..49e7ef34 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 @@ -66,6 +64,29 @@ program native_multi_image #ifndef HAVE_ALLOC_COARRAY #define HAVE_ALLOC_COARRAY HAVE_COARRAY #endif +#ifndef HAVE_SAVE_COARRAY +#define HAVE_SAVE_COARRAY HAVE_COARRAY +#endif +#ifndef HAVE_MODULE_COARRAY +#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) \ @@ -75,10 +96,119 @@ program native_multi_image 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 + 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 + +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 + +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 -! Main program +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 end type @@ -86,8 +216,8 @@ program native_multi_image type(dummy_team_descriptor), pointer :: info => null() end type - integer :: me, ni, peer, tmp, fail_count = 0 - 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 @@ -142,31 +272,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 @@ -190,6 +334,55 @@ 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...") + 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...") + 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...") + 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], 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)...") + 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 + # if HAVE_EVENT_TYPE CHECK_TYPE_COMPLIANCE(EVENT_TYPE, default_event, .false., 64) # endif @@ -206,6 +399,14 @@ 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 + call test_module_coarray + call test_module_coarray + call sync_all write(*,'(A,I1,A,I1,A)') "Goodbye from image ", me, " of ", ni, " images" @@ -224,43 +425,38 @@ 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) \ - 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 - - logical, save :: once = .true. + 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, 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,*]) @@ -268,25 +464,14 @@ 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 - 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 +534,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 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) & 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