From da34485b98ee55bcede181e89ec1637992c99237 Mon Sep 17 00:00:00 2001 From: Willem Deconinck Date: Fri, 7 Nov 2025 14:33:41 +0000 Subject: [PATCH 1/3] [fctest] Fix wrong inline initialisation --- src/fckit/fctest.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/fckit/fctest.F90 b/src/fckit/fctest.F90 index 79cb723..6519ce7 100644 --- a/src/fckit/fctest.F90 +++ b/src/fckit/fctest.F90 @@ -149,8 +149,9 @@ subroutine fctest_check_equal_string(V1,V2,line) subroutine fctest_check_equal_int32_r1(V1,V2,line) integer(c_int32_t), intent(in) :: V1(:), V2(:) integer(c_int32_t), intent(in) :: line - logical :: compare = .True. + logical :: compare integer(c_int32_t) :: j + compare = .True. if( size(V1) /= size(V2) ) compare = .False. if( compare .eqv. .True. ) then do j=1,size(V1) @@ -169,8 +170,9 @@ subroutine fctest_check_equal_int32_r1(V1,V2,line) subroutine fctest_check_equal_int64_r1(V1,V2,line) integer(c_int64_t), intent(in) :: V1(:), V2(:) integer(c_int32_t), intent(in) :: line - logical :: compare = .True. + logical :: compare integer(c_int32_t) :: j + compare = .True. if( size(V1) /= size(V2) ) compare = .False. if( compare .eqv. .True. ) then do j=1,size(V1) From 58e60d535fe352be215af2e7b784e45bf8ac28b3 Mon Sep 17 00:00:00 2001 From: Willem Deconinck Date: Thu, 13 Nov 2025 13:16:14 +0000 Subject: [PATCH 2/3] [fctest] Add capability to inspect and ignore last check --- src/fckit/fctest.F90 | 61 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 61 insertions(+) diff --git a/src/fckit/fctest.F90 b/src/fckit/fctest.F90 index 6519ce7..68f3d31 100644 --- a/src/fckit/fctest.F90 +++ b/src/fckit/fctest.F90 @@ -14,6 +14,8 @@ module fctest public character(len=1024) :: source_file integer(c_int32_t) :: exit_status + integer(c_int32_t) :: exit_status_before_check + integer(c_int32_t) :: check_status interface FCE module procedure fctest_check_equal_int32 module procedure fctest_check_equal_int64_int32 @@ -61,15 +63,29 @@ end function sweep_leading_blanks subroutine fctest_error(line) integer(c_int32_t), intent(in) :: line write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line))) + exit_status_before_check=exit_status + check_status=1 exit_status=1 end subroutine +function fctest_last_check_failed() + logical :: fctest_last_check_failed + fctest_last_check_failed = (check_status /= 0) +end function + +subroutine fctest_ignore_last_check() + exit_status=exit_status_before_check +end subroutine + subroutine fctest_check_equal_int32(V1,V2,line) integer(c_int32_t), intent(in) :: V1, V2 integer(c_int32_t), intent(in) :: line + exit_status_before_check=exit_status + check_status=0 if(V1/=V2) then write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line))) write(0,*) "--> [",V1,"!=",V2,"]" + check_status=1 exit_status=1 endif end subroutine @@ -77,9 +93,12 @@ subroutine fctest_check_equal_int32(V1,V2,line) subroutine fctest_check_equal_int64(V1,V2,line) integer(c_int64_t), intent(in) :: V1, V2 integer(c_int32_t), intent(in) :: line + exit_status_before_check=exit_status + check_status=0 if(V1/=V2) then write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line))) write(0,*) "--> [",V1,"!=",V2,"]" + check_status=1 exit_status=1 endif end subroutine @@ -88,9 +107,12 @@ subroutine fctest_check_equal_int64_int32(V1,V2,line) integer(c_int64_t), intent(in) :: V1 integer(c_int32_t), intent(in) :: V2 integer(c_int32_t), intent(in) :: line + exit_status_before_check=exit_status + check_status=0 if(V1/=V2) then write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line))) write(0,*) "--> [",V1,"!=",V2,"]" + check_status=1 exit_status=1 endif end subroutine @@ -99,9 +121,12 @@ subroutine fctest_check_equal_int32_int64(V1,V2,line) integer(c_int32_t), intent(in) :: V1 integer(c_int64_t), intent(in) :: V2 integer(c_int32_t), intent(in) :: line + exit_status_before_check=exit_status + check_status=0 if(V1/=V2) then write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line))) write(0,*) "--> [",V1,"!=",V2,"]" + check_status=1 exit_status=1 endif end subroutine @@ -109,9 +134,12 @@ subroutine fctest_check_equal_int32_int64(V1,V2,line) subroutine fctest_check_equal_real32(V1,V2,line) real(kind=c_float), intent(in) :: V1, V2 integer(c_int32_t), intent(in) :: line + exit_status_before_check=exit_status + check_status=0 if(V1/=V2) then write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line))) write(0,*) "--> [",V1,"!=",V2,"]" + check_status=1 exit_status=1 endif end subroutine @@ -119,9 +147,12 @@ subroutine fctest_check_equal_real32(V1,V2,line) subroutine fctest_check_equal_real64(V1,V2,line) real(kind=c_double), intent(in) :: V1, V2 integer(c_int32_t), intent(in) :: line + exit_status_before_check=exit_status + check_status=0 if(V1/=V2) then write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line))) write(0,*) "--> [",V1,"!=",V2,"]" + check_status=1 exit_status=1 endif end subroutine @@ -129,9 +160,12 @@ subroutine fctest_check_equal_real64(V1,V2,line) subroutine fctest_check_equal_logical(V1,V2,line) logical, intent(in) :: V1, V2 integer(c_int32_t), intent(in) :: line + exit_status_before_check=exit_status + check_status=0 if(V1.neqv.V2) then write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line))) write(0,*) "--> [",V1,"!=",V2,"]" + check_status=1 exit_status=1 endif end subroutine @@ -139,9 +173,12 @@ subroutine fctest_check_equal_logical(V1,V2,line) subroutine fctest_check_equal_string(V1,V2,line) character(kind=c_char,len=*), intent(in) :: V1, V2 integer(c_int32_t), intent(in) :: line + exit_status_before_check=exit_status + check_status=0 if(V1/=V2) then write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line))) write(0,*) "--> [",V1,"!=",V2,"]" + check_status=1 exit_status=1 endif end subroutine @@ -151,6 +188,8 @@ subroutine fctest_check_equal_int32_r1(V1,V2,line) integer(c_int32_t), intent(in) :: line logical :: compare integer(c_int32_t) :: j + exit_status_before_check=exit_status + check_status=0 compare = .True. if( size(V1) /= size(V2) ) compare = .False. if( compare .eqv. .True. ) then @@ -163,6 +202,7 @@ subroutine fctest_check_equal_int32_r1(V1,V2,line) if( size(V1) <= 30 ) then write(0,*) "--> [ ",V1," ] != [ ",V2," ] " endif + check_status=1 exit_status=1 endif end subroutine @@ -172,6 +212,8 @@ subroutine fctest_check_equal_int64_r1(V1,V2,line) integer(c_int32_t), intent(in) :: line logical :: compare integer(c_int32_t) :: j + exit_status_before_check=exit_status + check_status=0 compare = .True. if( size(V1) /= size(V2) ) compare = .False. if( compare .eqv. .True. ) then @@ -184,6 +226,7 @@ subroutine fctest_check_equal_int64_r1(V1,V2,line) if( size(V1) <= 30 ) then write(0,*) "--> [ ",V1," ] != [ ",V2," ]" endif + check_status=1 exit_status=1 endif end subroutine @@ -193,6 +236,8 @@ subroutine fctest_check_equal_real32_r1(V1,V2,line) integer(c_int32_t), intent(in) :: line logical :: compare integer(c_int32_t) :: j + exit_status_before_check=exit_status + check_status=0 compare = .True. if( size(V1) /= size(V2) ) compare = .False. if( compare .eqv. .True. ) then @@ -205,6 +250,7 @@ subroutine fctest_check_equal_real32_r1(V1,V2,line) if( size(V1) <= 30 ) then write(0,*) "--> [ ",V1," ] != [ ",V2," ]" endif + check_status=1 exit_status=1 endif end subroutine @@ -214,6 +260,8 @@ subroutine fctest_check_equal_real64_r1(V1,V2,line) integer(c_int32_t), intent(in) :: line logical :: compare integer(c_int32_t) :: j + exit_status_before_check=exit_status + check_status=0 compare = .True. if( size(V1) /= size(V2) ) compare = .False. if( compare .eqv. .True. ) then @@ -226,6 +274,7 @@ subroutine fctest_check_equal_real64_r1(V1,V2,line) if( size(V1) <= 30 ) then write(0,*) "--> [ ",V1," ] != [ ",V2," ]" endif + check_status=1 exit_status=1 endif end subroutine @@ -233,9 +282,12 @@ subroutine fctest_check_equal_real64_r1(V1,V2,line) subroutine fctest_check_close_real32(V1,V2,TOL,line) real(kind=c_float), intent(in) :: V1, V2, TOL integer(c_int32_t), intent(in) :: line + exit_status_before_check=exit_status + check_status=0 if(.not.(abs(V1-V2)<=TOL)) then; write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line))) write(0,*) "--> [",V1,"!=",V2,"]" + check_status=1 exit_status=1 endif end subroutine @@ -243,9 +295,12 @@ subroutine fctest_check_close_real32(V1,V2,TOL,line) subroutine fctest_check_close_real64(V1,V2,TOL,line) real(kind=c_double), intent(in) :: V1, V2, TOL integer(c_int32_t), intent(in) :: line + exit_status_before_check=exit_status + check_status=0 if(.not.(abs(V1-V2)<=TOL)) then; write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line))) write(0,*) "--> [",V1,"!=",V2,"]" + check_status=1 exit_status=1 endif end subroutine @@ -256,6 +311,8 @@ subroutine fctest_check_close_real32_r1(V1,V2,TOL,line) integer(c_int32_t), intent(in) :: line logical :: compare integer(c_int32_t) :: j + exit_status_before_check=exit_status + check_status=0 compare = .True. if( size(V1) /= size(V2) ) compare = .False. if( compare .eqv. .True. ) then @@ -268,6 +325,7 @@ subroutine fctest_check_close_real32_r1(V1,V2,TOL,line) if( size(V1) <= 30 ) then write(0,*) "--> [ ",V1," ] != [ ",V2," ]" endif + check_status=1 exit_status=1 endif end subroutine @@ -278,6 +336,8 @@ subroutine fctest_check_close_real64_r1(V1,V2,TOL,line) integer(c_int32_t), intent(in) :: line logical :: compare integer(c_int32_t) :: j + exit_status_before_check=exit_status + check_status=0 compare = .True. if( size(V1) /= size(V2) ) compare = .False. if( compare .eqv. .True. ) then @@ -290,6 +350,7 @@ subroutine fctest_check_close_real64_r1(V1,V2,TOL,line) if( size(V1) <= 30 ) then write(0,*) "--> [ ",V1," ] != [ ",V2," ]" endif + check_status=1 exit_status=1 endif end subroutine From 55d0afc12d2fe6851cb3e4b7277740feaedcdd1c Mon Sep 17 00:00:00 2001 From: Willem Deconinck Date: Thu, 6 Nov 2025 12:30:23 +0000 Subject: [PATCH 3/3] Fix array_strides with nvhpc; Note: not working on Linux_aarch64 --- CMakeLists.txt | 10 ++++++++ src/fckit/CMakeLists.txt | 3 +++ src/fckit/module/fckit_array.F90 | 40 ++++++++++++++++---------------- src/tests/CMakeLists.txt | 1 + src/tests/test_array.F90 | 26 ++++++++++++++++++++- 5 files changed, 59 insertions(+), 21 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index dddf126..ef17e67 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -29,6 +29,7 @@ ecbuild_check_fortran( FEATURES finalization ) set( FEATURE_FINAL_DEFAULT ON ) set( PGIBUG_ATLAS_197 0 ) +set( HAVE_NOREPACK 1 ) if( CMAKE_Fortran_COMPILER_ID MATCHES "PGI|NVHPC" ) if( ${CMAKE_Fortran_COMPILER_VERSION} VERSION_LESS 19.4 ) set( PGIBUG_ATLAS_197 1 ) @@ -40,6 +41,15 @@ if( CMAKE_Fortran_COMPILER_ID MATCHES "PGI|NVHPC" ) list( APPEND FCKIT_QUARANTAINED_TESTS fckit_test_shared_ptr ) # deallocation of list of shared_ptr only seems to deallocate first entry endif() + check_fortran_compiler_flag(-Mnotarget_temps SUPPORTED_FLAG_NOTARGET_TEMPS) + if(NOT SUPPORTED_FLAG_NOTARGET_TEMPS) + set( HAVE_NOREPACK 0 ) + ecbuild_warn("The NVHPC Fortran flag -Mnotarget_temps is not supported. " + "In practice this means that a Fortran array sliced on first (leftmost) dimension (so discontiguous) " + "will be repacked as a temporary contiguous array when passed as argument and copied in/out. " + "Other types of slices are not repacked regardless. " + "See https://github.com/ecmwf/fckit/issues/73") + endif() endif() if( CMAKE_Fortran_COMPILER_ID STREQUAL "Intel" ) # known to work: 2021.4.0.20210910 from intel/2021.4 diff --git a/src/fckit/CMakeLists.txt b/src/fckit/CMakeLists.txt index e00ce99..8b347f9 100644 --- a/src/fckit/CMakeLists.txt +++ b/src/fckit/CMakeLists.txt @@ -66,6 +66,9 @@ if( CMAKE_Fortran_COMPILER_ID MATCHES "PGI|NVHPC" ) # PGF90-W-0435-Array declared with zero size # (/tmp/nawd/atlas-bundle/source/fckit/src/fckit/module/fckit_array.F90: 25) set_source_files_properties( module/fckit_array.F90 PROPERTIES COMPILE_FLAGS "-w" ) + + ecbuild_add_fortran_flags("-Mnotarget_temps" NAME fckit_fortran_norepack NO_FAIL) # otherwise wrong strides computation of arrays passed as arguments + # Not all NVHPC installations support this. See https://github.com/ecmwf/fckit/issues/73 endif() diff --git a/src/fckit/module/fckit_array.F90 b/src/fckit/module/fckit_array.F90 index 8c8a1b3..e016906 100644 --- a/src/fckit/module/fckit_array.F90 +++ b/src/fckit/module/fckit_array.F90 @@ -1103,7 +1103,7 @@ function array_stride_logical_r4_dim(arr,dim) result( stride ) function array_stride_int32_r1(arr) result( stride_ ) use, intrinsic :: iso_c_binding - integer(c_int32_t) :: arr(:) + integer(c_int32_t), target :: arr(:) integer(c_int32_t) :: stride_(1) stride_(1) = array_stride_int32_r1_dim(arr,1) end function @@ -1112,7 +1112,7 @@ function array_stride_int32_r1(arr) result( stride_ ) function array_stride_int32_r2(arr) result( stride_ ) use, intrinsic :: iso_c_binding - integer(c_int32_t) :: arr(:,:) + integer(c_int32_t), target :: arr(:,:) integer(c_int32_t) :: stride_(2) stride_(1) = array_stride_int32_r2_dim(arr,1) stride_(2) = array_stride_int32_r2_dim(arr,2) @@ -1122,7 +1122,7 @@ function array_stride_int32_r2(arr) result( stride_ ) function array_stride_int32_r3(arr) result( stride_ ) use, intrinsic :: iso_c_binding - integer(c_int32_t) :: arr(:,:,:) + integer(c_int32_t), target :: arr(:,:,:) integer(c_int32_t) :: stride_(3) stride_(1) = array_stride_int32_r3_dim(arr,1) stride_(2) = array_stride_int32_r3_dim(arr,2) @@ -1133,7 +1133,7 @@ function array_stride_int32_r3(arr) result( stride_ ) function array_stride_int32_r4(arr) result( stride_ ) use, intrinsic :: iso_c_binding - integer(c_int32_t) :: arr(:,:,:,:) + integer(c_int32_t), target :: arr(:,:,:,:) integer(c_int32_t) :: stride_(4) stride_(1) = array_stride_int32_r4_dim(arr,1) stride_(2) = array_stride_int32_r4_dim(arr,2) @@ -1145,7 +1145,7 @@ function array_stride_int32_r4(arr) result( stride_ ) function array_stride_int64_r1(arr) result( stride_ ) use, intrinsic :: iso_c_binding - integer(c_int64_t) :: arr(:) + integer(c_int64_t), target :: arr(:) integer(c_int32_t) :: stride_(1) stride_(1) = array_stride_int64_r1_dim(arr,1) end function @@ -1154,7 +1154,7 @@ function array_stride_int64_r1(arr) result( stride_ ) function array_stride_int64_r2(arr) result( stride_ ) use, intrinsic :: iso_c_binding - integer(c_int64_t) :: arr(:,:) + integer(c_int64_t), target :: arr(:,:) integer(c_int32_t) :: stride_(2) stride_(1) = array_stride_int64_r2_dim(arr,1) stride_(2) = array_stride_int64_r2_dim(arr,2) @@ -1164,7 +1164,7 @@ function array_stride_int64_r2(arr) result( stride_ ) function array_stride_int64_r3(arr) result( stride_ ) use, intrinsic :: iso_c_binding - integer(c_int64_t) :: arr(:,:,:) + integer(c_int64_t), target :: arr(:,:,:) integer(c_int32_t) :: stride_(3) stride_(1) = array_stride_int64_r3_dim(arr,1) stride_(2) = array_stride_int64_r3_dim(arr,2) @@ -1175,7 +1175,7 @@ function array_stride_int64_r3(arr) result( stride_ ) function array_stride_int64_r4(arr) result( stride_ ) use, intrinsic :: iso_c_binding - integer(c_int64_t) :: arr(:,:,:,:) + integer(c_int64_t), target :: arr(:,:,:,:) integer(c_int32_t) :: stride_(4) stride_(1) = array_stride_int64_r4_dim(arr,1) stride_(2) = array_stride_int64_r4_dim(arr,2) @@ -1187,7 +1187,7 @@ function array_stride_int64_r4(arr) result( stride_ ) function array_stride_real32_r1(arr) result( stride_ ) use, intrinsic :: iso_c_binding - real(c_float) :: arr(:) + real(c_float), target :: arr(:) integer(c_int32_t) :: stride_(1) stride_(1) = array_stride_real32_r1_dim(arr,1) end function @@ -1196,7 +1196,7 @@ function array_stride_real32_r1(arr) result( stride_ ) function array_stride_real32_r2(arr) result( stride_ ) use, intrinsic :: iso_c_binding - real(c_float) :: arr(:,:) + real(c_float), target :: arr(:,:) integer(c_int32_t) :: stride_(2) stride_(1) = array_stride_real32_r2_dim(arr,1) stride_(2) = array_stride_real32_r2_dim(arr,2) @@ -1206,7 +1206,7 @@ function array_stride_real32_r2(arr) result( stride_ ) function array_stride_real32_r3(arr) result( stride_ ) use, intrinsic :: iso_c_binding - real(c_float) :: arr(:,:,:) + real(c_float), target :: arr(:,:,:) integer(c_int32_t) :: stride_(3) stride_(1) = array_stride_real32_r3_dim(arr,1) stride_(2) = array_stride_real32_r3_dim(arr,2) @@ -1217,7 +1217,7 @@ function array_stride_real32_r3(arr) result( stride_ ) function array_stride_real32_r4(arr) result( stride_ ) use, intrinsic :: iso_c_binding - real(c_float) :: arr(:,:,:,:) + real(c_float), target :: arr(:,:,:,:) integer(c_int32_t) :: stride_(4) stride_(1) = array_stride_real32_r4_dim(arr,1) stride_(2) = array_stride_real32_r4_dim(arr,2) @@ -1229,7 +1229,7 @@ function array_stride_real32_r4(arr) result( stride_ ) function array_stride_real64_r1(arr) result( stride_ ) use, intrinsic :: iso_c_binding - real(c_double) :: arr(:) + real(c_double), target :: arr(:) integer(c_int32_t) :: stride_(1) stride_(1) = array_stride_real64_r1_dim(arr,1) end function @@ -1238,7 +1238,7 @@ function array_stride_real64_r1(arr) result( stride_ ) function array_stride_real64_r2(arr) result( stride_ ) use, intrinsic :: iso_c_binding - real(c_double) :: arr(:,:) + real(c_double), target :: arr(:,:) integer(c_int32_t) :: stride_(2) stride_(1) = array_stride_real64_r2_dim(arr,1) stride_(2) = array_stride_real64_r2_dim(arr,2) @@ -1248,7 +1248,7 @@ function array_stride_real64_r2(arr) result( stride_ ) function array_stride_real64_r3(arr) result( stride_ ) use, intrinsic :: iso_c_binding - real(c_double) :: arr(:,:,:) + real(c_double), target :: arr(:,:,:) integer(c_int32_t) :: stride_(3) stride_(1) = array_stride_real64_r3_dim(arr,1) stride_(2) = array_stride_real64_r3_dim(arr,2) @@ -1259,7 +1259,7 @@ function array_stride_real64_r3(arr) result( stride_ ) function array_stride_real64_r4(arr) result( stride_ ) use, intrinsic :: iso_c_binding - real(c_double) :: arr(:,:,:,:) + real(c_double), target :: arr(:,:,:,:) integer(c_int32_t) :: stride_(4) stride_(1) = array_stride_real64_r4_dim(arr,1) stride_(2) = array_stride_real64_r4_dim(arr,2) @@ -1271,7 +1271,7 @@ function array_stride_real64_r4(arr) result( stride_ ) function array_stride_logical_r1(arr) result( stride_ ) use, intrinsic :: iso_c_binding - logical :: arr(:) + logical, target :: arr(:) integer(c_int32_t) :: stride_(1) stride_(1) = array_stride_logical_r1_dim(arr,1) end function @@ -1280,7 +1280,7 @@ function array_stride_logical_r1(arr) result( stride_ ) function array_stride_logical_r2(arr) result( stride_ ) use, intrinsic :: iso_c_binding - logical :: arr(:,:) + logical, target :: arr(:,:) integer(c_int32_t) :: stride_(2) stride_(1) = array_stride_logical_r2_dim(arr,1) stride_(2) = array_stride_logical_r2_dim(arr,2) @@ -1290,7 +1290,7 @@ function array_stride_logical_r2(arr) result( stride_ ) function array_stride_logical_r3(arr) result( stride_ ) use, intrinsic :: iso_c_binding - logical :: arr(:,:,:) + logical, target :: arr(:,:,:) integer(c_int32_t) :: stride_(3) stride_(1) = array_stride_logical_r3_dim(arr,1) stride_(2) = array_stride_logical_r3_dim(arr,2) @@ -1301,7 +1301,7 @@ function array_stride_logical_r3(arr) result( stride_ ) function array_stride_logical_r4(arr) result( stride_ ) use, intrinsic :: iso_c_binding - logical :: arr(:,:,:,:) + logical, target :: arr(:,:,:,:) integer(c_int32_t) :: stride_(4) stride_(1) = array_stride_logical_r4_dim(arr,1) stride_(2) = array_stride_logical_r4_dim(arr,2) diff --git a/src/tests/CMakeLists.txt b/src/tests/CMakeLists.txt index 74869bf..de9e14d 100644 --- a/src/tests/CMakeLists.txt +++ b/src/tests/CMakeLists.txt @@ -11,6 +11,7 @@ cmake_policy( SET CMP0064 NEW ) # Recognize ``TEST`` as operator for the ``if()` add_fctest( TARGET fckit_test_array LINKER_LANGUAGE Fortran SOURCES test_array.F90 + DEFINITIONS FCKIT_HAVE_NOREPACK=${HAVE_NOREPACK} LIBS fckit) add_fctest( TARGET fckit_test_resource diff --git a/src/tests/test_array.F90 b/src/tests/test_array.F90 index 82eaac0..178c975 100644 --- a/src/tests/test_array.F90 +++ b/src/tests/test_array.F90 @@ -25,13 +25,37 @@ use fckit_array_module, only: array_stride, array_strides use, intrinsic :: iso_c_binding integer(c_int32_t) :: array_int32_r2(20,10) + integer(c_int32_t) :: array_int32_r4(20,10,4,2) write(0,*) "test_array_stride" FCTEST_CHECK_EQUAL( array_stride(array_int32_r2,1), 1 ) FCTEST_CHECK_EQUAL( array_stride(array_int32_r2,2), 20 ) - FCTEST_CHECK_EQUAL( array_strides(array_int32_r2), ([1,20]) ) + FCTEST_CHECK_EQUAL( array_stride(array_int32_r4,1), 1 ) + FCTEST_CHECK_EQUAL( array_stride(array_int32_r4,2), 20 ) + FCTEST_CHECK_EQUAL( array_stride(array_int32_r4,3), 200 ) + FCTEST_CHECK_EQUAL( array_stride(array_int32_r4,4), 800 ) + FCTEST_CHECK_EQUAL( array_strides(array_int32_r4), ([1,20,200,800]) ) +END_TEST + +TEST( test_array_stride_discontiguous ) + use fckit_array_module, only: array_stride, array_strides + use, intrinsic :: iso_c_binding + implicit none + integer(c_int32_t), target :: array_int32_r4(20,10,4,2) + + write(0,*) "test_array_stride_discontiguous" + FCTEST_CHECK_EQUAL( array_strides(array_int32_r4(:,5,2,:)), ([1,800]) ) + FCTEST_CHECK_EQUAL( array_strides(array_int32_r4(:,:,2,:)), ([1,20,800]) ) + FCTEST_CHECK_EQUAL( array_strides(array_int32_r4(5:5,:,2,:)), ([1,20,800]) ) + FCTEST_CHECK_EQUAL( array_strides(array_int32_r4(5,:,2,:)), ([20,800]) ) + ! Above FCTEST_CHECK_EQUAL is known to fail with NVHPC 25.9 on Linux_aarch64 (e.g. GH200) + ! because the flag -Mnotarget_temps is not supported on Linux_aarch64 (FCKIT_HAVE_NOREPACK=0) + if (FCKIT_HAVE_NOREPACK==0 .AND. FCTEST_LAST_CHECK_FAILED()) then + write(0,'(A)') "WARNING: Above FCTEST_CHECK_EQUAL is known to fail because FCKIT_HAVE_NOREPACK=0" + write(0,'(A)') "--> IGNORING THIS CHECK" + endif END_TEST END_TESTSUITE