OpenMP/Fortran: Fix (re)mapping of allocatable/pointer arrays [PR96668]

gcc/cp/ChangeLog:

	PR fortran/96668
	* cp-gimplify.c (cxx_omp_finish_clause): Add bool openacc arg.
	* cp-tree.h (cxx_omp_finish_clause): Likewise
	* semantics.c (handle_omp_for_class_iterator): Update call.

gcc/fortran/ChangeLog:

	PR fortran/96668
	* trans.h (gfc_omp_finish_clause): Add bool openacc arg.
	* trans-openmp.c (gfc_omp_finish_clause): Ditto. Use
	GOMP_MAP_ALWAYS_POINTER with PSET for pointers.
	(gfc_trans_omp_clauses): Like the latter and also if the always
	modifier is used.

gcc/ChangeLog:

	PR fortran/96668
	* gimplify.c (gimplify_omp_for): Add 'bool openacc' argument;
	update omp_finish_clause calls.
	(gimplify_adjust_omp_clauses_1, gimplify_adjust_omp_clauses,
	gimplify_expr, gimplify_omp_loop): Update omp_finish_clause
	and/or gimplify_for calls.
	* langhooks-def.h (lhd_omp_finish_clause): Add bool openacc arg.
	* langhooks.c (lhd_omp_finish_clause): Likewise.
	* langhooks.h (lhd_omp_finish_clause): Likewise.
	* omp-low.c (scan_sharing_clauses): Keep GOMP_MAP_TO_PSET cause for
	'declare target' vars.

include/ChangeLog:

	PR fortran/96668
	* gomp-constants.h (GOMP_MAP_ALWAYS_POINTER_P): Define.

libgomp/ChangeLog:

	PR fortran/96668
	* libgomp.h (struct target_var_desc): Add has_null_ptr_assoc member.
	* target.c (gomp_map_vars_existing): Add always_to_flag flag.
	(gomp_map_vars_existing): Update call to it.
	(gomp_map_fields_existing): Likewise
	(gomp_map_vars_internal): Update PSET handling such that if a nullptr is
	now allocated or if GOMP_MAP_POINTER is used PSET is updated and pointer
	remapped.
	(GOMP_target_enter_exit_data): Hanlde GOMP_MAP_ALWAYS_POINTER like
	GOMP_MAP_POINTER.
	* testsuite/libgomp.fortran/map-alloc-ptr-1.f90: New test.
	* testsuite/libgomp.fortran/map-alloc-ptr-2.f90: New test.

10 files changed, 53 insertions, 20 deletions

diff --git a/gcc/cp/cp-gimplify.c b/gcc/cp/cp-gimplify.c
index f869583..b2befa7 100644
--- a/gcc/cp/cp-gimplify.c
+++ b/gcc/cp/cp-gimplify.c
@@ -2357,7 +2357,7 @@ cxx_omp_predetermined_mapping (tree decl)
 /* Finalize an implicitly determined clause.  */
 
 void
-cxx_omp_finish_clause (tree c, gimple_seq *)
+cxx_omp_finish_clause (tree c, gimple_seq *, bool /* openacc */)
 {
   tree decl, inner_type;
   bool make_shared = false;
diff --git a/gcc/cp/cp-tree.h b/gcc/cp/cp-tree.h
index 5923574..6e4de7d 100644
--- a/gcc/cp/cp-tree.h
+++ b/gcc/cp/cp-tree.h
@@ -7749,7 +7749,7 @@ extern tree cxx_omp_clause_default_ctor		(tree, tree, tree);
 extern tree cxx_omp_clause_copy_ctor		(tree, tree, tree);
 extern tree cxx_omp_clause_assign_op		(tree, tree, tree);
 extern tree cxx_omp_clause_dtor			(tree, tree);
-extern void cxx_omp_finish_clause		(tree, gimple_seq *);
+extern void cxx_omp_finish_clause		(tree, gimple_seq *, bool);
 extern bool cxx_omp_privatize_by_reference	(const_tree);
 extern bool cxx_omp_disregard_value_expr	(tree, bool);
 extern void cp_fold_function			(tree);
diff --git a/gcc/cp/semantics.c b/gcc/cp/semantics.c
index dafb403..4ca2a2f 100644
--- a/gcc/cp/semantics.c
+++ b/gcc/cp/semantics.c
@@ -8770,7 +8770,7 @@ handle_omp_for_class_iterator (int i, location_t locus, enum tree_code code,
 	{
 	  tree ivc = build_omp_clause (locus, OMP_CLAUSE_FIRSTPRIVATE);
 	  OMP_CLAUSE_DECL (ivc) = iter;
-	  cxx_omp_finish_clause (ivc, NULL);
+	  cxx_omp_finish_clause (ivc, NULL, false);
 	  OMP_CLAUSE_CHAIN (ivc) = clauses;
 	  clauses = ivc;
 	}
@@ -8802,7 +8802,7 @@ handle_omp_for_class_iterator (int i, location_t locus, enum tree_code code,
 	  OMP_CLAUSE_CODE (loop_iv_seen) = OMP_CLAUSE_FIRSTPRIVATE;
 	}
       if (OMP_CLAUSE_CODE (loop_iv_seen) == OMP_CLAUSE_FIRSTPRIVATE)
-	cxx_omp_finish_clause (loop_iv_seen, NULL);
+	cxx_omp_finish_clause (loop_iv_seen, NULL, false);
     }
 
   orig_pre_body = *pre_body;
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 0e1da04..9ec0df2 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -1276,7 +1276,7 @@ gfc_build_cond_assign_expr (stmtblock_t *block, tree cond_val,
 }
 
 void
-gfc_omp_finish_clause (tree c, gimple_seq *pre_p)
+gfc_omp_finish_clause (tree c, gimple_seq *pre_p, bool openacc)
 {
   if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_MAP)
     return;
@@ -1357,6 +1357,16 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p)
       tree type = TREE_TYPE (decl);
       tree ptr = gfc_conv_descriptor_data_get (decl);
 
+      /* OpenMP: automatically map pointer targets with the pointer;
+	 hence, always update the descriptor/pointer itself.
+	 NOTE: This also remaps the pointer for allocatable arrays with
+	 'target' attribute which also don't have the 'restrict' qualifier.  */
+      bool always_modifier = false;
+
+      if (!openacc
+	  && !(TYPE_QUALS (TREE_TYPE (ptr)) & TYPE_QUAL_RESTRICT))
+	always_modifier = true;
+
       if (present)
 	ptr = gfc_build_cond_assign_expr (&block, present, ptr,
 					  null_pointer_node);
@@ -1376,7 +1386,8 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p)
 	OMP_CLAUSE_DECL (c2) = decl;
       OMP_CLAUSE_SIZE (c2) = TYPE_SIZE_UNIT (type);
       c3 = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_MAP);
-      OMP_CLAUSE_SET_MAP_KIND (c3, GOMP_MAP_POINTER);
+      OMP_CLAUSE_SET_MAP_KIND (c3, always_modifier ? GOMP_MAP_ALWAYS_POINTER
+						   : GOMP_MAP_POINTER);
       if (present)
 	{
 	  ptr = gfc_conv_descriptor_data_get (decl);
@@ -2549,11 +2560,19 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 	      if (!n->sym->attr.referenced)
 		continue;
 
+	      bool always_modifier = false;
 	      tree node = build_omp_clause (input_location, OMP_CLAUSE_MAP);
 	      tree node2 = NULL_TREE;
 	      tree node3 = NULL_TREE;
 	      tree node4 = NULL_TREE;
 
+	      /* OpenMP: automatically map pointer targets with the pointer;
+		 hence, always update the descriptor/pointer itself.  */
+	      if (!openacc
+		  && ((n->expr == NULL && n->sym->attr.pointer)
+		      || (n->expr && gfc_expr_attr (n->expr).pointer)))
+		always_modifier = true;
+
 	      switch (n->u.map_op)
 		{
 		case OMP_MAP_ALLOC:
@@ -2575,12 +2594,15 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		  OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_TOFROM);
 		  break;
 		case OMP_MAP_ALWAYS_TO:
+		  always_modifier = true;
 		  OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALWAYS_TO);
 		  break;
 		case OMP_MAP_ALWAYS_FROM:
+		  always_modifier = true;
 		  OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALWAYS_FROM);
 		  break;
 		case OMP_MAP_ALWAYS_TOFROM:
+		  always_modifier = true;
 		  OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALWAYS_TOFROM);
 		  break;
 		case OMP_MAP_RELEASE:
@@ -2760,7 +2782,10 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 			  goto finalize_map_clause;
 			}
 		      else
-			OMP_CLAUSE_SET_MAP_KIND (node3, GOMP_MAP_POINTER);
+			OMP_CLAUSE_SET_MAP_KIND (node3,
+						 always_modifier
+						 ? GOMP_MAP_ALWAYS_POINTER
+						 : GOMP_MAP_POINTER);
 
 		      /* We have to check for n->sym->attr.dimension because
 			 of scalar coarrays.  */
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index e126fe9..d257963 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -810,7 +810,7 @@ tree gfc_omp_clause_copy_ctor (tree, tree, tree);
 tree gfc_omp_clause_assign_op (tree, tree, tree);
 tree gfc_omp_clause_linear_ctor (tree, tree, tree, tree);
 tree gfc_omp_clause_dtor (tree, tree);
-void gfc_omp_finish_clause (tree, gimple_seq *);
+void gfc_omp_finish_clause (tree, gimple_seq *, bool);
 bool gfc_omp_scalar_p (tree);
 bool gfc_omp_disregard_value_expr (tree, bool);
 bool gfc_omp_private_debug_clause (tree, bool);
diff --git a/gcc/gimplify.c b/gcc/gimplify.c
index 23d0e25..2dea03cc 100644
--- a/gcc/gimplify.c
+++ b/gcc/gimplify.c
@@ -10123,13 +10123,15 @@ gimplify_adjust_omp_clauses_1 (splay_tree_node n, void *data)
       OMP_CLAUSE_CHAIN (clause) = nc;
       struct gimplify_omp_ctx *ctx = gimplify_omp_ctxp;
       gimplify_omp_ctxp = ctx->outer_context;
-      lang_hooks.decls.omp_finish_clause (nc, pre_p);
+      lang_hooks.decls.omp_finish_clause (nc, pre_p,
+					  (ctx->region_type & ORT_ACC) != 0);
       gimplify_omp_ctxp = ctx;
     }
   *list_p = clause;
   struct gimplify_omp_ctx *ctx = gimplify_omp_ctxp;
   gimplify_omp_ctxp = ctx->outer_context;
-  lang_hooks.decls.omp_finish_clause (clause, pre_p);
+  lang_hooks.decls.omp_finish_clause (clause, pre_p,
+				      (ctx->region_type & ORT_ACC) != 0);
   if (gimplify_omp_ctxp)
     for (; clause != chain; clause = OMP_CLAUSE_CHAIN (clause))
       if (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_MAP
@@ -10539,7 +10541,9 @@ gimplify_adjust_omp_clauses (gimple_seq *pre_p, gimple_seq body, tree *list_p,
 		  OMP_CLAUSE_SET_MAP_KIND (nc, GOMP_MAP_TOFROM);
 		  OMP_CLAUSE_DECL (nc) = decl;
 		  OMP_CLAUSE_CHAIN (c) = nc;
-		  lang_hooks.decls.omp_finish_clause (nc, pre_p);
+		  lang_hooks.decls.omp_finish_clause (nc, pre_p,
+						      (ctx->region_type
+						       & ORT_ACC) != 0);
 		  while (1)
 		    {
 		      OMP_CLAUSE_MAP_IN_REDUCTION (nc) = 1;
@@ -11040,6 +11044,7 @@ gimplify_omp_for (tree *expr_p, gimple_seq *pre_p)
   int i;
   bitmap has_decl_expr = NULL;
   enum omp_region_type ort = ORT_WORKSHARE;
+  bool openacc = TREE_CODE (*expr_p) == OACC_LOOP;
 
   orig_for_stmt = for_stmt = *expr_p;
 
@@ -11147,7 +11152,7 @@ gimplify_omp_for (tree *expr_p, gimple_seq *pre_p)
 		OMP_CLAUSE_CHAIN (c) = OMP_FOR_CLAUSES (for_stmt);
 		OMP_FOR_CLAUSES (for_stmt) = c;
 		OMP_CLAUSE_CODE (*pc) = OMP_CLAUSE_FIRSTPRIVATE;
-		lang_hooks.decls.omp_finish_clause (*pc, pre_p);
+		lang_hooks.decls.omp_finish_clause (*pc, pre_p, openacc);
 	      }
 	    else
 	      {
@@ -11159,7 +11164,7 @@ gimplify_omp_for (tree *expr_p, gimple_seq *pre_p)
 		OMP_CLAUSE_DECL (c) = OMP_CLAUSE_DECL (*pc);
 		OMP_CLAUSE_CHAIN (c) = *pc;
 		*pc = c;
-		lang_hooks.decls.omp_finish_clause (*pc, pre_p);
+		lang_hooks.decls.omp_finish_clause (*pc, pre_p, openacc);
 	      }
 	    tree c = build_omp_clause (UNKNOWN_LOCATION,
 				       OMP_CLAUSE_FIRSTPRIVATE);
@@ -12115,7 +12120,8 @@ gimplify_omp_for (tree *expr_p, gimple_seq *pre_p)
 		  = build_omp_clause (OMP_CLAUSE_LOCATION (c),
 				      OMP_CLAUSE_FIRSTPRIVATE);
 		OMP_CLAUSE_DECL (*gtask_clauses_ptr) = OMP_CLAUSE_DECL (c);
-		lang_hooks.decls.omp_finish_clause (*gtask_clauses_ptr, NULL);
+		lang_hooks.decls.omp_finish_clause (*gtask_clauses_ptr, NULL,
+						    openacc);
 		gtask_clauses_ptr = &OMP_CLAUSE_CHAIN (*gtask_clauses_ptr);
 		*gforo_clauses_ptr = c;
 		gforo_clauses_ptr = &OMP_CLAUSE_CHAIN (c);
@@ -12154,7 +12160,8 @@ gimplify_omp_for (tree *expr_p, gimple_seq *pre_p)
 		  = build_omp_clause (OMP_CLAUSE_LOCATION (c),
 				      OMP_CLAUSE_FIRSTPRIVATE);
 		OMP_CLAUSE_DECL (*gtask_clauses_ptr) = OMP_CLAUSE_DECL (c);
-		lang_hooks.decls.omp_finish_clause (*gtask_clauses_ptr, NULL);
+		lang_hooks.decls.omp_finish_clause (*gtask_clauses_ptr, NULL,
+						    openacc);
 		gtask_clauses_ptr = &OMP_CLAUSE_CHAIN (*gtask_clauses_ptr);
 		OMP_CLAUSE_LASTPRIVATE_FIRSTPRIVATE (c) = 1;
 		*gforo_clauses_ptr = build_omp_clause (OMP_CLAUSE_LOCATION (c),
@@ -12535,7 +12542,7 @@ gimplify_omp_loop (tree *expr_p, gimple_seq *pre_p)
 		*pc = build_omp_clause (OMP_CLAUSE_LOCATION (c),
 					OMP_CLAUSE_FIRSTPRIVATE);
 		OMP_CLAUSE_DECL (*pc) = OMP_CLAUSE_DECL (c);
-		lang_hooks.decls.omp_finish_clause (*pc, NULL);
+		lang_hooks.decls.omp_finish_clause (*pc, NULL, false);
 		pc = &OMP_CLAUSE_CHAIN (*pc);
 	      }
 	    *pc = copy_node (c);
@@ -12546,7 +12553,7 @@ gimplify_omp_loop (tree *expr_p, gimple_seq *pre_p)
 		if (pass != last)
 		  OMP_CLAUSE_LASTPRIVATE_FIRSTPRIVATE (*pc) = 1;
 		else
-		  lang_hooks.decls.omp_finish_clause (*pc, NULL);
+		  lang_hooks.decls.omp_finish_clause (*pc, NULL, false);
 		OMP_CLAUSE_LASTPRIVATE_LOOP_IV (*pc) = 0;
 	      }
 	    pc = &OMP_CLAUSE_CHAIN (*pc);
diff --git a/gcc/langhooks-def.h b/gcc/langhooks-def.h
index 67b0210..a909915 100644
--- a/gcc/langhooks-def.h
+++ b/gcc/langhooks-def.h
@@ -81,7 +81,7 @@ extern int lhd_gimplify_expr (tree *, gimple_seq *, gimple_seq *);
 extern enum omp_clause_default_kind lhd_omp_predetermined_sharing (tree);
 extern enum omp_clause_defaultmap_kind lhd_omp_predetermined_mapping (tree);
 extern tree lhd_omp_assignment (tree, tree, tree);
-extern void lhd_omp_finish_clause (tree, gimple_seq *);
+extern void lhd_omp_finish_clause (tree, gimple_seq *, bool);
 struct gimplify_omp_ctx;
 extern void lhd_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *,
 					       tree);
diff --git a/gcc/langhooks.c b/gcc/langhooks.c
index 3cbe04c..8819a88 100644
--- a/gcc/langhooks.c
+++ b/gcc/langhooks.c
@@ -610,7 +610,7 @@ lhd_omp_assignment (tree clause ATTRIBUTE_UNUSED, tree dst, tree src)
 /* Finalize clause C.  */
 
 void
-lhd_omp_finish_clause (tree, gimple_seq *)
+lhd_omp_finish_clause (tree, gimple_seq *, bool)
 {
 }
 
diff --git a/gcc/langhooks.h b/gcc/langhooks.h
index 6ab6fb6..a35cf21 100644
--- a/gcc/langhooks.h
+++ b/gcc/langhooks.h
@@ -294,7 +294,7 @@ struct lang_hooks_for_decls
   tree (*omp_clause_dtor) (tree clause, tree decl);
 
   /* Do language specific checking on an implicitly determined clause.  */
-  void (*omp_finish_clause) (tree clause, gimple_seq *pre_p);
+  void (*omp_finish_clause) (tree clause, gimple_seq *pre_p, bool);
 
   /* Return true if DECL is a scalar variable (for the purpose of
      implicit firstprivatization).  */
diff --git a/gcc/omp-low.c b/gcc/omp-low.c
index 53efe5f..3d2a9d7 100644
--- a/gcc/omp-low.c
+++ b/gcc/omp-low.c
@@ -1351,6 +1351,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
 	      && OMP_CLAUSE_MAP_KIND (c) != GOMP_MAP_ALWAYS_TO
 	      && OMP_CLAUSE_MAP_KIND (c) != GOMP_MAP_ALWAYS_FROM
 	      && OMP_CLAUSE_MAP_KIND (c) != GOMP_MAP_ALWAYS_TOFROM
+	      && OMP_CLAUSE_MAP_KIND (c) != GOMP_MAP_TO_PSET
 	      && is_global_var (maybe_lookup_decl_in_outer_ctx (decl, ctx))
 	      && varpool_node::get_create (decl)->offloadable
 	      && !lookup_attribute ("omp declare target link",