Fortran/OpenMP: Warn when mapping polymorphic variables

OpenMP (TR13) states for Fortran:
* For map: "If a list item has polymorphic type, the behavior is unspecified."
* "If the firstprivate clause is on a target construct and a variable is of
  polymorphic type, the behavior is unspecified."
which this commit now warns for.

gcc/fortran/ChangeLog:

	* openmp.cc (resolve_omp_clauses): Diagnose polymorphic mapping.
	* trans-openmp.cc (gfc_omp_finish_clause): Warn when
	polymorphic variable is implicitly mapped.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/polymorphic-mapping.f90: New test.
	* gfortran.dg/gomp/polymorphic-mapping-2.f90: New test.

4 files changed, 121 insertions, 2 deletions

diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index d9ccae8..2c12f5e 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -9087,10 +9087,30 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 		  gfc_error ("List item %qs with allocatable components is not "
 			     "permitted in map clause at %L", n->sym->name,
 			     &n->where);
+		if (!openacc
+		    && (list == OMP_LIST_MAP
+			|| list == OMP_LIST_FROM
+			|| list == OMP_LIST_TO)
+		    && ((n->expr && n->expr->ts.type == BT_CLASS)
+			|| (!n->expr && n->sym->ts.type == BT_CLASS)))
+		  gfc_warning (OPT_Wopenmp,
+			       "Mapping polymorphic list item at %L is "
+			       "unspecified behavior", &n->where);
 		if (list == OMP_LIST_MAP && !openacc)
 		  switch (code->op)
 		    {
 		    case EXEC_OMP_TARGET:
+		    case EXEC_OMP_TARGET_PARALLEL:
+		    case EXEC_OMP_TARGET_PARALLEL_DO:
+		    case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
+		    case EXEC_OMP_TARGET_PARALLEL_LOOP:
+		    case EXEC_OMP_TARGET_SIMD:
+		    case EXEC_OMP_TARGET_TEAMS:
+		    case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
+		    case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
+		    case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
+		    case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
+		    case EXEC_OMP_TARGET_TEAMS_LOOP:
 		    case EXEC_OMP_TARGET_DATA:
 		      switch (n->u.map.op)
 			{
@@ -9113,8 +9133,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 			  gfc_error ("TARGET%s with map-type other than TO, "
 				     "FROM, TOFROM, or ALLOC on MAP clause "
 				     "at %L",
-				     code->op == EXEC_OMP_TARGET
-				     ? "" : " DATA", &n->where);
+				     code->op == EXEC_OMP_TARGET_DATA
+				     ? " DATA" : "", &n->where);
 			  break;
 			}
 		      break;
@@ -9381,6 +9401,33 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 		    && n->sym == omp_clauses->detach->symtree->n.sym)
 		  gfc_error ("DETACH event handle %qs in %s clause at %L",
 			     n->sym->name, name, &n->where);
+
+		if (!openacc
+		    && list == OMP_LIST_FIRSTPRIVATE
+		    && ((n->expr && n->expr->ts.type == BT_CLASS)
+			|| (!n->expr && n->sym->ts.type == BT_CLASS)))
+		  switch (code->op)
+		    {
+		    case EXEC_OMP_TARGET:
+		    case EXEC_OMP_TARGET_PARALLEL:
+		    case EXEC_OMP_TARGET_PARALLEL_DO:
+		    case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
+		    case EXEC_OMP_TARGET_PARALLEL_LOOP:
+		    case EXEC_OMP_TARGET_SIMD:
+		    case EXEC_OMP_TARGET_TEAMS:
+		    case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
+		    case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
+		    case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
+		    case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
+		    case EXEC_OMP_TARGET_TEAMS_LOOP:
+		      gfc_warning (OPT_Wopenmp,
+				   "FIRSTPRIVATE with polymorphic list item at "
+				   "%L is unspecified behavior", &n->where);
+		      break;
+		    default:
+		      break;
+		    }
+
 		switch (list)
 		  {
 		  case OMP_LIST_REDUCTION_TASK:
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 3a335ad..d3783f5 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -1553,6 +1553,11 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p, bool openacc)
       return;
     }
 
+  if (!openacc && GFC_CLASS_TYPE_P (TREE_TYPE (decl)))
+    warning_at (OMP_CLAUSE_LOCATION (c), OPT_Wopenmp,
+		"Implicit mapping of polymorphic variable %qD is "
+		"unspecified behavior", decl);
+
   tree c2 = NULL_TREE, c3 = NULL_TREE, c4 = NULL_TREE;
   tree present = gfc_omp_check_optional_argument (decl, true);
   if (POINTER_TYPE_P (TREE_TYPE (decl)))
diff --git a/gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping-2.f90 b/gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping-2.f90
new file mode 100644
index 0000000..e25db68
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping-2.f90
@@ -0,0 +1,16 @@
+type t
+  integer :: t
+end type t
+class(t), target, allocatable :: c, ca(:)
+class(*), pointer :: p, pa(:)
+integer :: x
+logical ll
+allocate( t :: c, ca(5))
+p => c
+pa => ca
+
+!$omp target  !  { dg-warning "Implicit mapping of polymorphic variable 'ca' is unspecified behavior \\\[-Wopenmp\\\]" }
+  ll = allocated(ca)
+!$omp end target 
+
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping.f90 b/gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping.f90
new file mode 100644
index 0000000..dc3eb9e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping.f90
@@ -0,0 +1,51 @@
+type t
+  integer :: t
+end type t
+class(t), target, allocatable :: c, ca(:)
+class(*), pointer :: p, pa(:)
+integer :: x
+allocate( t :: c, ca(5))
+p => c
+pa => ca
+
+!        11111111112222222222333333333344
+!2345678901234567890123456789012345678901
+!$omp target enter data map(c, ca, p, pa)
+! { dg-warning "28:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-1 }
+! { dg-warning "30:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-2 }
+! { dg-warning "34:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-3 }
+! { dg-warning "37:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-4 }
+
+!        11111111112222222222333333333344
+!2345678901234567890123456789012345678901
+!$omp target firstprivate(ca)  ! { dg-warning "26:FIRSTPRIVATE with polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" }
+!$omp end target
+
+!$omp target parallel do firstprivate(ca)  ! { dg-warning "38:FIRSTPRIVATE with polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" }
+do x = 0, 5
+end do
+
+!$omp target parallel do private(ca)  ! OK; should map declared type
+do x = 0, 5
+end do
+
+!$omp target private(ca)  ! OK; should map declared type
+block
+end block
+
+!        11111111112222222222333333333344
+!2345678901234567890123456789012345678901
+!$omp target update from(c,ca), to(p,pa)
+! { dg-warning "25:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-1 }
+! { dg-warning "27:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-2 }
+! { dg-warning "35:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-3 }
+! { dg-warning "37:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-4 }
+
+! -------------------------
+
+!$omp target parallel map(release: x) ! { dg-error "35:TARGET with map-type other than TO, FROM, TOFROM, or ALLOC on MAP clause" }
+
+block
+end block
+
+end