OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/47399 ([OOP] ICE with TBP of a PARAMETER)

Browse Source 
2011-01-22  Tobias Burnus  <burnus@net-b.de>

        PR fortran/47399
        * primary.c (gfc_match_varspec): Relax gcc_assert to allow for
        PARAMETER TBP.

2011-01-22  Tobias Burnus  <burnus@net-b.de>

        PR fortran/47399
        * gfortran.dg/typebound_proc_19.f90: New.

From-SVN: r169126
This commit is contained in:
Tobias Burnus 2011-01-22 14:50:25 +01:00 committed by Tobias Burnus
parent caaf13d387
commit 4618de23d8
4 changed files with 58 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -1,3 +1,9 @@
2011-01-22 Tobias Burnus <burnus@net-b.de>
PR fortran/47399
* primary.c (gfc_match_varspec): Relax gcc_assert to allow for
PARAMETER TBP.
2011-01-21 Tobias Burnus <burnus@net-b.de>
PR fortran/47394

5
gcc/fortran/primary.c
View File

@ -1843,7 +1843,10 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
return MATCH_ERROR;
gcc_assert (!tail || !tail->next);
gcc_assert (primary->expr_type == EXPR_VARIABLE);
gcc_assert (primary->expr_type == EXPR_VARIABLE
|| (primary->expr_type == EXPR_STRUCTURE
&& primary->symtree && primary->symtree->n.sym
&& primary->symtree->n.sym->attr.flavor));
if (tbp->n.tb->is_generic)
tbp_sym = NULL;

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2011-01-22 Tobias Burnus <burnus@net-b.de>
PR fortran/47399
* gfortran.dg/typebound_proc_19.f90: New.
2011-01-21 Jeff Law <law@redhat.com>
PR tree-optimization/47053

43
gcc/testsuite/gfortran.dg/typebound_proc_19.f90 Normal file
View File

@ -0,0 +1,43 @@
! { dg-do compile }
!
! PR fortran/47399
!
! Contributed by Wolfgang Kilian.
!
module mytypes
implicit none
private
public :: mytype, get_i
integer, save :: i_priv = 13
type :: mytype
integer :: dummy
contains
procedure, nopass :: i => get_i
end type mytype
contains
pure function get_i () result (i)
integer :: i
i = i_priv
end function get_i
end module mytypes
subroutine test()
use mytypes
implicit none
type(mytype) :: a
type(mytype), parameter :: a_const = mytype (0)
integer, dimension (get_i()) :: x ! #1
integer, dimension (a%i()) :: y ! #2
integer, dimension (a_const%i()) :: z ! #3
if (size (x) /= 13 .or. size(y) /= 13 .or. size(z) /= 13) call abort()
! print *, size (x), size(y), size(z)
end subroutine test
call test()
end
! { dg-final { cleanup-modules "mytypes" } }