GCC does not really handle mapping of polymorphic variables - and OpenMP
6 will also make it implementation defined. (While explicitly permitting
it with data-sharing clauses.)
This matches essentially what is in GCC, except that 'private' (and
other privatizations) are not properly handled.
It also fixes the reported error location which due to missing gobbling
of whitespace and pointing before the actual location looked odd.
Review comments? Remarks, Suggestions?
Tobias
PS: I think we eventually should move to location ranges, i.e. for a
variable or expression, not only point at the first character but at the
range. That's supported by the generic GCC diagnostic system. This can
be done step wise and I think the expression, the name and the symbol
matching are obvious candidates.
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.
It also fixes a diagnostic issue related to composite constructs containing
'target' and the match locus in gfc_match_omp_variable_list.
gcc/fortran/ChangeLog:
* gfortran.h (gfc_locus_add_offset): New macro.
* openmp.cc (gfc_match_omp_variable_list): Use it.
(resolve_omp_clauses): Diagnose polymorphic mapping.
gcc/testsuite/ChangeLog:
* gfortran.dg/gomp/allocate-14.f90: Fix off-by-one+ dg- column.
* gfortran.dg/gomp/reduction5.f90: Likewise.
* gfortran.dg/gomp/reduction6.f90: Likewise.
* gfortran.dg/goacc/pr92793-1.f90: Likewise.
* gfortran.dg/gomp/polymorphic-mapping.f90: New test.
* gfortran.dg/gomp/polymorphic-mapping-2.f90: New test.
gcc/fortran/gfortran.h | 3 ++
gcc/fortran/openmp.cc | 55 +++++++++++++++++++++-
gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90 | 4 +-
gcc/testsuite/gfortran.dg/gomp/allocate-14.f90 | 4 +-
.../gfortran.dg/gomp/polymorphic-mapping-2.f90 | 16 +++++++
.../gfortran.dg/gomp/polymorphic-mapping.f90 | 49 +++++++++++++++++++
gcc/testsuite/gfortran.dg/gomp/reduction5.f90 | 6 +--
gcc/testsuite/gfortran.dg/gomp/reduction6.f90 | 4 +-
8 files changed, 130 insertions(+), 11 deletions(-)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 917866a7ef0..2e495e80e0d 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1083,6 +1083,9 @@ typedef struct gfc_linebuf
#define gfc_linebuf_linenum(LBUF) (LOCATION_LINE ((LBUF)->location))
+#define gfc_locus_add_offset(loc, offset) \
+ do { STATIC_ASSERT (offset >= 0); loc.nextc += offset; } while (false)
+
typedef struct
{
gfc_char_t *nextc;
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index d9ccae8a11f..bd5dee56ca5 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -424,6 +424,7 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list,
for (;;)
{
+ gfc_gobble_whitespace ();
cur_loc = gfc_current_locus;
m = gfc_match_name (n);
@@ -445,6 +446,7 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list,
tail = tail->next;
}
tail->where = cur_loc;
+ gfc_locus_add_offset (tail->where, 1);
goto next_item;
}
if (m == MATCH_YES)
@@ -492,6 +494,7 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list,
tail->sym = sym;
tail->expr = expr;
tail->where = cur_loc;
+ gfc_locus_add_offset (tail->where, 1);
if (reject_common_vars && sym->attr.in_common)
{
gcc_assert (allow_common);
@@ -535,6 +538,7 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list,
tail = tail->next;
}
tail->sym = sym;
+ gfc_locus_add_offset (tail->where, 1);
tail->where = cur_loc;
}
@@ -9087,10 +9091,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 +9137,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 +9405,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/testsuite/gfortran.dg/goacc/pr92793-1.f90 b/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90
index 422131ba473..25ccc4e429e 100644
--- a/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/pr92793-1.f90
@@ -22,7 +22,7 @@ subroutine check ()
!$acc & & ! { dg-final { scan-tree-dump-times "pr92793-1\\\.f90:26:22\\\] #pragma acc loop" 1 "gimple" } }
!$acc& reduction ( + : sum ) & ! { dg-line sum1 }
!$acc && ! Fortran location information points to the ':' in 'reduction(+:sum)'.
- !$acc & & ! { dg-message "36: location of the previous reduction for 'sum'" "" { target *-*-* } sum1 }
+ !$acc & & ! { dg-message "38: location of the previous reduction for 'sum'" "" { target *-*-* } sum1 }
!$acc& independent
do i = 1, 10
!$acc loop &
@@ -32,7 +32,7 @@ subroutine check ()
!$acc & reduction(-: diff ) &
!$acc&reduction(- : sum) & ! { dg-line sum2 }
!$acc & & ! Fortran location information points to the ':' in 'reduction(-:sum)'.
- !$acc& & ! { dg-warning "32: conflicting reduction operations for 'sum'" "" { target *-*-* } sum2 }
+ !$acc& & ! { dg-warning "37: conflicting reduction operations for 'sum'" "" { target *-*-* } sum2 }
!$acc &independent
do j = 1, 10
sum &
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-14.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-14.f90
index 4fed19249a3..4db950f90a7 100644
--- a/gcc/testsuite/gfortran.dg/gomp/allocate-14.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-14.f90
@@ -32,10 +32,10 @@ subroutine coarrays(x)
!$omp allocate(x) ! { dg-error "Unexpected dummy argument 'x' as argument at .1. to declarative !.OMP ALLOCATE" }
- !$omp allocators allocate(y) ! { dg-error "28:Unexpected coarray 'y' in 'allocate' at .1." }
+ !$omp allocators allocate(y) ! { dg-error "29:Unexpected coarray 'y' in 'allocate' at .1." }
allocate(y[*])
- !$omp allocate(z) ! { dg-error "17:Unexpected coarray 'z' in 'allocate' at .1." }
+ !$omp allocate(z) ! { dg-error "18:Unexpected coarray 'z' in 'allocate' at .1." }
allocate(z(5)[*])
x = 5
end
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 00000000000..e25db68094a
--- /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 00000000000..93db00565ec
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping.f90
@@ -0,0 +1,49 @@
+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 "29:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-1 }
+! { dg-warning "32:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-2 }
+! { dg-warning "36:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-3 }
+! { dg-warning "39:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-4 }
+
+! 11111111112222222222333333333344
+!2345678901234567890123456789012345678901
+!$omp target firstprivate(ca) ! { dg-warning "27:FIRSTPRIVATE with polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" }
+!$omp end target
+
+!$omp target parallel do firstprivate(ca) ! { dg-warning "39: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 "26:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-1 }
+! { dg-warning "28:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-2 }
+! { dg-warning "36:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-3 }
+! { dg-warning "38:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-4 }
+
+!$omp target parallel map(release: x) ! { dg-error "36:TARGET with map-type other than TO, FROM, TOFROM, or ALLOC on MAP clause" }
+
+block
+end block
+
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction5.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction5.f90
index 85491f0b643..b4b1c468589 100644
--- a/gcc/testsuite/gfortran.dg/gomp/reduction5.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/reduction5.f90
@@ -21,13 +21,13 @@ end do
!$omp end task ! { dg-error "Unexpected !.OMP END TASK statement" }
!$omp taskloop reduction(inscan,+:a) in_reduction(+:b) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" }
- ! { dg-error "34: With INSCAN at .1., expected loop body with ..OMP SCAN between two structured block sequences" "" { target *-*-* } .-1 }
+ ! { dg-error "35: With INSCAN at .1., expected loop body with ..OMP SCAN between two structured block sequences" "" { target *-*-* } .-1 }
! { dg-error "'inscan' and non-'inscan' 'reduction' clauses on the same construct" "" { target *-*-* } .-2 }
do i=1,10
a = a + 1
end do
-!$omp taskloop reduction(task,+:a) in_reduction(+:b) ! { dg-error "32: Only DEFAULT permitted as reduction-modifier in REDUCTION clause" }
+!$omp taskloop reduction(task,+:a) in_reduction(+:b) ! { dg-error "33: Only DEFAULT permitted as reduction-modifier in REDUCTION clause" }
do i=1,10
a = a + 1
end do
@@ -36,7 +36,7 @@ end do
a = a + 1
!$omp end teams
-!$omp teams reduction(task, +:b) ! { dg-error "30: Only DEFAULT permitted as reduction-modifier in REDUCTION clause" }
+!$omp teams reduction(task, +:b) ! { dg-error "31: Only DEFAULT permitted as reduction-modifier in REDUCTION clause" }
a = a + 1
!$omp end teams
diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction6.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction6.f90
index 321f096e02b..f6d95af0833 100644
--- a/gcc/testsuite/gfortran.dg/gomp/reduction6.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/reduction6.f90
@@ -4,13 +4,13 @@ implicit none
integer :: a, b, i
a = 0
-!$omp simd reduction(inscan,+:a) ! { dg-error "30: With INSCAN at .1., expected loop body with ..OMP SCAN between two structured block sequences" }
+!$omp simd reduction(inscan,+:a) ! { dg-error "31: With INSCAN at .1., expected loop body with ..OMP SCAN between two structured block sequences" }
do i=1,10
a = a + 1
end do
!$omp parallel
-!$omp do reduction(inscan,+:a) ! { dg-error "28: With INSCAN at .1., expected loop body with ..OMP SCAN between two structured block sequences" }
+!$omp do reduction(inscan,+:a) ! { dg-error "29: With INSCAN at .1., expected loop body with ..OMP SCAN between two structured block sequences" }
do i=1,10
a = a + 1
end do
