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(-)
@@ -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;
@@ -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:
@@ -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 &
@@ -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
new file mode 100644
@@ -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
new file mode 100644
@@ -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
@@ -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
@@ -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