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.

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);
 	      }
 	  }
       }

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