Fortran/OpenMP: Extend defaultmap clause for OpenMP 5 [PR92568]

	PR fortran/92568

gcc/fortran/ChangeLog:

	* dump-parse-tree.c (show_omp_clauses): Update for defaultmap.
	* f95-lang.c (LANG_HOOKS_OMP_ALLOCATABLE_P,
	LANG_HOOKS_OMP_SCALAR_TARGET_P): New.
	* gfortran.h (enum gfc_omp_defaultmap,
	enum gfc_omp_defaultmap_category): New.
	* openmp.c (gfc_match_omp_clauses): Update defaultmap matching.
	* trans-decl.c (gfc_finish_decl_attrs): Set GFC_DECL_SCALAR_TARGET.
	* trans-openmp.c (gfc_omp_allocatable_p, gfc_omp_scalar_target_p): New.
	(gfc_omp_scalar_p): Take 'ptr_alloc_ok' argument.
	(gfc_trans_omp_clauses, gfc_split_omp_clauses): Update for
	defaultmap changes.
	* trans.h (gfc_omp_scalar_p): Update prototype.
	(gfc_omp_allocatable_p, gfc_omp_scalar_target_p): New.
	(struct lang_decl): Add scalar_target.
	(GFC_DECL_SCALAR_TARGET, GFC_DECL_GET_SCALAR_TARGET): New.

gcc/ChangeLog:

	* gimplify.c (enum gimplify_defaultmap_kind): Add GDMK_SCALAR_TARGET.
	(struct gimplify_omp_ctx): Extend defaultmap array by one.
	(new_omp_context): Init defaultmap[GDMK_SCALAR_TARGET].
	(omp_notice_variable): Update type classification for Fortran.
	(gimplify_scan_omp_clauses): Update calls for new argument; handle
	GDMK_SCALAR_TARGET; for Fortran, GDMK_POINTER avoid GOVD_MAP_0LEN_ARRAY.
	* langhooks-def.h (lhd_omp_scalar_p): Add 'ptr_ok' argument.
	* langhooks.c (lhd_omp_scalar_p): Likewise.
	(LANG_HOOKS_OMP_ALLOCATABLE_P, LANG_HOOKS_OMP_SCALAR_TARGET_P): New.
	(LANG_HOOKS_DECLS): Add them.
	* langhooks.h (struct lang_hooks_for_decls): Add new hooks, update
	omp_scalar_p pointer type to include the new bool argument.

libgomp/ChangeLog:

	* testsuite/libgomp.fortran/defaultmap-8.f90: New test.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/pr99928-1.f90: Uncomment 'defaultmap(none)'.
	* gfortran.dg/gomp/pr99928-2.f90: Uncomment 'defaultmap(none)'.
	* gfortran.dg/gomp/pr99928-3.f90: Uncomment 'defaultmap(none)'.
	* gfortran.dg/gomp/pr99928-4.f90: Uncomment 'defaultmap(none)'.
	* gfortran.dg/gomp/pr99928-5.f90: Uncomment 'defaultmap(none)'.
	* gfortran.dg/gomp/pr99928-6.f90: Uncomment 'defaultmap(none)'.
	* gfortran.dg/gomp/pr99928-8.f90: Uncomment 'defaultmap(none)'.
	* gfortran.dg/gomp/defaultmap-1.f90: New test.
	* gfortran.dg/gomp/defaultmap-2.f90: New test.
	* gfortran.dg/gomp/defaultmap-3.f90: New test.
	* gfortran.dg/gomp/defaultmap-4.f90: New test.
	* gfortran.dg/gomp/defaultmap-5.f90: New test.
	* gfortran.dg/gomp/defaultmap-6.f90: New test.
	* gfortran.dg/gomp/defaultmap-7.f90: New test.

1 files changed, 89 insertions, 8 deletions

diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index f466ab6..ce1991e 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -393,6 +393,28 @@ gfc_is_unlimited_polymorphic_nonptr (tree type)
   return true;
 }
 
+/* Return true if the DECL is for an allocatable array or scalar.  */
+
+bool
+gfc_omp_allocatable_p (tree decl)
+{
+  if (!DECL_P (decl))
+    return false;
+
+  if (GFC_DECL_GET_SCALAR_ALLOCATABLE (decl))
+    return true;
+
+  tree type = TREE_TYPE (decl);
+  if (gfc_omp_privatize_by_reference (decl))
+    type = TREE_TYPE (type);
+
+  if (GFC_DESCRIPTOR_TYPE_P (type)
+      && GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE)
+    return true;
+
+  return false;
+}
+
 
 /* Return true if DECL in private clause needs
    OMP_CLAUSE_PRIVATE_OUTER_REF on the private clause.  */
@@ -1663,10 +1685,11 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p, bool openacc)
 
 
 /* Return true if DECL is a scalar variable (for the purpose of
-   implicit firstprivatization).  */
+   implicit firstprivatization/mapping). Only if 'ptr_alloc_ok.'
+   is true, allocatables and pointers are permitted. */
 
 bool
-gfc_omp_scalar_p (tree decl)
+gfc_omp_scalar_p (tree decl, bool ptr_alloc_ok)
 {
   tree type = TREE_TYPE (decl);
   if (TREE_CODE (type) == REFERENCE_TYPE)
@@ -1675,7 +1698,11 @@ gfc_omp_scalar_p (tree decl)
     {
       if (GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)
 	  || GFC_DECL_GET_SCALAR_POINTER (decl))
-	type = TREE_TYPE (type);
+	{
+	  if (!ptr_alloc_ok)
+	    return false;
+	  type = TREE_TYPE (type);
+	}
       if (GFC_ARRAY_TYPE_P (type)
 	  || GFC_CLASS_TYPE_P (type))
 	return false;
@@ -1691,6 +1718,17 @@ gfc_omp_scalar_p (tree decl)
 }
 
 
+/* Return true if DECL is a scalar with target attribute but does not have the
+   allocatable (or pointer) attribute (for the purpose of implicit mapping).  */
+
+bool
+gfc_omp_scalar_target_p (tree decl)
+{
+  return (DECL_P (decl) && GFC_DECL_GET_SCALAR_TARGET (decl)
+	  && gfc_omp_scalar_p (decl, false));
+}
+
+
 /* Return true if DECL's DECL_VALUE_EXPR (if any) should be
    disregarded in OpenMP construct, because it is going to be
    remapped during OpenMP lowering.  SHARED is true if DECL
@@ -4036,13 +4074,55 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NOGROUP);
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
-  if (clauses->defaultmap)
+
+  for (int i = 0; i < OMP_DEFAULTMAP_CAT_NUM; i++)
     {
+      if (clauses->defaultmap[i] == OMP_DEFAULTMAP_UNSET)
+       continue;
+      enum omp_clause_defaultmap_kind behavior, category;
+      switch ((gfc_omp_defaultmap_category) i)
+	{
+	case OMP_DEFAULTMAP_CAT_UNCATEGORIZED:
+	  category = OMP_CLAUSE_DEFAULTMAP_CATEGORY_UNSPECIFIED;
+	  break;
+	case OMP_DEFAULTMAP_CAT_SCALAR:
+	  category = OMP_CLAUSE_DEFAULTMAP_CATEGORY_SCALAR;
+	  break;
+	case OMP_DEFAULTMAP_CAT_AGGREGATE:
+	  category = OMP_CLAUSE_DEFAULTMAP_CATEGORY_AGGREGATE;
+	  break;
+	case OMP_DEFAULTMAP_CAT_ALLOCATABLE:
+	  category = OMP_CLAUSE_DEFAULTMAP_CATEGORY_ALLOCATABLE;
+	  break;
+	case OMP_DEFAULTMAP_CAT_POINTER:
+	  category = OMP_CLAUSE_DEFAULTMAP_CATEGORY_POINTER;
+	  break;
+	default: gcc_unreachable ();
+	}
+      switch (clauses->defaultmap[i])
+	{
+	case OMP_DEFAULTMAP_ALLOC:
+	  behavior = OMP_CLAUSE_DEFAULTMAP_ALLOC;
+	  break;
+	case OMP_DEFAULTMAP_TO: behavior = OMP_CLAUSE_DEFAULTMAP_TO; break;
+	case OMP_DEFAULTMAP_FROM: behavior = OMP_CLAUSE_DEFAULTMAP_FROM; break;
+	case OMP_DEFAULTMAP_TOFROM:
+	  behavior = OMP_CLAUSE_DEFAULTMAP_TOFROM;
+	  break;
+	case OMP_DEFAULTMAP_FIRSTPRIVATE:
+	  behavior = OMP_CLAUSE_DEFAULTMAP_FIRSTPRIVATE;
+	  break;
+	case OMP_DEFAULTMAP_NONE: behavior = OMP_CLAUSE_DEFAULTMAP_NONE; break;
+	case OMP_DEFAULTMAP_DEFAULT:
+	  behavior = OMP_CLAUSE_DEFAULTMAP_DEFAULT;
+	  break;
+	default: gcc_unreachable ();
+	}
       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEFAULTMAP);
-      OMP_CLAUSE_DEFAULTMAP_SET_KIND (c, OMP_CLAUSE_DEFAULTMAP_TOFROM,
-				      OMP_CLAUSE_DEFAULTMAP_CATEGORY_SCALAR);
+      OMP_CLAUSE_DEFAULTMAP_SET_KIND (c, behavior, category);
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
+
   if (clauses->depend_source)
     {
       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEPEND);
@@ -5672,8 +5752,9 @@ gfc_split_omp_clauses (gfc_code *code,
 	    = code->ext.omp_clauses->lists[OMP_LIST_IS_DEVICE_PTR];
 	  clausesa[GFC_OMP_SPLIT_TARGET].device
 	    = code->ext.omp_clauses->device;
-	  clausesa[GFC_OMP_SPLIT_TARGET].defaultmap
-	    = code->ext.omp_clauses->defaultmap;
+	  for (int i = 0; i < OMP_DEFAULTMAP_CAT_NUM; i++)
+	    clausesa[GFC_OMP_SPLIT_TARGET].defaultmap[i]
+	      = code->ext.omp_clauses->defaultmap[i];
 	  clausesa[GFC_OMP_SPLIT_TARGET].if_exprs[OMP_IF_TARGET]
 	    = code->ext.omp_clauses->if_exprs[OMP_IF_TARGET];
 	  /* And this is copied to all.  */