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 <pa...@gcc.gnu.org> 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 <pa...@gcc.gnu.org> 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 <juergen.reu...@desy.de> + ! + 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 <juergen.reu...@desy.de> + ! + 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