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

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 553c338..f0562ac 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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

diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index ed85398..360176e 100644 (file)
--- 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 1c980ac..d0a8f40 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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

diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_19.f90 b/gcc/testsuite/gfortran.dg/typebound_proc_19.f90
new file mode 100644 (file)
index 0000000..be15bf0
--- /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" } }