Commit 687ea68f by Tobias Burnus Committed by Tobias Burnus

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
parent 85c9bcd4
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
......
......@@ -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)
{
......
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
......
! { 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" } }
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment