gcc/testsuite/gfortran.dg/proc_ptr_comp_44.f90

   1 ! { dg-do compile }
   2 ! Test the fix for PR59198, where the field for the component 'term' in
   3 ! the derived type 'decay_gen_t' was not being built.
   4 !
   5 ! Contributed by Juergen Reuter  <juergen.reuter@desy.de>
   6 !
   7 module decays
   8   abstract interface
   9      function obs_unary_int ()
  10      end function obs_unary_int
  11   end interface
  12
  13   type, abstract :: any_config_t
  14    contains
  15      procedure (any_config_final), deferred :: final
  16   end type any_config_t
  17
  18   type :: decay_term_t
  19      type(unstable_t), dimension(:), pointer :: unstable_product => null ()
  20   end type decay_term_t
  21
  22   type, abstract :: decay_gen_t
  23      type(decay_term_t), dimension(:), allocatable :: term
  24      procedure(obs_unary_int),   nopass, pointer :: obs1_int  => null ()
  25   end type decay_gen_t
  26
  27   type, extends (decay_gen_t) :: decay_root_t
  28    contains
  29      procedure :: final => decay_root_final
  30   end type decay_root_t
  31
  32   type, abstract :: rng_t
  33   end type rng_t
  34
  35   type, extends (decay_gen_t) :: decay_t
  36      class(rng_t), allocatable :: rng
  37    contains
  38      procedure :: final => decay_final
  39   end type decay_t
  40
  41   type, extends (any_config_t) :: unstable_config_t
  42    contains
  43      procedure :: final => unstable_config_final
  44   end type unstable_config_t
  45
  46   type :: unstable_t
  47      type(unstable_config_t), pointer :: config => null ()
  48      type(decay_t), dimension(:), allocatable :: decay
  49   end type unstable_t
  50
  51   interface
  52      subroutine any_config_final (object)
  53        import
  54        class(any_config_t), intent(inout) :: object
  55      end subroutine any_config_final
  56   end interface
  57
  58 contains
  59   subroutine decay_root_final (object)
  60     class(decay_root_t), intent(inout) :: object
  61   end subroutine decay_root_final
  62
  63   recursive subroutine decay_final (object)
  64     class(decay_t), intent(inout) :: object
  65   end subroutine decay_final
  66
  67   recursive subroutine unstable_config_final (object)
  68     class(unstable_config_t), intent(inout) :: object
  69   end subroutine unstable_config_final
  70
  71 end module decays