diff options
author | Tobias Burnus <burnus@net-b.de> | 2010-04-10 16:24:46 +0200 |
---|---|---|
committer | Tobias Burnus <burnus@gcc.gnu.org> | 2010-04-10 16:24:46 +0200 |
commit | 687ea68f03359b93fd19fa6fd7666a2867aaa22c (patch) | |
tree | e2073cb1cb60b55156ee63c56140969f388c8595 | |
parent | 85c9bcd4184b9c088323e1b46d455d5f0b1067a1 (diff) | |
download | gcc-687ea68f03359b93fd19fa6fd7666a2867aaa22c.zip gcc-687ea68f03359b93fd19fa6fd7666a2867aaa22c.tar.gz gcc-687ea68f03359b93fd19fa6fd7666a2867aaa22c.tar.bz2 |
re PR fortran/43591 (PPC: internal compiler error: in gfc_traverse_expr, at fortran/expr.c:3604)
2010-04-10 Tobias Burnus <burnus@net-b.de>
PR fortran/43591
* expr.c (gfc_is_constant_expr, gfc_traverse_expr): Handle
proc-pointers and type-bound procedures.
(gfc_specification_expr): Check proc-pointers for pureness.
2010-04-10 Tobias Burnus <burnus@net-b.de>
PR fortran/43591
* gfortran.dg/spec_expr_6.f90: New test.
From-SVN: r158191
-rw-r--r-- | gcc/fortran/ChangeLog | 7 | ||||
-rw-r--r-- | gcc/fortran/expr.c | 9 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/spec_expr_6.f90 | 52 |
4 files changed, 72 insertions, 1 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ebce913..17933ff 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2010-04-10 Tobias Burnus <burnus@net-b.de> + + PR fortran/43591 + * expr.c (gfc_is_constant_expr, gfc_traverse_expr): Handle + proc-pointers and type-bound procedures. + (gfc_specification_expr): Check proc-pointers for pureness. + 2010-04-09 Iain Sandoe <iains@gcc.gnu.org> PR bootstrap/43684 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 2200a80..9e2beb6 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -782,6 +782,8 @@ gfc_is_constant_expr (gfc_expr *e) break; case EXPR_FUNCTION: + case EXPR_PPC: + case EXPR_COMPCALL: /* Specification functions are constant. */ if (check_specification_function (e) == MATCH_YES) { @@ -2808,6 +2810,7 @@ check_restricted (gfc_expr *e) gfc_try gfc_specification_expr (gfc_expr *e) { + gfc_component *comp; if (e == NULL) return SUCCESS; @@ -2822,7 +2825,9 @@ gfc_specification_expr (gfc_expr *e) if (e->expr_type == EXPR_FUNCTION && !e->value.function.isym && !e->value.function.esym - && !gfc_pure (e->symtree->n.sym)) + && !gfc_pure (e->symtree->n.sym) + && (!gfc_is_proc_ptr_comp (e, &comp) + || !comp->attr.pure)) { gfc_error ("Function '%s' at %L must be PURE", e->symtree->n.sym->name, &e->where); @@ -3588,6 +3593,8 @@ gfc_traverse_expr (gfc_expr *expr, gfc_symbol *sym, switch (expr->expr_type) { + case EXPR_PPC: + case EXPR_COMPCALL: case EXPR_FUNCTION: for (args = expr->value.function.actual; args; args = args->next) { diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 3d07046..1ca318b 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2010-04-10 Tobias Burnus <burnus@net-b.de> + + PR fortran/43591 + * gfortran.dg/spec_expr_6.f90: New test. + 2010-04-09 Manuel López-Ibáñez <manu@gcc.gnu.org> PR cpp/43195 diff --git a/gcc/testsuite/gfortran.dg/spec_expr_6.f90 b/gcc/testsuite/gfortran.dg/spec_expr_6.f90 new file mode 100644 index 0000000..3b5b973 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/spec_expr_6.f90 @@ -0,0 +1,52 @@ +! { dg-do compile } +! +! PR fortran/43591 +! +! Pureness check for TPB/PPC in specification expressions +! +! Based on a test case of Thorsten Ohl +! +! + +module m + implicit none + type t + procedure(p1_type), nopass, pointer :: p1 => NULL() + contains + procedure, nopass :: tbp => p1_type + end type t +contains + subroutine proc (t1, t2) + type(t), intent(in) :: t1, t2 + integer, dimension(t1%p1(), t2%tbp()) :: table + end subroutine proc + pure function p1_type() + integer :: p1_type + p1_type = 42 + end function p1_type + pure subroutine p(t1) + type(t), intent(inout) :: t1 + integer :: a(t1%p1()) + end subroutine p +end module m + +module m2 + implicit none + type t + procedure(p1_type), nopass, pointer :: p1 => NULL() + contains + procedure, nopass :: tbp => p1_type + end type t +contains + subroutine proc (t1, t2) + type(t), intent(in) :: t1, t2 + integer, dimension(t1%p1()) :: table1 ! { dg-error "must be PURE" } + integer, dimension(t2%tbp()) :: table2 ! { dg-error "must be PURE" } + end subroutine proc + function p1_type() + integer :: p1_type + p1_type = 42 + end function p1_type +end module m2 + +! { dg-final { cleanup-modules "m m2" } } |