1! { dg-do run }
2! Check that derived type extension is compatible with renaming
3! the parent type and that allocatable components are OK.  At
4! the same time, private type and components are checked.
5!
6! Contributed by Paul Thomas  <pault@gcc.gnu.org>
7!
8module mymod
9  type :: a
10    real, allocatable :: x(:)
11    integer, private :: ia = 0
12  end type a
13  type :: b
14    private
15    real, allocatable :: x(:)
16    integer :: i
17  end type b
18contains
19  function set_b () result (res)
20    type(b) :: res
21    allocate (res%x(2))
22    res%x = [10.0, 20.0]
23    res%i = 1
24  end function
25  subroutine check_b (arg)
26    type(b) :: arg
27    if (any (arg%x /= [10.0, 20.0])) STOP 1
28    if (arg%i /= 1) STOP 2
29  end subroutine
30end module mymod
31
32  use mymod, e => a
33  type, extends(e) :: f
34    integer :: if
35  end type f
36  type, extends(b) :: d
37    integer :: id
38  end type d
39
40  type(f) :: p
41  type(d) :: q
42
43  p = f (x = [1.0, 2.0], if = 3)
44  if (any (p%e%x /= [1.0, 2.0])) STOP 3
45
46  q%b = set_b ()
47  call check_b (q%b)
48  q = d (b = set_b (), id = 99)
49  call check_b (q%b)
50end
51