gcc/testsuite/gfortran.dg/proc_ptr_comp_45.f90

   1 ! { dg-do run }
   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 Paul Thomas and based on the original testcase by
   6 ! Juergen Reuter  <juergen.reuter@desy.de>
   7 !
   8 module decays
   9
  10   implicit none
  11
  12   interface
  13     real elemental function iface (arg)
  14       real, intent(in) :: arg
  15     end function
  16   end interface
  17
  18   type :: decay_term_t
  19      type(decay_t), pointer :: unstable_product
  20      integer :: i
  21   end type
  22
  23   type :: decay_gen_t
  24      procedure(iface), nopass, pointer :: obs1_int
  25      type(decay_term_t), allocatable :: term
  26   end type
  27
  28   type :: rng_t
  29     integer :: i
  30   end type
  31
  32   type, extends (decay_gen_t) :: decay_t
  33      class(rng_t), allocatable :: rng
  34   end type
  35
  36   class(decay_t), allocatable :: object
  37
  38 end
  39
  40   use decays
  41   type(decay_t), pointer :: template
  42   real, parameter :: arg = 1.570796327
  43   allocate (template)
  44   allocate (template%rng)
  45   template%obs1_int => cos
  46   if (abs (template%obs1_int (arg) - cos (arg)) .gt. 1e-4) STOP 1
  47   allocate (object, source = template)
  48   if (abs (object%obs1_int (arg) - cos (arg)) .gt. 1e-4) STOP 2
  49 end