diff options
| -rw-r--r-- | gcc/fortran/openmp.cc | 12 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/gomp/associate1.f90 | 40 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/gomp/associate2.f90 | 76 |
3 files changed, 104 insertions, 24 deletions
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index 16cd03a..7141481 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -6782,8 +6782,10 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, gfc_error ("Cray pointee %qs in SHARED clause at %L", n->sym->name, &n->where); if (n->sym->attr.associate_var) - gfc_error ("ASSOCIATE name %qs in SHARED clause at %L", - n->sym->name, &n->where); + gfc_error ("Associate name %qs in SHARED clause at %L", + n->sym->attr.select_type_temporary + ? n->sym->assoc->target->symtree->n.sym->name + : n->sym->name, &n->where); if (omp_clauses->detach && n->sym == omp_clauses->detach->symtree->n.sym) gfc_error ("DETACH event handle %qs in SHARED clause at %L", @@ -7163,8 +7165,10 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, gfc_error ("Cray pointee %qs in %s clause at %L", n->sym->name, name, &n->where); if (n->sym->attr.associate_var) - gfc_error ("ASSOCIATE name %qs in %s clause at %L", - n->sym->name, name, &n->where); + gfc_error ("Associate name %qs in %s clause at %L", + n->sym->attr.select_type_temporary + ? n->sym->assoc->target->symtree->n.sym->name + : n->sym->name, name, &n->where); if (list != OMP_LIST_PRIVATE && is_reduction) { if (n->sym->attr.proc_pointer) diff --git a/gcc/testsuite/gfortran.dg/gomp/associate1.f90 b/gcc/testsuite/gfortran.dg/gomp/associate1.f90 index abc5ae9..a44099e 100644 --- a/gcc/testsuite/gfortran.dg/gomp/associate1.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/associate1.f90 @@ -16,65 +16,65 @@ program associate1 j = 2 associate(k => v, l => a(i, j), m => a(i, :)) associate(n => b(j)%c(:, :)%i, o => a, p => b) -!$omp parallel shared (l) ! { dg-error "ASSOCIATE name" } +!$omp parallel shared (l) ! { dg-error "Associate name" } !$omp end parallel -!$omp parallel firstprivate (m) ! { dg-error "ASSOCIATE name" } +!$omp parallel firstprivate (m) ! { dg-error "Associate name" } !$omp end parallel -!$omp parallel reduction (+: k) ! { dg-error "ASSOCIATE name" } +!$omp parallel reduction (+: k) ! { dg-error "Associate name" } !$omp end parallel -!$omp parallel do firstprivate (k) ! { dg-error "ASSOCIATE name" } +!$omp parallel do firstprivate (k) ! { dg-error "Associate name" } do i = 1, 10 end do -!$omp parallel do lastprivate (n) ! { dg-error "ASSOCIATE name" } +!$omp parallel do lastprivate (n) ! { dg-error "Associate name" } do i = 1, 10 end do -!$omp parallel do private (o) ! { dg-error "ASSOCIATE name" } +!$omp parallel do private (o) ! { dg-error "Associate name" } do i = 1, 10 end do -!$omp parallel do shared (p) ! { dg-error "ASSOCIATE name" } +!$omp parallel do shared (p) ! { dg-error "Associate name" } do i = 1, 10 end do -!$omp task private (k) ! { dg-error "ASSOCIATE name" } +!$omp task private (k) ! { dg-error "Associate name" } !$omp end task -!$omp task shared (l) ! { dg-error "ASSOCIATE name" } +!$omp task shared (l) ! { dg-error "Associate name" } !$omp end task -!$omp task firstprivate (m) ! { dg-error "ASSOCIATE name" } +!$omp task firstprivate (m) ! { dg-error "Associate name" } !$omp end task -!$omp do private (l) ! { dg-error "ASSOCIATE name" } +!$omp do private (l) ! { dg-error "Associate name" } do i = 1, 10 end do -!$omp do reduction (*: k) ! { dg-error "ASSOCIATE name" } +!$omp do reduction (*: k) ! { dg-error "Associate name" } do i = 1, 10 end do -!$omp sections private(o) ! { dg-error "ASSOCIATE name" } +!$omp sections private(o) ! { dg-error "Associate name" } !$omp section !$omp section !$omp end sections -!$omp parallel sections firstprivate(p) ! { dg-error "ASSOCIATE name" } +!$omp parallel sections firstprivate(p) ! { dg-error "Associate name" } !$omp section !$omp section !$omp endparallelsections -!$omp parallelsections lastprivate(m) ! { dg-error "ASSOCIATE name" } +!$omp parallelsections lastprivate(m) ! { dg-error "Associate name" } !$omp section !$omp section !$omp endparallelsections -!$omp sections reduction(+:k) ! { dg-error "ASSOCIATE name" } +!$omp sections reduction(+:k) ! { dg-error "Associate name" } !$omp section !$omp section !$omp end sections -!$omp simd private (l) ! { dg-error "ASSOCIATE name" } +!$omp simd private (l) ! { dg-error "Associate name" } do i = 1, 10 end do k = 1 -!$omp simd lastprivate (m) ! { dg-error "ASSOCIATE name" } +!$omp simd lastprivate (m) ! { dg-error "Associate name" } do i = 1, 10 end do k = 1 -!$omp simd reduction (+: k) ! { dg-error "ASSOCIATE name" } +!$omp simd reduction (+: k) ! { dg-error "Associate name" } do i = 1, 10 end do k = 1 -!$omp simd linear (k : 2) ! { dg-error "ASSOCIATE name" } +!$omp simd linear (k : 2) ! { dg-error "Associate name" } do i = 1, 10 k = k + 2 end do diff --git a/gcc/testsuite/gfortran.dg/gomp/associate2.f90 b/gcc/testsuite/gfortran.dg/gomp/associate2.f90 new file mode 100644 index 0000000..d4e97cb --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/associate2.f90 @@ -0,0 +1,76 @@ +! { dg-do compile } +! +! PR fortran/103039 +! + +subroutine shared_test(cc, ar) +implicit none +class(*) :: cc +integer :: ar(..) + +associate(aa => cc) + !$omp parallel shared(aa) ! { dg-error "Associate name 'aa' in SHARED clause" } + !$omp end parallel +end associate + +select type(tt => cc) + type is (integer) + !$omp parallel shared(tt) ! { dg-error "Associate name 'tt' in SHARED clause" } + !$omp end parallel +end select + +select type(cc) + type is (integer) + !$omp parallel shared(cc) ! { dg-error "Associate name 'cc' in SHARED clause" } + !$omp end parallel +end select + +select rank(rr => ar) + rank(1) + !$omp parallel shared(rr) ! { dg-error "Associate name 'rr' in SHARED clause" } + !$omp end parallel +end select + +select rank(ar) + rank(1) + !$omp parallel shared(ar) ! { dg-error "Associate name 'ar' in SHARED clause" } + !$omp end parallel +end select +end + + + +subroutine firstprivate_test(cc, ar) +implicit none +class(*) :: cc +integer :: ar(..) + +associate(aa => cc) + !$omp parallel firstprivate(aa) ! { dg-error "Associate name 'aa' in FIRSTPRIVATE clause" } + !$omp end parallel +end associate + +select type(tt => cc) + type is (integer) + !$omp parallel firstprivate(tt) ! { dg-error "Associate name 'tt' in FIRSTPRIVATE clause" } + !$omp end parallel +end select + +select type(cc) + type is (integer) + !$omp parallel firstprivate(cc) ! { dg-error "Associate name 'cc' in FIRSTPRIVATE clause" } + !$omp end parallel +end select + +select rank(rr => ar) + rank(1) + !$omp parallel firstprivate(rr) ! { dg-error "Associate name 'rr' in FIRSTPRIVATE clause" } + !$omp end parallel +end select + +select rank(ar) + rank(1) + !$omp parallel firstprivate(ar) ! { dg-error "Associate name 'ar' in FIRSTPRIVATE clause" } + !$omp end parallel +end select +end |