Dear All,
As will be apparent from the PR, I have spent a silly amount of time
on this one :-( Once I became 'de-obsessed' with the fact that the
reduced testcase worked, when 'rng' was made a pointer and
concentrated on the procedure pointer component 'obs1_int', finding
the problem was rather more straightforward, even if not 'obvious'.
The ChangeLog says it all. If the check is not done for components
that are not procedure pointers,
typebound_operator_9.f03 breaks. I am not entirely sure why this is
the case but the fix works fine.
Bootstraps and regtests on FC21/x86_64 - OK for 4.8, 4.9 and 5.0?
Paul
2014-03-15 Paul Thomas <[email protected]>
PR fortran/59198
* trans-types.c (gfc_get_derived_type): If an abstract derived
type with procedure pointer components has no other type of
component, return the backend_decl directly. Otherwise build
the components.
2014-03-15 Paul Thomas <[email protected]>
PR fortran/59198
* gfortran.dg/proc_ptr_comp_44.f90 : New test
* gfortran.dg/proc_ptr_comp_45.f90 : New test
Index: gcc/fortran/trans-types.c
===================================================================
*** gcc/fortran/trans-types.c (revision 221333)
--- gcc/fortran/trans-types.c (working copy)
*************** gfc_get_derived_type (gfc_symbol * deriv
*** 2448,2456 ****
/* Its components' backend_decl have been built or we are
seeing recursion through the formal arglist of a procedure
pointer component. */
! if (TYPE_FIELDS (derived->backend_decl)
! || derived->attr.proc_pointer_comp)
return derived->backend_decl;
else
typenode = derived->backend_decl;
}
--- 2448,2469 ----
/* Its components' backend_decl have been built or we are
seeing recursion through the formal arglist of a procedure
pointer component. */
! if (TYPE_FIELDS (derived->backend_decl))
return derived->backend_decl;
+ else if (derived->attr.proc_pointer_comp && derived->attr.abstract)
+ {
+ /* If an abstract derived type with procedure pointer components
+ has no other type of component, return the backend_decl.
+ Otherwise build the components. */
+ for (c = derived->components; c; c = c->next)
+ {
+ if (!c->attr.proc_pointer)
+ break;
+ else if (c->next == NULL)
+ return derived->backend_decl;
+ }
+ typenode = derived->backend_decl;
+ }
else
typenode = derived->backend_decl;
}
Index: gcc/testsuite/gfortran.dg/proc_ptr_comp_44.f90
===================================================================
*** gcc/testsuite/gfortran.dg/proc_ptr_comp_44.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/proc_ptr_comp_44.f90 (working copy)
***************
*** 0 ****
--- 1,71 ----
+ ! { dg-do compile }
+ ! Test the fix for PR59198, where the field for the component 'term' in
+ ! the derived type 'decay_gen_t' was not being built.
+ !
+ ! Contributed by Juergen Reuter <[email protected]>
+ !
+ module decays
+ abstract interface
+ function obs_unary_int ()
+ end function obs_unary_int
+ end interface
+
+ type, abstract :: any_config_t
+ contains
+ procedure (any_config_final), deferred :: final
+ end type any_config_t
+
+ type :: decay_term_t
+ type(unstable_t), dimension(:), pointer :: unstable_product => null ()
+ end type decay_term_t
+
+ type, abstract :: decay_gen_t
+ type(decay_term_t), dimension(:), allocatable :: term
+ procedure(obs_unary_int), nopass, pointer :: obs1_int => null ()
+ end type decay_gen_t
+
+ type, extends (decay_gen_t) :: decay_root_t
+ contains
+ procedure :: final => decay_root_final
+ end type decay_root_t
+
+ type, abstract :: rng_t
+ end type rng_t
+
+ type, extends (decay_gen_t) :: decay_t
+ class(rng_t), allocatable :: rng
+ contains
+ procedure :: final => decay_final
+ end type decay_t
+
+ type, extends (any_config_t) :: unstable_config_t
+ contains
+ procedure :: final => unstable_config_final
+ end type unstable_config_t
+
+ type :: unstable_t
+ type(unstable_config_t), pointer :: config => null ()
+ type(decay_t), dimension(:), allocatable :: decay
+ end type unstable_t
+
+ interface
+ subroutine any_config_final (object)
+ import
+ class(any_config_t), intent(inout) :: object
+ end subroutine any_config_final
+ end interface
+
+ contains
+ subroutine decay_root_final (object)
+ class(decay_root_t), intent(inout) :: object
+ end subroutine decay_root_final
+
+ recursive subroutine decay_final (object)
+ class(decay_t), intent(inout) :: object
+ end subroutine decay_final
+
+ recursive subroutine unstable_config_final (object)
+ class(unstable_config_t), intent(inout) :: object
+ end subroutine unstable_config_final
+
+ end module decays
Index: gcc/testsuite/gfortran.dg/proc_ptr_comp_45.f90
===================================================================
*** gcc/testsuite/gfortran.dg/proc_ptr_comp_45.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/proc_ptr_comp_45.f90 (working copy)
***************
*** 0 ****
--- 1,49 ----
+ ! { dg-do run }
+ ! Test the fix for PR59198, where the field for the component 'term' in
+ ! the derived type 'decay_gen_t' was not being built.
+ !
+ ! Contributed by Paul Thomas and based on the original testcase by
+ ! Juergen Reuter <[email protected]>
+ !
+ module decays
+
+ implicit none
+
+ interface
+ real elemental function iface (arg)
+ real, intent(in) :: arg
+ end function
+ end interface
+
+ type :: decay_term_t
+ type(decay_t), pointer :: unstable_product
+ integer :: i
+ end type
+
+ type :: decay_gen_t
+ procedure(iface), nopass, pointer :: obs1_int
+ type(decay_term_t), allocatable :: term
+ end type
+
+ type :: rng_t
+ integer :: i
+ end type
+
+ type, extends (decay_gen_t) :: decay_t
+ class(rng_t), allocatable :: rng
+ end type
+
+ class(decay_t), allocatable :: object
+
+ end
+
+ use decays
+ type(decay_t), pointer :: template
+ real, parameter :: arg = 1.570796327
+ allocate (template)
+ allocate (template%rng)
+ template%obs1_int => cos
+ if (template%obs1_int (arg) .ne. cos (arg)) call abort
+ allocate (object, source = template)
+ if (object%obs1_int (arg) .ne. cos (arg)) call abort
+ end
