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!
7module 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
58contains
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
71end module decays
72