https://gcc.gnu.org/g:34b77d1b9ac53c89296a0d8bd7f4cf35eebd8001
commit r15-4291-g34b77d1b9ac53c89296a0d8bd7f4cf35eebd8001
Author: Tobias Burnus <tbur...@baylibre.com>
Date: Sat Oct 12 14:55:22 2024 +0200
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:
---
gcc/fortran/openmp.cc | 51 +++++++++++++++++++++-
gcc/fortran/trans-openmp.cc | 5 +++
.../gfortran.dg/gomp/polymorphic-mapping-2.f90 | 16 +++++++
.../gfortran.dg/gomp/polymorphic-mapping.f90 | 51 ++++++++++++++++++++++
4 files changed, 121 insertions(+), 2 deletions(-)
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index d9ccae8a11fd..2c12f5e362d6 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 3a335ade0f73..d3783f56a693 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 000000000000..e25db68094ad
--- /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 000000000000..dc3eb9e9c712
--- /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
