https://gcc.gnu.org/g:1e71ff87c97fcd37b8b98c76b684f23a17bae973
commit r16-7288-g1e71ff87c97fcd37b8b98c76b684f23a17bae973 Author: Paul-Antoine Arras <[email protected]> Date: Mon Feb 2 11:19:06 2026 +0100 OpenMP/Fortran: Fix present modifier in map clauses for allocatables The OpenMP 6.0 spec reads (Section 7.9.6 "map Clause"): "Unless otherwise specified, if a list item is a referencing variable then the effect of the map clause is applied to its referring pointer and, if a referenced pointee exists, its referenced pointee." In other words, the map clause (and its modifiers) applies to the array descriptor (unconditionally), and also to the array data if it is allocated. Without this patch, the semantics enforced in libgomp is incorrect: an allocatable is deemed present only if it is allocated. Correct semantics: an allocatable is in the present table as long as its descriptor is mapped, even if no data exists. libgomp/ChangeLog: * target.c (gomp_present_fatal): New function. (gomp_map_vars_internal): For a Fortran allocatable array, present causes runtime termination only if the descriptor is not mapped. (gomp_update): Call gomp_present_fatal. * testsuite/libgomp.fortran/map-alloc-present-1.f90: New test. Diff: --- libgomp/target.c | 60 ++++++++++++---------- .../libgomp.fortran/map-alloc-present-1.f90 | 51 ++++++++++++++++++ 2 files changed, 83 insertions(+), 28 deletions(-) diff --git a/libgomp/target.c b/libgomp/target.c index 071957ee3055..29e9a2c6367f 100644 --- a/libgomp/target.c +++ b/libgomp/target.c @@ -1156,6 +1156,23 @@ gomp_merge_iterator_maps (size_t *mapnum, void ***hostaddrs, size_t **sizes, return true; } +static void +gomp_present_fatal (void *addr, size_t size, struct gomp_device_descr *devicep) +{ + gomp_mutex_unlock (&devicep->lock); +#ifdef HAVE_INTTYPES_H + gomp_fatal ("present clause: not present on the device " + "(addr: %p, size: %" PRIu64 " (0x%" PRIx64 "), " + "dev: %d)", + addr, (uint64_t) size, (uint64_t) size, devicep->target_id); +#else + gomp_fatal ("present clause: not present on the device " + "(addr: %p, size: %lu (0x%lx), dev: %d)", + addr, (unsigned long) size, (unsigned long) size, + devicep->target_id); +#endif +} + static inline __attribute__((always_inline)) struct target_mem_desc * gomp_map_vars_internal (struct gomp_device_descr *devicep, struct goacc_asyncqueue *aq, size_t mapnum, @@ -1529,6 +1546,7 @@ gomp_map_vars_internal (struct gomp_device_descr *devicep, size_t j, field_tgt_offset = 0, field_tgt_clear = FIELD_TGT_EMPTY; uintptr_t field_tgt_base = 0; splay_tree_key field_tgt_structelem_first = NULL; + bool ref_ptee_not_present = false; for (i = 0; i < mapnum; i++) if (has_always_ptrset @@ -1936,6 +1954,7 @@ gomp_map_vars_internal (struct gomp_device_descr *devicep, case GOMP_MAP_FORCE_TOFROM: case GOMP_MAP_ALWAYS_TO: case GOMP_MAP_ALWAYS_TOFROM: + map_to: gomp_copy_host2dev (devicep, aq, (void *) (tgt->tgt_start + k->tgt_offset), @@ -1952,6 +1971,9 @@ gomp_map_vars_internal (struct gomp_device_descr *devicep, == GOMP_MAP_POINTER_TO_ZERO_LENGTH_ARRAY_SECTION)); break; case GOMP_MAP_TO_PSET: + if (ref_ptee_not_present) + gomp_present_fatal ((void *) k->host_start, + k->host_end - k->host_start, devicep); gomp_copy_host2dev (devicep, aq, (void *) (tgt->tgt_start + k->tgt_offset), @@ -2001,23 +2023,17 @@ gomp_map_vars_internal (struct gomp_device_descr *devicep, case GOMP_MAP_ALWAYS_PRESENT_FROM: case GOMP_MAP_ALWAYS_PRESENT_TOFROM: { + if (i + 1 < mapnum + && (get_kind (short_mapkind, kinds, i + 1) & typemask) + == GOMP_MAP_TO_PSET) + { + ref_ptee_not_present = true; + goto map_to; + } /* We already looked up the memory region above and it was missing. */ - size_t size = k->host_end - k->host_start; - gomp_mutex_unlock (&devicep->lock); -#ifdef HAVE_INTTYPES_H - gomp_fatal ("present clause: not present on the device " - "(addr: %p, size: %"PRIu64" (0x%"PRIx64"), " - "dev: %d)", (void *) k->host_start, - (uint64_t) size, (uint64_t) size, - devicep->target_id); -#else - gomp_fatal ("present clause: not present on the device " - "(addr: %p, size: %lu (0x%lx), dev: %d)", - (void *) k->host_start, - (unsigned long) size, (unsigned long) size, - devicep->target_id); -#endif + gomp_present_fatal ((void *) k->host_start, + k->host_end - k->host_start, devicep); } break; case GOMP_MAP_FORCE_DEVICEPTR: @@ -2465,19 +2481,7 @@ gomp_update (struct gomp_device_descr *devicep, size_t mapnum, void **hostaddrs, { /* We already looked up the memory region above and it was missing. */ - gomp_mutex_unlock (&devicep->lock); -#ifdef HAVE_INTTYPES_H - gomp_fatal ("present clause: not present on the device " - "(addr: %p, size: %"PRIu64" (0x%"PRIx64"), " - "dev: %d)", (void *) hostaddrs[i], - (uint64_t) sizes[i], (uint64_t) sizes[i], - devicep->target_id); -#else - gomp_fatal ("present clause: not present on the device " - "(addr: %p, size: %lu (0x%lx), dev: %d)", - (void *) hostaddrs[i], (unsigned long) sizes[i], - (unsigned long) sizes[i], devicep->target_id); -#endif + gomp_present_fatal (hostaddrs[i], sizes[i], devicep); } } } diff --git a/libgomp/testsuite/libgomp.fortran/map-alloc-present-1.f90 b/libgomp/testsuite/libgomp.fortran/map-alloc-present-1.f90 new file mode 100644 index 000000000000..eab1abc53919 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/map-alloc-present-1.f90 @@ -0,0 +1,51 @@ +! This testcase checks that a mapped allocatable array is considered present +! on a target construct even when it is unallocated. + +implicit none + +real(kind=8), allocatable :: alloc0(:,:), alloc1(:,:), alloc2(:,:) + +! Case 1: allocated and mapped -> present + +alloc0 = reshape([1,2,3,4],[2,2]) + +!$omp target enter data & +!$omp map(to: alloc0) & +!$omp map(to: alloc1) + +!$omp target map(present, alloc: alloc0) + if (.not. allocated(alloc0)) stop 1 + if (any (alloc0 /= reshape([1,2,3,4],[2,2]))) stop 2 + alloc0 = alloc0 * 2 +!$omp end target + +! Case 2: unallocated but mapped -> present + +alloc1 = reshape([11,22,33,44],[2,2]) + +!$omp target map(always, present, to: alloc1) + if (.not. allocated(alloc1)) stop 3 + if (any (alloc1 /= reshape([11,22,33,44],[2,2]))) stop 4 + alloc1 = alloc1 * 3 +!$omp end target + +! Case 3: unallocated and not mapped -> not present + +alloc2 = reshape([111,222,333,444],[2,2]) + +print *, "CheCKpOInT" +! { dg-output "CheCKpOInT(\n|\r\n|\r).*" } + +! { dg-output "libgomp: present clause: not present on the device \\(addr: 0x\[0-9a-f\]+, size: \[0-9\]+ \\(0x\[0-9a-f\]+\\), dev: \[0-9\]+\\\)" { target offload_device_nonshared_as } } +! { dg-shouldfail "present error triggered" { offload_device_nonshared_as } } +!$omp target map(always, present, to: alloc2) + if (.not. allocated(alloc2)) stop 5 + if (any (alloc2 /= reshape([111,222,333,444],[2,2]))) stop 6 + alloc2 = alloc2 * 4 +!$omp end target + +!$omp target exit data & +!$omp map(from: alloc0) & +!$omp map(from: alloc1) + +end
