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.

diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index d9ccae8a11fd68ee80c36c8f6180c9fae9d07317..2c12f5e362d659bb6e6707f50dbdfc2eada4263f 100644 (file)
--- 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 3a335ade0f737cc7426ecbb77bd314d6d1ef0b9b..d3783f56a6937ec28b976fa8f3eee4f93487d79f 100644 (file)
--- 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 (file)
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 (file)
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