diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index a10351a3..41c8031f 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -108,14 +108,14 @@ jobs: - os: ubuntu-24.04 compiler: flang version: latest - #container: snowstep/llvm:ubuntu-24.04-latest - container: snowstep/llvm:debian-12-latest + container: snowstep/llvm:ubuntu-24.04-latest + #container: snowstep/llvm:debian-12-latest # https://hub.docker.com/r/phhargrove/llvm-flang/tags - os: ubuntu-24.04 compiler: flang version: 23 - container: phhargrove/llvm-flang:23.1.0_rc2-latest + container: phhargrove/llvm-flang:23.1.0_rc3-latest - os: ubuntu-24.04 compiler: flang version: 22 @@ -141,15 +141,11 @@ jobs: compiler: lfortran version: latest container: ghcr.io/lfortran/lfortran:latest - native_multi_image: true - FFLAGS: --coarray=true -DHAVE_TEAM=0 -DHAVE_TEAM_TYPE -DHAVE_FORM_TEAM -DHAVE_SYNC_TEAM -DHAVE_COARRAY -DHAVE_ALLOC_COARRAY=0 -DHAVE_COARRAY_QUERY=0 -DHAVE_COBOUND -DHAVE_EVENT=0 -DHAVE_LOCK_TYPE=0 -DHAVE_NOTIFY_TYPE=0 - os: ubuntu-22.04 compiler: lfortran version: 0.64 container: ghcr.io/lfortran/lfortran:v0.64.0 - native_multi_image: true - FFLAGS: --coarray=true -DHAVE_TEAM=0 -DHAVE_COARRAY -DHAVE_ALLOC_COARRAY=0 -DHAVE_COARRAY_QUERY=0 -DHAVE_EVENT=0 -DHAVE_LOCK_TYPE=0 -DHAVE_NOTIFY_TYPE=0 - os: ubuntu-22.04 compiler: lfortran @@ -233,13 +229,13 @@ jobs: compiler: flang version: 23 network: udp - container: phhargrove/llvm-flang:23.1.0_rc2-latest + container: phhargrove/llvm-flang:23.1.0_rc3-latest - os: ubuntu-24.04 compiler: flang version: latest network: udp - #container: snowstep/llvm:ubuntu-24.04-latest - container: snowstep/llvm:debian-12-latest + container: snowstep/llvm:ubuntu-24.04-latest + #container: snowstep/llvm:debian-12-latest container: image: ${{ matrix.container }} @@ -247,9 +243,6 @@ jobs: env: COMPILER_VERSION: ${{ matrix.version || needs.setup.outputs.BREW_FLANG_VERSION }} - NATIVE_MULTI_IMAGE: ${{ matrix.native_multi_image || - ( matrix.compiler == 'flang' && ( ! matrix.version || matrix.version >= 22 || matrix.version == 'latest' ) ) - }} FFLAGS: ${{ matrix.FFLAGS }} ${{ inputs.fflags }} CFLAGS: ${{ matrix.CFLAGS }} ${{ inputs.cflags }} PREFIX: install @@ -359,15 +352,6 @@ jobs: echo "CC=clang" >> "$GITHUB_ENV" echo "CXX=clang++" >> "$GITHUB_ENV" fi - if [ "${NATIVE_MULTI_IMAGE}" == true ] ; then - if [[ $COMPILER_VERSION == latest ]] ; then - echo "FFLAGS=$FFLAGS -fcoarray -DHAVE_COARRAY -DHAVE_ALLOC_COARRAY=0 -DHAVE_COARRAY_INIT=0 -DHAVE_COARRAY_LOCAL_ACCESS=0 -DHAVE_PUTGET=0 -DHAVE_EVENT=0 -DHAVE_EVENT_TYPE -DIGNORE_FAILURES=6" >> "$GITHUB_ENV" - elif [[ $COMPILER_VERSION == 23 ]] ; then - echo "FFLAGS=$FFLAGS -fcoarray -DHAVE_COARRAY -DHAVE_ALLOC_COARRAY=0 -DHAVE_COARRAY_INIT=0 -DHAVE_COARRAY_LOCAL_ACCESS=0 -DHAVE_PUTGET=0 -DHAVE_EVENT=0 -DHAVE_EVENT_TYPE -DIGNORE_FAILURES=6" >> "$GITHUB_ENV" - else # $COMPILER_VERSION == 22 - echo "FFLAGS=$FFLAGS -fcoarray -DHAVE_EVENT_TYPE -DIGNORE_FAILURES=8" >> "$GITHUB_ENV" - fi - fi - name: Setup lfortran dependencies and variables if: ${{ matrix.compiler == 'lfortran' }} @@ -399,12 +383,6 @@ jobs: if test "${{ matrix.network }}" = "udp"; then echo "GASNET_SUPERNODE_MAXSIZE=1" >> "$GITHUB_ENV" fi - # Turn some knobs for a compiler that natively uses PRIF for multi-image features: - # HAVE_MULTI_IMAGE : controls app/native-multi-image and prif_init testing - # HAVE_MULTI_IMAGE_SUPPORT : force-enable Julienne's multi-image support - if [ "${NATIVE_MULTI_IMAGE}" == true ] ; then - echo "FFLAGS=$FFLAGS -DHAVE_MULTI_IMAGE -DHAVE_MULTI_IMAGE_SUPPORT" >> "$GITHUB_ENV" - fi - name: Set Workflow Dispatch Environment if: github.event_name == 'workflow_dispatch' @@ -451,6 +429,9 @@ jobs: eval echo "$var=\$$var"; done ./install.sh --prefix=${PREFIX} ${NETWORK_ARG} --verbose \ ${{ inputs.install_args }} ${{ matrix.install_filter }} + if ! grep -q 'NATIVEFLAGS=""' run-fpm.sh ; then + echo "NATIVE_MULTI_IMAGE=true" >> "$GITHUB_ENV" + fi ########################################################################## # Caffeine Testing @@ -464,15 +445,21 @@ jobs: echo CAF_IMAGES=${CAF_IMAGES} ./run-fpm.sh run --verbose --example hello - - name: Run native multi-image test + - name: Run native multi-image test (with Caffeine) if: ${{ env.NATIVE_MULTI_IMAGE == 'true' }} run: | ./run-fpm.sh run --verbose 2>&1 | tee output + test ${PIPESTATUS[0]} = 0 if [[ "${{ matrix.network }}" != "udp" ]] ; then # ignore intermittent INEXACT exceptions from AMUDP at exit time ! grep -q "IEEE arithmetic exceptions signaled" output fi + - name: Run native multi-image test (stand-alone) + if: ${{ matrix.compiler == 'gfortran' && matrix.version >= '16' }} + run: | + make -C app gcc GFORTRAN=$FC + - name: Run unit tests run: | while (( CAF_IMAGES > 0 )); do diff --git a/app/Makefile b/app/Makefile new file mode 100644 index 00000000..8e8d4f7d --- /dev/null +++ b/app/Makefile @@ -0,0 +1,60 @@ +# This Makefile is for internal testing use only and not intended for end-users +# To run this test with Caffeine, please execute `./run-fpm.sh run` in the top-level directory + +# overridable settings +NUM_IMAGES?=4 +FLAGS= +NATIVE_FLAGS=$$($(MAKE) --no-print-directory print-flags FC=$$FC) +GFORTRAN=gfortran +FC_FORCE= + +# ---------------------------------------------------------------- + +SHELL = bash + +all: gcc + +print-flags: + @$$FC print-native-flags.F90 -o print-native-flags + @./print-native-flags -s + @rm -f print-native-flags + +gcc: + @set -x ; \ + export FC=$(if $(FC_FORCE),$(FC_FORCE),$(GFORTRAN)) ; \ + export NATIVE_FLAGS="$(NATIVE_FLAGS)" && \ + $$FC -g -fcoarray=lib $$NATIVE_FLAGS $(FLAGS) \ + native-multi-image.F90 -o native-multi-image-gcc -lcaf_shmem + env GFORTRAN_NUM_IMAGES=$(NUM_IMAGES) ./native-multi-image-gcc + +nag: + @set -x ; \ + export FC=$(if $(FC_FORCE),$(FC_FORCE),nagfor) ; \ + export NATIVE_FLAGS="$(NATIVE_FLAGS)" && \ + $(GFORTRAN) -E -DNAGFOR $$NATIVE_FLAGS $(FLAGS) \ + native-multi-image.F90 > native-multi-image.i.F90 && \ + $$FC -u -g -coarray native-multi-image.i.F90 -o native-multi-image-nag + @rm -f native-multi-image.i.F90 + env NAGFORTRAN_NUM_IMAGES=$(NUM_IMAGES) ./native-multi-image-nag + +cce: + @set -x ; \ + export FC=$(if $(FC_FORCE),$(FC_FORCE),ftn) ; \ + export NATIVE_FLAGS="$(NATIVE_FLAGS)" && \ + $$FC -g -hcaf -O0 $$NATIVE_FLAGS $(FLAGS) \ + native-multi-image.F90 -o native-multi-image-cce + ./native-multi-image-cce + srun -n $(NUM_IMAGES) ./native-multi-image-cce + +intel: + @set -x ; \ + export FC=$(if $(FC_FORCE),$(FC_FORCE),ifx) ; \ + export NATIVE_FLAGS="$(NATIVE_FLAGS)" && \ + $$FC -g -coarray -O0 $$NATIVE_FLAGS $(FLAGS) \ + native-multi-image.F90 -o native-multi-image-intel + env FOR_COARRAY_NUM_IMAGES=$(NUM_IMAGES) ./native-multi-image-intel + +clean: + rm -f *.mod *.i.F90 native-multi-image-{gcc,nag,cce,intel} + +.PHONY: nag gcc clean diff --git a/app/native-multi-image.F90 b/app/native-multi-image.F90 index 0888efa3..20f0d7c2 100644 --- a/app/native-multi-image.F90 +++ b/app/native-multi-image.F90 @@ -35,7 +35,11 @@ #define HAVE_CO_BROADCAST HAVE_COLLECTIVES #endif +! TYPES_PRIF_COMPLIANT: ISO_FORTRAN_ENV multi-image types satisfy PRIF requirements ! TYPES_IMPORT_PRIF: compiler imports the real PRIF definition of ISO_FORTRAN_ENV types +#ifndef TYPES_PRIF_COMPLIANT +#define TYPES_PRIF_COMPLIANT 1 +#endif #ifndef TYPES_IMPORT_PRIF #define TYPES_IMPORT_PRIF 0 #endif @@ -46,8 +50,14 @@ #ifndef HAVE_TEAM_TYPE #define HAVE_TEAM_TYPE HAVE_TEAM #endif -#ifndef HAVE_TEAM_QUERIES -#define HAVE_TEAM_QUERIES HAVE_TEAM +#ifndef HAVE_GET_TEAM +#define HAVE_GET_TEAM HAVE_TEAM +#endif +#ifndef HAVE_TEAM_NUMBER +#define HAVE_TEAM_NUMBER HAVE_TEAM +#endif +#ifndef HAVE_TEAM_NUMBER_TEAM +#define HAVE_TEAM_NUMBER_TEAM HAVE_TEAM_NUMBER #endif #ifndef HAVE_FORM_TEAM #define HAVE_FORM_TEAM HAVE_TEAM @@ -58,16 +68,31 @@ #ifndef HAVE_CHANGE_TEAM #define HAVE_CHANGE_TEAM HAVE_TEAM #endif +#ifndef HAVE_THIS_IMAGE_TEAM +#define HAVE_THIS_IMAGE_TEAM HAVE_TEAM +#endif +#ifndef HAVE_NUM_IMAGES_TEAM +#define HAVE_NUM_IMAGES_TEAM HAVE_TEAM +#endif #ifndef HAVE_COARRAY -#define HAVE_COARRAY 0 +#define HAVE_COARRAY 1 #endif #ifndef HAVE_MAIN_COARRAY #define HAVE_MAIN_COARRAY HAVE_COARRAY #endif +#ifndef HAVE_MAIN_COARRAY_ARRAY +#define HAVE_MAIN_COARRAY_ARRAY HAVE_COARRAY +#endif #ifndef HAVE_ALLOC_COARRAY #define HAVE_ALLOC_COARRAY HAVE_COARRAY #endif +#ifndef HAVE_ALLOC_COARRAY_DEALLOC +#define HAVE_ALLOC_COARRAY_DEALLOC HAVE_ALLOC_COARRAY +#endif +#ifndef HAVE_ALLOC_COARRAY_CLEANUP +#define HAVE_ALLOC_COARRAY_CLEANUP HAVE_ALLOC_COARRAY +#endif #ifndef HAVE_SAVE_COARRAY #define HAVE_SAVE_COARRAY HAVE_COARRAY #endif @@ -87,6 +112,9 @@ #ifndef HAVE_PUTGET_INTRINSIC_SCALAR #define HAVE_PUTGET_INTRINSIC_SCALAR HAVE_PUTGET #endif +#ifndef HAVE_PUTGET_INTRINSIC_ARRAY_CONTIG +#define HAVE_PUTGET_INTRINSIC_ARRAY_CONTIG HAVE_PUTGET +#endif ! coarray query intrinsics #ifndef HAVE_COARRAY_QUERY @@ -101,6 +129,12 @@ #ifndef HAVE_IMAGE_INDEX #define HAVE_IMAGE_INDEX HAVE_COARRAY_QUERY #endif +#ifndef HAVE_IMAGE_INDEX_TEAM +#define HAVE_IMAGE_INDEX_TEAM HAVE_IMAGE_INDEX +#endif +#ifndef HAVE_IMAGE_INDEX_TEAM_NUMBER +#define HAVE_IMAGE_INDEX_TEAM_NUMBER HAVE_IMAGE_INDEX +#endif #ifndef HAVE_THIS_IMAGE_COARRAY #define HAVE_THIS_IMAGE_COARRAY HAVE_COARRAY_QUERY #endif @@ -118,33 +152,67 @@ #define HAVE_EVENT_QUERY HAVE_EVENT #endif +#ifndef HAVE_LOCK +#define HAVE_LOCK HAVE_COARRAY +#endif #ifndef HAVE_LOCK_TYPE -#define HAVE_LOCK_TYPE 1 +#define HAVE_LOCK_TYPE HAVE_LOCK #endif +#ifndef HAVE_NOTIFY +#define HAVE_NOTIFY HAVE_COARRAY +#endif #ifndef HAVE_NOTIFY_TYPE -#define HAVE_NOTIFY_TYPE 1 +#define HAVE_NOTIFY_TYPE HAVE_NOTIFY #endif ! Helper macros +#ifndef CPP_STRINGIFY_SOURCE +# if defined(__GFORTRAN__) || defined(_CRAYFTN) || defined(NAGFOR) +# define CPP_STRINGIFY_SOURCE(x) "x" +# else +# define CPP_STRINGIFY_SOURCE(x) #x +# endif +#endif +#define STATUS(msg_expr) \ + BLOCK ; \ + character(len=:), allocatable :: stat_msg__ ; \ + allocate(character(0) :: stat_msg__) ; \ + stat_msg__ = msg_expr ; \ + call status(stat_msg__) ; \ + END BLOCK #define CHECK_TYPE_COMPLIANCE(subject_type, subject, is_team, min_size) \ BLOCK ; \ integer(c_int8_t), allocatable, target :: bytes(:) ; \ bytes = transfer(subject, bytes) ; \ - call check_type(#subject_type, is_team, min_size, \ + call check_type(CPP_STRINGIFY_SOURCE(subject_type), is_team, min_size, \ storage_size(subject)/8, bytes); \ END BLOCK -#define CHECK_VALI(expr, expect) \ +! check that an expression has a given integer value +#define CHECK_VALIK(expr, expect, kind) \ BLOCK ; \ - use helpers ; \ - integer :: cvi_tmp ; \ + integer kind :: cvi_tmp ; \ cvi_tmp = (expr) ; \ if (cvi_tmp /= (expect)) then ; \ - if (THIS_IMAGE() == 1) write(*,'(A,I)') __FILE__//":"//tostring(__LINE__)//": ERROR: " // \ - #expr // " = ", cvi_tmp ; \ + if (THIS_IMAGE() == 1) write(*,'(A,I0)') __FILE__//":"//tostring(__LINE__)//": ERROR: " // \ + CPP_STRINGIFY_SOURCE(expr) // " = ", cvi_tmp ; \ fail_count = fail_count + 1 ; \ end if ; \ END BLOCK +#define CHECK_VALI(expr, expect) CHECK_VALIK(expr, expect, ) +#define CHECK_VALI64(expr, expect) CHECK_VALIK(expr, expect, (int64)) +! check that an expression has a given logical value +#define CHECK_VALL(expr, expect) \ + BLOCK ; \ + logical :: cvl_tmp ; \ + cvl_tmp = (expr) ; \ + if (cvl_tmp .neqv. (expect)) then ; \ + if (THIS_IMAGE() == 1) write(*,'(A,L1)') __FILE__//":"//tostring(__LINE__)//": ERROR: " // \ + CPP_STRINGIFY_SOURCE(expr) // " = ", cvl_tmp ; \ + fail_count = fail_count + 1 ; \ + end if ; \ + END BLOCK +#define CHECK_ASSERT(expr) CHECK_VALL((expr), .true.) #define COARRAY_INT_INIT_VALUE 123456789 #if HAVE_COARRAY_INIT @@ -160,12 +228,25 @@ module helpers public integer :: fail_count = 0 contains - function tostring(int) result(res) - integer :: int - character(len=128) :: str + function tostring(int, width) result(res) + integer, intent(in) :: int + integer, intent(in), optional :: width character(len=:), allocatable :: res - write(str, *) int - res = trim(adjustl(str)) + if (present(width)) then + allocate(character(width) :: res) + write(res, '(I0)') int + res = adjustr(res) + else + allocate(character(128) :: res) + write(res, '(I0)') int + res = trim(adjustl(res)) + end if + end function + + function element(intarr, idx) result(res) + integer, intent(in) :: intarr(*), idx + integer :: res + res = intarr(idx) end function function hexdump(arr) result(res) @@ -206,7 +287,7 @@ subroutine test_save_extern_coarray() if (once) then once = .false. - call status("Testing external SAVE coarrays...") + if (THIS_IMAGE() == 1) write(*,'(A)') "Testing external SAVE coarrays..." # if HAVE_COARRAY_LOCAL_ACCESS # if HAVE_COARRAY_INIT CHECK_VALI(esc_int_1, COARRAY_INT_INIT_VALUE) @@ -226,7 +307,6 @@ subroutine test_save_extern_coarray() end subroutine module coarrays - use helpers implicit none # if HAVE_MODULE_COARRAY @@ -240,12 +320,13 @@ module coarrays contains subroutine test_module_coarray() # if HAVE_MODULE_COARRAY + use helpers implicit none logical, save :: once = .true. if (once) then once = .false. - call status("Testing module SAVE coarrays...") + if (THIS_IMAGE() == 1) write(*,'(A)') "Testing module SAVE coarrays..." # if HAVE_COARRAY_LOCAL_ACCESS # if HAVE_COARRAY_INIT CHECK_VALI(msc_int_1, COARRAY_INT_INIT_VALUE) @@ -279,10 +360,12 @@ program native_multi_image end type integer :: me, ni, peer, i, ia(3) - character(len=5) :: c, ca(3) -# if HAVE_TEAM_TYPE + character(len=10) :: c, ca(3) +# if HAVE_TEAM integer :: team_id type(TEAM_TYPE) :: subteam +# endif +# if HAVE_TEAM_TYPE type(TEAM_TYPE) :: default_team # endif # if HAVE_MAIN_COARRAY @@ -290,6 +373,16 @@ program native_multi_image integer :: sca_int_2[2,*] COARRAY_INT_INIT integer :: sca_int_3[2,3,*] COARRAY_INT_INIT # endif +# if HAVE_MAIN_COARRAY_ARRAY + integer :: sca_int100_1(100)[*] COARRAY_INT_INIT + integer :: sca_int100_2(100)[2,*] COARRAY_INT_INIT + integer :: sca_int100_3(100)[2,3,*] COARRAY_INT_INIT +# endif +# if HAVE_ALLOC_COARRAY + integer, allocatable :: aca_int_1[:] + integer, allocatable :: aca_int_2[:,:] + integer, allocatable :: aca_int_3[:,:,:] +# endif # if HAVE_EVENT_TYPE type(event_type), target :: default_event[*] type(event_type) :: test_event[*] @@ -305,7 +398,7 @@ program native_multi_image ni = NUM_IMAGES() peer = MIN(IEOR(me-1,1)+1, ni) - write(*,'(A,I1,A,I1,A)') "Hello, world! From image ", me, " of ", ni, " images" + write(*,'(A,I0,A,I0,A)') "Hello, world! From image ", me, " of ", ni, " images" # if SET_EXCEPTIONS block @@ -318,147 +411,263 @@ program native_multi_image # endif # if HAVE_SYNC_ALL - call status("Testing SYNC ALL...") + STATUS("Testing SYNC ALL...") call sync_all # endif # if HAVE_SYNC_MEMORY - call status("Testing SYNC MEMORY...") + STATUS("Testing SYNC MEMORY...") SYNC MEMORY # endif # if HAVE_SYNC_IMAGES - call status("Testing SYNC IMAGES...") + STATUS("Testing SYNC IMAGES...") SYNC IMAGES(*) SYNC IMAGES(peer) SYNC IMAGES([peer]) if (me /= peer) SYNC IMAGES([me, peer]) #endif - i = me - ia = me - c = "hello" - ca = c # if HAVE_CO_SUM - call status("Testing CO_SUM...") + STATUS("Testing CO_SUM...") + i = me + ia = me call CO_SUM(i) + CHECK_VALI(i,ni*(ni+1)/2) call CO_SUM(i,1) call CO_SUM(ia) + CHECK_ASSERT(all(ia == ni*(ni+1)/2)) call CO_SUM(ia,1) # endif # if HAVE_CO_MIN - call status("Testing CO_MIN...") + STATUS("Testing CO_MIN...") + i = 10*(ni-me+1) + ia = i call CO_MIN(i) + CHECK_VALI(i,10) call CO_MIN(i,1) call CO_MIN(ia) + CHECK_ASSERT(all(ia == 10)) call CO_MIN(ia,1) + c = tostring(10*(ni-me+1), len(c)) + ca = c +# if VERBOSE + write(*,'(I3,A,A)') THIS_IMAGE(), ": BEFORE CO_MIN(CHARACTER): ", c +# endif call CO_MIN(c) +# if VERBOSE + write(*,'(I3,A,A)') THIS_IMAGE(), ": AFTER CO_MIN(CHARACTER): ", c +# endif + CHECK_ASSERT(c == tostring(10, len(c))) call CO_MIN(c,1) call CO_MIN(ca) + CHECK_ASSERT(all(ca == tostring(10, len(c)))) call CO_MIN(ca,1) # endif # if HAVE_CO_MAX - call status("Testing CO_MAX...") + STATUS("Testing CO_MAX...") + i = 100*me + ia = i call CO_MAX(i) + CHECK_VALI(i,100*ni) call CO_MAX(i,1) call CO_MAX(ia) + CHECK_ASSERT(all(ia == 100*ni)) call CO_MAX(ia,1) + c = tostring(100*me, len(c)) + ca = c +# if VERBOSE + write(*,'(I3,A,A)') THIS_IMAGE(), ": BEFORE CO_MAX(CHARACTER): ", c +# endif call CO_MAX(c) +# if VERBOSE + write(*,'(I3,A,A)') THIS_IMAGE(), ": AFTER CO_MAX(CHARACTER): ", c +# endif + CHECK_ASSERT(c == tostring(100*ni, len(c))) call CO_MAX(c,1) call CO_MAX(ca) + CHECK_ASSERT(all(ca == tostring(100*ni, len(c)))) call CO_MAX(ca,1) # endif # if HAVE_CO_BROADCAST - call status("Testing CO_BROADCAST...") + STATUS("Testing CO_BROADCAST...") + i = me*1000 + ia = i call CO_BROADCAST(i,1) + CHECK_VALI(i,1000) call CO_BROADCAST(ia,1) + CHECK_ASSERT(all(ia == 1000)) + c = "hello" + ca = c call CO_BROADCAST(c,1) + CHECK_ASSERT(c == 'hello') call CO_BROADCAST(ca,1) + CHECK_ASSERT(all(ca == 'hello')) # endif # if HAVE_TEAM_TYPE CHECK_TYPE_COMPLIANCE(TEAM_TYPE, default_team, .true., 0) # endif -# if HAVE_TEAM_QUERIES - call status("Testing team queries...") +# if HAVE_GET_TEAM + STATUS("Testing GET_TEAM...") subteam = GET_TEAM(CURRENT_TEAM) subteam = GET_TEAM(INITIAL_TEAM) subteam = GET_TEAM() - write(*,'(A,I3)') "Initial team number is ", TEAM_NUMBER() +# endif +# if HAVE_TEAM_NUMBER + STATUS("Testing TEAM_NUMBER...") + CHECK_VALI(TEAM_NUMBER(), -1) # endif # if HAVE_FORM_TEAM - call status("Testing FORM TEAM...") + STATUS("Testing FORM TEAM...") team_id = merge(1, 2, me <= (ni+1)/2) FORM TEAM(team_id, subteam) # endif # if HAVE_SYNC_TEAM - call status("Testing SYNC TEAM...") + STATUS("Testing SYNC TEAM...") SYNC TEAM(subteam) # endif # if HAVE_CHANGE_TEAM - call status("Testing CHANGE TEAM...") + STATUS("Testing CHANGE TEAM...") CHANGE TEAM(subteam) - write(*,'(A,I3,A,I3,A,I3)') 'Inside CHANGE TEAM construct: ', THIS_IMAGE(), ' of ', NUM_IMAGES(), ' in team number ', TEAM_NUMBER() + write(*,'(I3,A,I3,A,I3,A,I3)') me, ': Inside CHANGE TEAM construct: ', THIS_IMAGE(), ' of ', NUM_IMAGES(), ' in team number ', team_id +# if !(__flang_major__ == 22 && __flang_minor__ == 1 && __flang_patchlevel__ < 3) /* avoid llvm #171048 */ + CHECK_ASSERT(THIS_IMAGE() >= 1) + CHECK_ASSERT(THIS_IMAGE() <= NUM_IMAGES()) + CHECK_ASSERT(NUM_IMAGES() <= (ni+1)/2) +# if HAVE_TEAM_NUMBER + CHECK_VALI(TEAM_NUMBER(), team_id) +# endif +# if HAVE_THIS_IMAGE_TEAM + CHECK_VALI(THIS_IMAGE(subteam),THIS_IMAGE()) +# if HAVE_GET_TEAM + CHECK_VALI(THIS_IMAGE(GET_TEAM()),THIS_IMAGE()) + CHECK_VALI(THIS_IMAGE(TEAM=GET_TEAM(INITIAL_TEAM)),me) +# endif +# endif +# if HAVE_NUM_IMAGES_TEAM + CHECK_VALI(NUM_IMAGES(subteam),NUM_IMAGES()) +# if HAVE_GET_TEAM + CHECK_VALI(NUM_IMAGES(GET_TEAM()),NUM_IMAGES()) + CHECK_VALI(NUM_IMAGES(TEAM=GET_TEAM(INITIAL_TEAM)),ni) +# endif +# endif +# if HAVE_TEAM_NUMBER_TEAM + CHECK_VALI(TEAM_NUMBER(subteam),team_id) +# if HAVE_GET_TEAM + CHECK_VALI(TEAM_NUMBER(GET_TEAM()),team_id) + CHECK_VALI(TEAM_NUMBER(TEAM=GET_TEAM(INITIAL_TEAM)),-1) +# endif +# endif +# endif END TEAM call sync_all - write(*,'(A,I3)') "After END TEAM statement, TEAM_NUMBER() is ", TEAM_NUMBER() +# if HAVE_TEAM_NUMBER + CHECK_VALI(TEAM_NUMBER(), -1) +# endif # endif # if HAVE_MAIN_COARRAY # if HAVE_COARRAY_INIT - call status("Testing main program coarray initialization...") + STATUS("Testing main program coarray initialization...") CHECK_VALI(sca_int_1, COARRAY_INT_INIT_VALUE) CHECK_VALI(sca_int_2, COARRAY_INT_INIT_VALUE) CHECK_VALI(sca_int_3, COARRAY_INT_INIT_VALUE) # endif # if HAVE_COBOUND - call status("Testing LCOBOUND/UCOBOUND...") + 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 + block + integer :: co3(3) + integer(int64) :: co3_64(3) + CHECK_ASSERT(all(LCOBOUND(sca_int_3) == 1)) + CHECK_ASSERT(all(LCOBOUND(sca_int_3, kind=int64) == 1_int64)) + co3 = UCOBOUND(sca_int_3) + co3_64 = UCOBOUND(sca_int_3, kind=int64) + CHECK_ASSERT(all(co3(1:2) == [2,3])) + CHECK_ASSERT(co3(3) >= 1) + CHECK_ASSERT(all(co3_64(1:2) == [2_int64,3_int64])) + CHECK_ASSERT(co3_64(3) >= 1_int64) + end block + CHECK_VALI(LCOBOUND(sca_int_2, dim=1), 1) + CHECK_VALI(UCOBOUND(sca_int_2, dim=1), 2) + CHECK_VALI(LCOBOUND(sca_int_3, dim=1), 1) + CHECK_VALI(LCOBOUND(sca_int_3, dim=2), 1) + CHECK_VALI(LCOBOUND(sca_int_3, dim=3), 1) + CHECK_VALI(UCOBOUND(sca_int_3, dim=1), 2) + CHECK_VALI(UCOBOUND(sca_int_3, dim=2), 3) + CHECK_VALI64(LCOBOUND(sca_int_3, dim=2, kind=int64), 1) + CHECK_VALI64(UCOBOUND(sca_int_3, dim=2, kind=int64), 3) # endif # if HAVE_COSHAPE - call status("Testing COSHAPE...") + 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 + block + integer :: co3(3) + integer(int64) :: co3_64(3) + co3 = COSHAPE(sca_int_3) + co3_64 = COSHAPE(sca_int_3, kind=int64) + CHECK_ASSERT(all(co3(1:2) == [2,3])) + CHECK_ASSERT(co3(3) >= 1) + CHECK_ASSERT(all(co3_64(1:2) == [2_int64,3_int64])) + CHECK_ASSERT(co3_64(3) >= 1_int64) + end block # 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()) + STATUS("Testing IMAGE_INDEX...") + CHECK_VALI(IMAGE_INDEX(sca_int_1, [1]), 1) + CHECK_VALI(IMAGE_INDEX(sca_int_1, [ni]), ni) + CHECK_VALI(IMAGE_INDEX(sca_int_2, [1,1]), 1) + CHECK_VALI(IMAGE_INDEX(sca_int_3, [1,1,1]), 1) +# if HAVE_TEAM +# if HAVE_IMAGE_INDEX_TEAM_NUMBER + CHECK_VALI(IMAGE_INDEX(sca_int_1, [1], team_number=-1), 1) + CHECK_VALI(IMAGE_INDEX(sca_int_1, [ni], team_number=-1), ni) + CHECK_VALI(IMAGE_INDEX(sca_int_2, [1,1], team_number=-1), 1) + CHECK_VALI(IMAGE_INDEX(sca_int_3, [1,1,1], team_number=-1), 1) +# endif +# if HAVE_IMAGE_INDEX_TEAM && HAVE_GET_TEAM + ! affected by llvm-project issue #205953 + CHECK_VALI(IMAGE_INDEX(sca_int_1, [1], GET_TEAM()), 1) +# ifndef __GFORTRAN__ + ! ICE's gfortran 16: + CHECK_VALI(IMAGE_INDEX(sca_int_1, [ni], GET_TEAM()), ni) +# endif + CHECK_VALI(IMAGE_INDEX(sca_int_2, [1,1], GET_TEAM()), 1) + CHECK_VALI(IMAGE_INDEX(sca_int_3, [1,1,1], GET_TEAM()), 1) +# endif # endif - end if # endif # if HAVE_THIS_IMAGE_COARRAY - call status("Testing THIS_IMAGE(coarray)...") + STATUS("Testing THIS_IMAGE(coarray)...") if (THIS_IMAGE() == NUM_IMAGES()) 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) + write(*,'(I3,A,I3)') me, ": this_image(sca_int_1) = ", THIS_IMAGE(sca_int_1) + write(*,'(I3,A,2I3)') me, ": this_image(sca_int_2) = ", THIS_IMAGE(sca_int_2) + write(*,'(I3,A,3I3)') me, ": this_image(sca_int_3) = ", THIS_IMAGE(sca_int_3) + end if + CHECK_VALI(element(THIS_IMAGE(sca_int_1),1), THIS_IMAGE()) + CHECK_VALI(THIS_IMAGE(sca_int_3, dim=1), element(THIS_IMAGE(sca_int_3),1)) + CHECK_VALI(THIS_IMAGE(sca_int_3, dim=2), element(THIS_IMAGE(sca_int_3),2)) + CHECK_VALI(THIS_IMAGE(sca_int_3, dim=3), element(THIS_IMAGE(sca_int_3),3)) + if (THIS_IMAGE() == 1) then + CHECK_ASSERT(all(THIS_IMAGE(sca_int_2) == 1)) + CHECK_ASSERT(all(THIS_IMAGE(sca_int_3) == 1)) + else + CHECK_ASSERT(all(THIS_IMAGE(sca_int_2) >= 1)) + CHECK_ASSERT(all(THIS_IMAGE(sca_int_3) >= 1)) + CHECK_ASSERT(any(THIS_IMAGE(sca_int_2) > 1)) + CHECK_ASSERT(any(THIS_IMAGE(sca_int_3) > 1)) end if # endif # if HAVE_PUTGET_INTRINSIC_SCALAR - call status("Testing put/get intrinsic scalar...") + STATUS("Testing put/get intrinsic scalar...") sca_int_1 = THIS_IMAGE() call sync_all i = sca_int_1[peer] ! get @@ -476,13 +685,39 @@ program native_multi_image end if # endif # endif +# if HAVE_MAIN_COARRAY_ARRAY +# if HAVE_COARRAY_INIT + STATUS("Testing main program array coarray initialization...") + CHECK_VALI(sca_int100_1(3), COARRAY_INT_INIT_VALUE) + CHECK_VALI(sca_int100_2(4), COARRAY_INT_INIT_VALUE) + CHECK_VALI(sca_int100_3(5), COARRAY_INT_INIT_VALUE) +# endif +# if HAVE_PUTGET_INTRINSIC_ARRAY_CONTIG + STATUS("Testing put/get intrinsic array (contiguous)...") + sca_int100_1 = THIS_IMAGE() + call sync_all + ia = sca_int100_1(10:12)[peer] ! get + if (any(ia /= peer)) then + write(*,'(A,3I0,A,I3)') "FAIL: get sca_int100_1[peer] = ", ia, " expected = ", peer + fail_count = fail_count + 1 + end if + call sync_all + sca_int100_1(20:22)[peer] = THIS_IMAGE() ! put + call sync_all + ia = sca_int100_1(20:22) + if (any(ia /= peer)) then + write(*,'(A,3I0,A,I3)') "FAIL: put to sca_int100_1 = ", ia, " expected = ", peer + fail_count = fail_count + 1 + end if +# endif +# endif # if HAVE_EVENT_TYPE CHECK_TYPE_COMPLIANCE(EVENT_TYPE, default_event, .false., 64) # endif # if HAVE_EVENT_QUERY - call status("Testing event_query...") + STATUS("Testing event_query...") i = 666 call EVENT_QUERY(test_event, i) if (i /= 0) then @@ -492,7 +727,7 @@ program native_multi_image # endif # if HAVE_EVENT_POST_WAIT - call status("Testing event post / event wait...") + STATUS("Testing event post / event wait...") if (THIS_IMAGE() == 1) then !event post (test_event) ! currently broken event post (test_event[1]) @@ -510,6 +745,30 @@ program native_multi_image CHECK_TYPE_COMPLIANCE(NOTIFY_TYPE, default_notify, .false., 64) # endif +# if HAVE_ALLOC_COARRAY + STATUS("Testing coarray allocation...") + CHECK_VALL(ALLOCATED(aca_int_1), .false.) + CHECK_VALL(ALLOCATED(aca_int_2), .false.) + CHECK_VALL(ALLOCATED(aca_int_3), .false.) + + allocate(aca_int_1[*]) + CHECK_VALL(ALLOCATED(aca_int_1), .true.) + + allocate(aca_int_2[10:11,*], aca_int_3[100:101,200:202,*]) + CHECK_VALL(ALLOCATED(aca_int_2), .true.) + CHECK_VALL(ALLOCATED(aca_int_3), .true.) + +# if HAVE_ALLOC_COARRAY_DEALLOC + STATUS("Testing coarray deallocation...") + deallocate(aca_int_1) + CHECK_VALL(ALLOCATED(aca_int_1), .false.) + + deallocate(aca_int_2, aca_int_3) + CHECK_VALL(ALLOCATED(aca_int_2), .false.) + CHECK_VALL(ALLOCATED(aca_int_3), .false.) +# endif +# endif + call sync_all call test_allocatable_coarray call test_allocatable_coarray @@ -527,61 +786,48 @@ program native_multi_image end if call sync_all - write(*,'(A,I1,A,I1,A)') "Goodbye from image ", me, " of ", ni, " images" + write(*,'(A,I0,A,I0,A)') "Goodbye from image ", me, " of ", ni, " images" ! explicit flush for now until we have multi-image stop support call flush_all call sync_all if (fail_count > 0) then - call status("ERROR: "//tostring(fail_count)//" tests FAILED.") + STATUS("ERROR: "//tostring(fail_count)//" tests FAILED.") else - call status("All tests passed.") + STATUS("All tests passed.") end if #if IGNORE_FAILURES - call status("WARNING: Ignoring "//tostring(IGNORE_FAILURES)//" failures.") + STATUS("WARNING: Ignoring "//tostring(IGNORE_FAILURES)//" failures.") fail_count = MAX(0, fail_count - IGNORE_FAILURES) #endif stop fail_count contains subroutine test_allocatable_coarray() -# if HAVE_ALLOC_COARRAY -# define CHECK_ALLOC(coarray, expect) \ - 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 - +# if HAVE_ALLOC_COARRAY_CLEANUP 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...") + STATUS("Testing ALLOCATABLE coarray cleanup...") end if -# if VERBOSE +# 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, .not. once) +# endif + CHECK_VALL(ALLOCATED(aca_int_1), .false.) + CHECK_VALL(ALLOCATED(aca_int_2), .false.) + CHECK_VALL(ALLOCATED(aca_int_3), .not. once) if (once) then ALLOCATE(aca_int_1[*]) ALLOCATE(aca_int_2[2,*]) ALLOCATE(aca_int_3[2,3,*]) - CHECK_ALLOC(aca_int_1, .true.) - CHECK_ALLOC(aca_int_2, .true.) - CHECK_ALLOC(aca_int_3, .true.) + CHECK_VALL(ALLOCATED(aca_int_1), .true.) + CHECK_VALL(ALLOCATED(aca_int_2), .true.) + CHECK_VALL(ALLOCATED(aca_int_3), .true.) end if # if VERBOSE if (THIS_IMAGE() == 1) & @@ -603,10 +849,13 @@ subroutine check_type(type_name, is_team, min_size, subject_size, default_bytes) integer, parameter :: reference_size = storage_size(dummy_team_type_var)/8 # endif - call status("Testing " // type_name // "...") + STATUS("Testing " // type_name // "...") if (subject_size /= size(default_bytes)) ERROR STOP "INTERNAL ERROR: representation size mismatch" + if (TYPES_PRIF_COMPLIANT == 0) then + STATUS(" (validation skipped)") + else if (is_team) then # if HAVE_TEAM_TYPE ! check size, should be an exact match @@ -616,7 +865,7 @@ subroutine check_type(type_name, is_team, min_size, subject_size, default_bytes) diag = "FAIL (should be exactly " // tostring(reference_size) // " bytes)" fail_count = fail_count + 1 end if - call status(" Size of " // type_name // ": " // tostring(subject_size) // " bytes ==> " // diag) + STATUS(" Size of " // type_name // ": " // tostring(subject_size) // " bytes ==> " // diag) ! check default initialization dummy_team_type_var = transfer(team_var, dummy_team_type_var) @@ -626,7 +875,7 @@ subroutine check_type(type_name, is_team, min_size, subject_size, default_bytes) diag = "FAIL (not default-initialized to null(): " // hexdump(default_bytes)// ")" fail_count = fail_count + 1 end if - call status(" Default init of " // type_name // " ==> " // diag) + STATUS(" Default init of " // type_name // " ==> " // diag) # endif else # if TYPES_IMPORT_PRIF @@ -640,7 +889,7 @@ subroutine check_type(type_name, is_team, min_size, subject_size, default_bytes) fail_count = fail_count + 1 end if # endif - call status(" Size of " // type_name // ": " // tostring(subject_size) // " bytes ==> " // diag) + STATUS(" Size of " // type_name // ": " // tostring(subject_size) // " bytes ==> " // diag) ! check default initialization if (all(default_bytes == 0)) then @@ -650,8 +899,9 @@ subroutine check_type(type_name, is_team, min_size, subject_size, default_bytes) hexdump(default_bytes) // ")" fail_count = fail_count + 1 end if - call status(" Default init of " // type_name // " ==> " // diag) + STATUS(" Default init of " // type_name // " ==> " // diag) end if + end if end subroutine end program #else diff --git a/app/print-native-flags.F90 b/app/print-native-flags.F90 new file mode 100644 index 00000000..1480b470 --- /dev/null +++ b/app/print-native-flags.F90 @@ -0,0 +1,181 @@ +program print_native_flags + use iso_fortran_env, only: COMPILER_VERSION, COMPILER_OPTIONS + implicit none + + character(:), allocatable :: flags + logical :: stand_alone + +#if VERBOSE + write(error_unit,'(A,A)') "COMPILER_VERSION=", COMPILER_VERSION() + write(error_unit,'(A,A)') "COMPILER_OPTIONS=", COMPILER_OPTIONS() +#endif + + stand_alone = COMMAND_ARGUMENT_COUNT() > 0 + + call write_flags + +contains +subroutine write_flags +#if __flang__ +# if __flang_major__ == 22 + call set("-fcoarray") + + call no("COARRAY") + + ! issue #205953 + call no("NUM_IMAGES_TEAM") + call no("THIS_IMAGE_TEAM") + call no("TEAM_NUMBER_TEAM") + + call yes("EVENT_TYPE") + call yes("LOCK_TYPE") + call yes("NOTIFY_TYPE") + + call set("-DIGNORE_FAILURES=8") ! type checks for event, notify, lock, team +# elif __flang_major__ == 23 + call set("-fcoarray") + + call no("COARRAY_INIT") + call no("COARRAY_LOCAL_ACCESS") + call no("PUTGET") + + call no("EVENT") + call yes("EVENT_TYPE") + call no("LOCK") + call yes("LOCK_TYPE") + call no("NOTIFY") + call yes("NOTIFY_TYPE") + + call set("-DIGNORE_FAILURES=6") ! type checks for event, notify, lock +# elif __flang_major__ >= 24 + call set("-fcoarray") + + call no("COARRAY_INIT") + call no("COARRAY_LOCAL_ACCESS") + call no("PUTGET") + + call no("EVENT") + call yes("EVENT_TYPE") + call no("LOCK") + call yes("LOCK_TYPE") + call no("NOTIFY") + call yes("NOTIFY_TYPE") + + call set("-DIGNORE_FAILURES=6") ! type checks for event, notify, lock +# endif +#elif __LFORTRAN__ +# if __LFORTRAN_MAJOR__ == 0 && __LFORTRAN_MINOR__ <= 63 + ! no multi-image support +# elif __LFORTRAN_MAJOR__ > 0 || \ + (__LFORTRAN_MAJOR__ == 0 && __LFORTRAN_MINOR__ >= 64 ) + if (INDEX(COMPILER_VERSION(), 'version 0.64') /= 0 .and. & + INDEX(COMPILER_VERSION(), '-g') == 0) then + ! LFortran release 0.64 + call set("--coarray=true") + + call no("TEAM") + + call no("ALLOC_COARRAY") + call no("COARRAY_QUERY") + call no("PUTGET_INTRINSIC_ARRAY_CONTIG") + + call no("EVENT") + call no("LOCK") + call no("NOTIFY") + else + ! LFortran git snapshot or newer, assume latest we know about + call set("--coarray=true") + + call no("GET_TEAM") + call no("NUM_IMAGES_TEAM") + call no("THIS_IMAGE_TEAM") + call no("TEAM_NUMBER") + + call no("ALLOC_COARRAY_CLEANUP") + call no("IMAGE_INDEX") + call no("THIS_IMAGE_COARRAY") + call no("PUTGET_INTRINSIC_ARRAY_CONTIG") + + call no("EVENT") + call no("LOCK") + call no("NOTIFY") + end if +# endif +#elif NAGFOR + if (.not. stand_alone) return +# if __NAG_COMPILER_RELEASE >= 72 + ! __NAG_COMPILER_BUILD contains build number + !call set("-coarray=cosmp") + call set("-DTYPES_PRIF_COMPLIANT=0") + + call no("NOTIFY") ! missing F2023 feature +# endif +#elif __GFORTRAN__ + if (.not. stand_alone) return +# if __GNUC__ >= 16 + !call set("-fcoarray=lib") + call set("-DTYPES_PRIF_COMPLIANT=0") + + call no("NOTIFY") ! missing F2023 feature + call no("IMAGE_INDEX_TEAM_NUMBER") ! https://gcc.gnu.org/bugzilla/show_bug.cgi?id=126777 + call no("NUM_IMAGES_TEAM") ! https://gcc.gnu.org/bugzilla/show_bug.cgi?id=126781 + call no("CO_MIN") ! https://gcc.gnu.org/bugzilla/show_bug.cgi?id=126776 + call no("CO_MAX") ! CO_MIN/CO_MAX(character) runtime crash +# endif +#elif _CRAYFTN + if (.not. stand_alone) return + ! More details in _RELEASE_MINOR, _RELEASE_PATCHLEVEL, _RELEASE_STRING +# if _RELEASE_MAJOR >= 18 + !call set("-hcaf") +# if _RELEASE_MAJOR < 19 + call no("NOTIFY") ! missing F2023 feature +# endif + call set("-DTYPES_PRIF_COMPLIANT=0") + call no("COSHAPE") ! missing F2018 feature + call set("-DIGNORE_FAILURES=2") ! CO_MIN(character) get wrong answer with > 9 images +# endif +#elif __INTEL_COMPILER + if (.not. stand_alone) return +# if __INTEL_COMPILER >= 20250302 + !call set("-coarray") + call set("-DTYPES_PRIF_COMPLIANT=0") + + call no("NOTIFY") ! missing F2023 feature + call no("FORM_TEAM") ! runtime errors on FORM TEAM + call no("CHANGE_TEAM") ! runtime errors on FORM TEAM + call no("TEAM_TYPE") ! avoid runtime errors from CHECK_TYPE_COMPLIANCE + call set("-DIGNORE_FAILURES=4") ! CO_MIN/CO_MAX(character) get the wrong answer at runtime (no change) +# endif +#endif + + if (allocated(flags)) write(*,'(A)') flags +end subroutine +subroutine yes(flag) + character(*), intent(in) :: flag + call define(flag, .true.) +end subroutine +subroutine no(flag) + character(*), intent(in) :: flag + call define(flag, .false.) +end subroutine +subroutine define(flag,val) + character(*), intent(in) :: flag + logical, intent(in) :: val + character(:), allocatable :: tmp + if (INDEX(flag,"HAVE") > 0 .or. INDEX(flag,"-D") > 0) error stop flag + allocate(character(0) :: tmp) + tmp = "-DHAVE_" + tmp = tmp // flag + if (.not. val) tmp = tmp // "=0" + call set(tmp) +end subroutine +subroutine set(flag) + character(*), intent(in) :: flag + if (.not. allocated(flags)) then + allocate(character(0) :: flags) + flags = "-DHAVE_MULTI_IMAGE" + end if + flags = flags // " " // flag +end subroutine + +end program diff --git a/install.sh b/install.sh index e9a256d5..6ee507d3 100755 --- a/install.sh +++ b/install.sh @@ -571,7 +571,9 @@ cat << EOF > $RUN_FPM_SH FPM="${FPM}" FC="`$PKG_CONFIG caffeine --variable=CAFFEINE_FPM_FC`" CC="`$PKG_CONFIG caffeine --variable=CAFFEINE_FPM_CC`" -FFLAGS="$compiler_flag" +NATIVEFLAGS="" +RAWFLAGS="$compiler_flag" +FFLAGS="\$NATIVEFLAGS \$RAWFLAGS" CFLAGS="`$PKG_CONFIG caffeine --variable=CAFFEINE_FPM_CFLAGS`" LDFLAGS="`$PKG_CONFIG caffeine --variable=CAFFEINE_FPM_LDFLAGS`" FPM_DRIVER=\${FPM_DRIVER:-\`realpath \$0\`} @@ -595,6 +597,15 @@ elif echo "build test run install" | grep -w -q -e "\$fpm_sub_cmd" ; then --c-flag "\$CFLAGS" \\ --link-flag "\$LDFLAGS" \\ "\$@" +elif echo "set-native" | grep -w -q -e "\$fpm_sub_cmd" ; then + set -e + cmd="\$FC \$RAWFLAGS app/print-native-flags.F90 -o build/print-native-flags $APPEND_LDFLAGS" + eval \$cmd || (set -x ; eval \$cmd) + NATIVEFLAGS="\`build/print-native-flags\`" + rm -f build/print-native-flags + sed -i.bak 's/^NATIVEFLAGS=.*\$/NATIVEFLAGS="'"\$NATIVEFLAGS"'"/' \$FPM_DRIVER + rm -f \$FPM_DRIVER.bak + echo NATIVEFLAGS=\"\$NATIVEFLAGS\" elif echo "info" | grep -w -q -e "\$fpm_sub_cmd" ; then LINE=-------------------------------------------------- SRCDIR=\$(dirname \$FPM_DRIVER) @@ -656,6 +667,8 @@ chmod u+x $RUN_FPM_SH # for backwards-compatibility of instructions/scripting: ( cd build && ln -f -s ../$RUN_FPM_SH run-fpm.sh ) +./$RUN_FPM_SH set-native + ./$RUN_FPM_SH build $VERBOSE || \ ( set +x echo "Defect reporting information:" diff --git a/manifest/fpm.toml.template b/manifest/fpm.toml.template index 3dd2af8a..0a4b8828 100644 --- a/manifest/fpm.toml.template +++ b/manifest/fpm.toml.template @@ -12,4 +12,10 @@ julienne = {git = "https://github.com/berkeleylab/julienne.git", tag = "4.1.0"} [install] library = true +[[executable]] +name = "native-multi-image" +source-dir = "app" +main = "native-multi-image.F90" + [build] +auto-executables = false