This started by me trying to understand a FAIL: libgomp.fortran/map-subarray-6.f90 -O1 execution test
I think the problem was that the execution did *not* fail because var%p2 was *by chance* having the "right" value, violating the 'dg-should-fail' condition. The reason for that was that 'p2 = 0' initialized an implicitly declared variable - instead of var%p2. I think the idea for the test is/was that no pointer attachment actually happens - such that it crashes when trying to access the variable. Obviously, this will fail when the host memory is accessible. There are some other tricky parts: By mapping tgt/tgt2, the copy back will actually overwrite the var%p / var%p2 = ... assignment (unless on the host or using self mapping). Or not - as 'map(tgt)' is actually removed, if 'tgt' is not used! I hope that the attached version actually tests everything possible, with the caveat that for nvptx the host accessible is not detected. That's https://gcc.gnu.org/PR113216 This has only the effect that some code is skipped - the code does not try to access the memory if GCC reports it is inaccessible, even if it actually is. (If it isn't, this prevents crashing the code). I have committed the testcase as r17-144-ga61760c4e555f9 Follow-up comments are still welcome :-) Thanks, Tobias
commit a61760c4e555f9f5af2ea1ca3aa7abc2e578eed1 Author: Tobias Burnus <[email protected]> Date: Tue Apr 28 14:15:21 2026 +0200 libgomp.fortran/map-subarray-6.f90: Fix and robustify Changes: * Actually initialize the proper variable. * Handle the three cases explicitly: self mapping/host fallback, mapping but host accessible and mapping and (potentially) not host accessible. Hence, remove 'dg-should-fail' - as the code should now always run. * Add more checks for not pointer attaching, using values outside mapped range. * Add several comments and handle the case that 'tgt' is actually removed during gimplification as unused. (Two cases: once the result with 'tgt' removed - and once using 'tgt'/'tgt2' in the target region - and checking then for the result). libgomp/ChangeLog: * testsuite/libgomp.fortran/map-subarray-6.f90: Fix, extend, and robustify. --- .../testsuite/libgomp.fortran/map-subarray-6.f90 | 146 +++++++++++++++++++-- 1 file changed, 137 insertions(+), 9 deletions(-) diff --git a/libgomp/testsuite/libgomp.fortran/map-subarray-6.f90 b/libgomp/testsuite/libgomp.fortran/map-subarray-6.f90 index 9f0edf70890..243e88b70bd 100644 --- a/libgomp/testsuite/libgomp.fortran/map-subarray-6.f90 +++ b/libgomp/testsuite/libgomp.fortran/map-subarray-6.f90 @@ -1,5 +1,9 @@ ! { dg-do run } +use iso_c_binding +use omp_lib +implicit none + type t integer, pointer :: p(:) integer, pointer :: p2(:) @@ -7,20 +11,144 @@ end type t type(t) :: var integer, target :: tgt(5), tgt2(1000) +logical :: host_accessible, self_mapping +integer(c_intptr_t) :: ip, ip2 + +ip = transfer(c_loc(tgt), ip) +ip2 = transfer(c_loc(tgt2), ip2) + var%p => tgt var%p2 => tgt2 -p = 0 -p2 = 0 +! 'map(var)' shall never do any pointer attachment - even if the pointer +! variables are mapped to the device. +! +! There are three case: +! +! 1. Host fallback or self mapping: In the target region, the values are modified on the host +! 2. Host memory inaccessible: var's pointers point to the host version (inaccessible); +! tgt and tgt2 are mapped from/to the device but are inaccessible via var's pointers. +! 3. No selfmapping but variables are accessible on the host: +! Modifying var%p and var%p2 changes the value on the host - but copying back tgt and +! tgt2 will set the value prior to the copy in. -!$omp target map(tgt, tgt2(4:6), var) - var%p(1) = 5 - var%p2(5) = 7 +! NOTE: Due to PR libgomp/113216, omp_target_is_accessible will report .false. on Nvptx +! even if host access to the device is possible. - This will reduce the test coverage +! but will not cause a fail. + +host_accessible = omp_target_is_accessible(c_loc(tgt), c_sizeof(tgt), omp_default_device) /= 0 +!host_accessible = .true. ! set this manually on nvptx with USM support, until fixed + +self_mapping = .false. +!$omp target map(to: self_mapping) + self_mapping = .true. !$omp end target -if (var%p(1).ne.5) stop 1 -if (var%p2(5).ne.7) stop 2 +print *, (self_mapping ? '' : 'NO '), 'self mapping, ', & + (host_accessible ? '' : 'NOT '), 'host accessible' -end +var%p = 1 +var%p2 = 2 + +! The following is slightly tricky as well: As 'tgt' is not used, it is optimized away +! by during gimplification! - Hence, 'tgt' is also not copied back. +! For 'tgt2(4:6)', the expression is too complex for the gimplifier - hence, it +! is copied back ... + +!$omp target map(tgt, tgt2(4:6),var) firstprivate(host_accessible, ip, ip2) + ! No pointer attachment = points to the host + if (ip /= transfer(c_loc(var%p), ip)) stop 1 + if (ip2 /= transfer(c_loc(var%p2), ip2)) stop 2 + + if (lbound(var%p,1) /= 1 .or. ubound(var%p,1) /= 5 .or. .not.associated(var%p)) & + stop 3 + if (lbound(var%p2,1) /= 1 .or. ubound(var%p2,1) /= 1000 .or. .not.associated(var%p2)) & + stop 4 + + if (omp_is_initial_device() .or. host_accessible) then + if (any (var%p /= 1)) stop 5 + if (any (var%p2 /= 2)) stop 6 + var%p(1) = 5 + var%p2(5) = 6 + var%p2(22) = 7 + end if +!$omp end target -! { dg-shouldfail "" { offload_device_nonshared_as } } +if (omp_get_default_device() == omp_get_num_devices() & + .or. omp_get_default_device() == omp_initial_device & + .or. host_accessible) then + if (self_mapping) then + if (var%p(1) /= 5) stop 7 + if (var%p2(5) /= 6) stop 8 + if (var%p2(22) /= 7) stop 9 + else + if (var%p(1) /= 5) stop 10 ! NO copy back - hence, value is 5 + if (var%p2(5) /= 2) stop 11 + if (var%p2(22) /= 7) stop 12 + endif + if (any (var%p(2:) /= 1)) stop 13 + if (any (var%p2(:4) /= 2) & + .or. any (var%p2(6:21) /= 2) & + .or. any (var%p2(23:) /= 2)) & + stop 14 +else + if (any(var%p /= 1)) stop 15 + if (any(var%p2 /= 2)) stop 16 +end if + + +! The same - but now using tgt / tgt2 inside the region + +var%p = 1 +var%p2 = 2 + +!$omp target map(tgt, tgt2(4:6),var) firstprivate(host_accessible, ip, ip2) + ! No pointer attachment = points to the host + if (ip /= transfer(c_loc(var%p), ip)) stop 17 + if (ip2 /= transfer(c_loc(var%p2), ip2)) stop 18 + + if (omp_is_initial_device() .or. self_mapping) then + if (.not. c_associated(c_loc(var%p), c_loc(tgt))) stop 19 + if (.not. c_associated(c_loc(var%p2), c_loc(tgt2))) stop 20 + else + if (c_associated(c_loc(var%p), c_loc(tgt))) stop 21 + if (c_associated(c_loc(var%p2), c_loc(tgt2))) stop 22 + endif + + if (lbound(var%p,1) /= 1 .or. ubound(var%p,1) /= 5 .or. .not.associated(var%p)) & + stop 23 + if (lbound(var%p2,1) /= 1 .or. ubound(var%p2,1) /= 1000 .or. .not.associated(var%p2)) & + stop 24 + + if (omp_is_initial_device() .or. host_accessible) then + if (any (var%p /= 1)) stop 25 + if (any (var%p2 /= 2)) stop 26 + var%p(1) = 5 + var%p2(5) = 6 + var%p2(22) = 7 + end if +!$omp end target + +if (omp_get_default_device() == omp_get_num_devices() & + .or. omp_get_default_device() == omp_initial_device & + .or. host_accessible) then + if (self_mapping) then + if (var%p(1) /= 5) stop 27 + if (var%p2(5) /= 6) stop 28 + if (var%p2(22) /= 7) stop 29 + else + if (var%p(1) /= 1) stop 30 ! NOW tgt is copied back + if (var%p2(5) /= 2) stop 31 + if (var%p2(22) /= 7) stop 32 + endif + if (any (var%p(2:) /= 1)) stop 33 + if (any (var%p2(:4) /= 2) & + .or. any (var%p2(6:21) /= 2) & + .or. any (var%p2(23:) /= 2)) & + stop 34 +else + if (any(var%p /= 1)) stop 35 + if (any(var%p2 /= 2)) stop 36 +end if + +end
