From 637b5a8e7ced71facbb36d9505b85ad3b991572b Mon Sep 17 00:00:00 2001 From: Jakub Jelinek Date: Thu, 3 Apr 2008 23:01:26 +0200 Subject: [PATCH] re PR fortran/35786 (OpenMP Fortran PRIVATE on parameter gives error in gfc_finish_var_decl) PR fortran/35786 * openmp.c (resolve_omp_clauses): Diagnose if a clause symbol isn't a variable. * gfortran.dg/gomp/pr35786-1.f90: New test. * gfortran.dg/gomp/pr35786-2.f90: New test. From-SVN: r133874 --- gcc/fortran/ChangeLog | 6 ++ gcc/fortran/openmp.c | 36 +++++++++- gcc/testsuite/ChangeLog | 6 ++ gcc/testsuite/gfortran.dg/gomp/pr35786-1.f90 | 74 ++++++++++++++++++++ gcc/testsuite/gfortran.dg/gomp/pr35786-2.f90 | 48 +++++++++++++ 5 files changed, 169 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/gomp/pr35786-1.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/pr35786-2.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 5a6971fa5bb..851008ed395 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2008-04-03 Jakub Jelinek + + PR fortran/35786 + * openmp.c (resolve_omp_clauses): Diagnose if a clause symbol + isn't a variable. + 2008-04-03 Tom Tromey * Make-lang.in (fortran_OBJS): New variable. diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 8c2d2577440..245f7951ddc 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -717,7 +717,41 @@ resolve_omp_clauses (gfc_code *code) a symbol can appear on both firstprivate and lastprivate. */ for (list = 0; list < OMP_LIST_NUM; list++) for (n = omp_clauses->lists[list]; n; n = n->next) - n->sym->mark = 0; + { + n->sym->mark = 0; + if (n->sym->attr.flavor == FL_VARIABLE) + continue; + if (n->sym->attr.flavor == FL_PROCEDURE + && n->sym->result == n->sym + && n->sym->attr.function) + { + if (gfc_current_ns->proc_name == n->sym + || (gfc_current_ns->parent + && gfc_current_ns->parent->proc_name == n->sym)) + continue; + if (gfc_current_ns->proc_name->attr.entry_master) + { + gfc_entry_list *el = gfc_current_ns->entries; + for (; el; el = el->next) + if (el->sym == n->sym) + break; + if (el) + continue; + } + if (gfc_current_ns->parent + && gfc_current_ns->parent->proc_name->attr.entry_master) + { + gfc_entry_list *el = gfc_current_ns->parent->entries; + for (; el; el = el->next) + if (el->sym == n->sym) + break; + if (el) + continue; + } + } + gfc_error ("Object '%s' is not a variable at %L", n->sym->name, + &code->loc); + } for (list = 0; list < OMP_LIST_NUM; list++) if (list != OMP_LIST_FIRSTPRIVATE && list != OMP_LIST_LASTPRIVATE) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 22d1cecdaa8..bd7e6e5815d 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2008-04-03 Jakub Jelinek + + PR fortran/35786 + * gfortran.dg/gomp/pr35786-1.f90: New test. + * gfortran.dg/gomp/pr35786-2.f90: New test. + 2008-04-03 Adam Nemet * gcc.target/mips/scc-1.c: New test. diff --git a/gcc/testsuite/gfortran.dg/gomp/pr35786-1.f90 b/gcc/testsuite/gfortran.dg/gomp/pr35786-1.f90 new file mode 100644 index 00000000000..c8639abdbbd --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/pr35786-1.f90 @@ -0,0 +1,74 @@ +! PR fortran/35786 +! { dg-do compile } +! { dg-options "-fopenmp" } + +module pr35768 + real, parameter :: one = 1.0 +contains + subroutine fn1 + !$omp parallel firstprivate (one) ! { dg-error "is not a variable" } + !$omp end parallel + end subroutine fn1 + subroutine fn2 (doit) + external doit + !$omp parallel firstprivate (doit) ! { dg-error "is not a variable" } + call doit () + !$omp end parallel + end subroutine fn2 + subroutine fn3 + interface fn4 + subroutine fn4 () + end subroutine fn4 + end interface + !$omp parallel private (fn4) ! { dg-error "is not a variable" } + call fn4 () + !$omp end parallel + end subroutine fn3 + subroutine fn5 + interface fn6 + function fn6 () + integer :: fn6 + end function fn6 + end interface + integer :: x + !$omp parallel private (fn6, x) ! { dg-error "is not a variable" } + x = fn6 () + !$omp end parallel + end subroutine fn5 + function fn7 () result (re7) + integer :: re7 + !$omp parallel private (fn7) ! { dg-error "is not a variable" } + !$omp end parallel + end function fn7 + function fn8 () result (re8) + integer :: re8 + call fn9 + contains + subroutine fn9 + !$omp parallel private (fn8) ! { dg-error "is not a variable" } + !$omp end parallel + end subroutine fn9 + end function fn8 + function fn10 () result (re10) + integer :: re10, re11 + entry fn11 () result (re11) + !$omp parallel private (fn10) ! { dg-error "is not a variable" } + !$omp end parallel + !$omp parallel private (fn11) ! { dg-error "is not a variable" } + !$omp end parallel + end function fn10 + function fn12 () result (re12) + integer :: re12, re13 + entry fn13 () result (re13) + call fn14 + contains + subroutine fn14 + !$omp parallel private (fn12) ! { dg-error "is not a variable" } + !$omp end parallel + !$omp parallel private (fn13) ! { dg-error "is not a variable" } + !$omp end parallel + end subroutine fn14 + end function fn12 +end module + +! { dg-final { cleanup-modules "pr35768" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/pr35786-2.f90 b/gcc/testsuite/gfortran.dg/gomp/pr35786-2.f90 new file mode 100644 index 00000000000..beb1a828df2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/pr35786-2.f90 @@ -0,0 +1,48 @@ +! PR fortran/35786 +! { dg-do compile } +! { dg-options "-fopenmp" } + +function fn7 () + integer :: fn7 + !$omp parallel private (fn7) + fn7 = 6 + !$omp end parallel + fn7 = 7 +end function fn7 +function fn8 () + integer :: fn8 + call fn9 +contains + subroutine fn9 + !$omp parallel private (fn8) + fn8 = 6 + !$omp end parallel + fn8 = 7 + end subroutine fn9 +end function fn8 +function fn10 () + integer :: fn10, fn11 + entry fn11 () + !$omp parallel private (fn10) + fn10 = 6 + !$omp end parallel + !$omp parallel private (fn11) + fn11 = 6 + !$omp end parallel + fn10 = 7 +end function fn10 +function fn12 () + integer :: fn12, fn13 + entry fn13 () + call fn14 +contains + subroutine fn14 + !$omp parallel private (fn12) + fn12 = 6 + !$omp end parallel + !$omp parallel private (fn13) + fn13 = 6 + !$omp end parallel + fn12 = 7 + end subroutine fn14 +end function fn12 -- 2.30.2