gcc/testsuite/gfortran.dg/extends_4.f03

   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 !
   8 module 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
  18 contains
  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])) call abort
  28     if (arg%i /= 1) call abort
  29   end subroutine
  30 end 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])) call abort
  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)
  50 end