From 4618de23d8ac1c2a2c054c8120bcf02d190901d5 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Sat, 22 Jan 2011 14:50:25 +0100 Subject: [PATCH] re PR fortran/47399 ([OOP] ICE with TBP of a PARAMETER) 2011-01-22 Tobias Burnus PR fortran/47399 * primary.c (gfc_match_varspec): Relax gcc_assert to allow for PARAMETER TBP. 2011-01-22 Tobias Burnus PR fortran/47399 * gfortran.dg/typebound_proc_19.f90: New. From-SVN: r169126 --- gcc/fortran/ChangeLog | 6 +++ gcc/fortran/primary.c | 5 ++- gcc/testsuite/ChangeLog | 5 +++ .../gfortran.dg/typebound_proc_19.f90 | 43 +++++++++++++++++++ 4 files changed, 58 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/typebound_proc_19.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 553c33859f8..f0562acb04d 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2011-01-22 Tobias Burnus + + PR fortran/47399 + * primary.c (gfc_match_varspec): Relax gcc_assert to allow for + PARAMETER TBP. + 2011-01-21 Tobias Burnus PR fortran/47394 diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index ed85398357a..360176edfdb 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -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; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 1c980ac7399..d0a8f405170 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2011-01-22 Tobias Burnus + + PR fortran/47399 + * gfortran.dg/typebound_proc_19.f90: New. + 2011-01-21 Jeff Law PR tree-optimization/47053 diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_19.f90 b/gcc/testsuite/gfortran.dg/typebound_proc_19.f90 new file mode 100644 index 00000000000..be15bf09fc3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/typebound_proc_19.f90 @@ -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" } } -- 2.30.2