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
This commit is contained in:
Jakub Jelinek 2008-04-03 23:01:26 +02:00 committed by Jakub Jelinek
parent 940f3b5219
commit 637b5a8e7c
5 changed files with 169 additions and 1 deletions

View file

@ -1,3 +1,9 @@
2008-04-03 Jakub Jelinek <jakub@redhat.com>
PR fortran/35786
* openmp.c (resolve_omp_clauses): Diagnose if a clause symbol
isn't a variable.
2008-04-03 Tom Tromey <tromey@redhat.com>
* Make-lang.in (fortran_OBJS): New variable.

View file

@ -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)

View file

@ -1,3 +1,9 @@
2008-04-03 Jakub Jelinek <jakub@redhat.com>
PR fortran/35786
* gfortran.dg/gomp/pr35786-1.f90: New test.
* gfortran.dg/gomp/pr35786-2.f90: New test.
2008-04-03 Adam Nemet <anemet@caviumnetworks.com>
* gcc.target/mips/scc-1.c: New test.

View file

@ -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" } }

View file

@ -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