Hi all,

here is a patch for a rejects-valid problem with type-bound
procedures, which is due to the fact that the PURE attribute is being
propagated too late. (I'm not sure if this problem could show up also
with other attributes, so for now I'm only treating PURE.)

Regtested on x86_64-unknown-linux-gnu. Ok for trunk?

Cheers,
Janus


2013-12-22  Janus Weil  <ja...@gcc.gnu.org>

    PR fortran/59547
    * class.c (add_proc_comp): Copy pure attribute.

2013-12-22  Janus Weil  <ja...@gcc.gnu.org>

    PR fortran/59547
    * gfortran.dg/typebound_proc_32.f90: New.
Index: gcc/fortran/class.c
===================================================================
--- gcc/fortran/class.c (revision 206161)
+++ gcc/fortran/class.c (working copy)
@@ -714,9 +714,11 @@ add_proc_comp (gfc_symbol *vtype, const char *name
 
   if (tb->u.specific)
     {
-      c->ts.interface = tb->u.specific->n.sym;
+      gfc_symbol *ifc = tb->u.specific->n.sym;
+      c->ts.interface = ifc;
       if (!tb->deferred)
        c->initializer = gfc_get_variable_expr (tb->u.specific);
+      c->attr.pure = ifc->attr.pure;
     }
 }
 
! { dg-do compile }
!
! PR 59547: [OOP] Problem with using tbp specification function in multiple class procedures
!
! Contributed by <b...@miller-mohr.de>

module classes

  implicit none

  type :: base_class
   contains
     procedure, nopass :: get_num
     procedure :: get_array, get_array2
  end type

contains

  pure integer function get_num()
    get_num = 2
  end function

  function get_array( this ) result(array)
    class(base_class), intent(in) :: this
    integer, dimension( this%get_num() ) :: array
  end function

  function get_array2( this ) result(array)
    class(base_class), intent(in) :: this
    integer, dimension( this%get_num(), this%get_num() ) :: array
  end function

end module

! { dg-final { cleanup-modules "classes" } }

Reply via email to