gcc/testsuite/gfortran.dg/class_allocate_20.f90

   1 ! { dg-do run }
   2 !
   3 ! PR fortran/64921
   4 ! Test that the finalization wrapper procedure get the always_explicit
   5 ! attribute so that the array is not passed without descriptor from
   6 ! T3's finalization wrapper procedure to T2's one.
   7 !
   8 ! Contributed by Mat Cross  <mathewc@nag.co.uk>
   9
  10 Program test
  11   Implicit None
  12   Type :: t1
  13     Integer, Allocatable :: i
  14   End Type
  15   Type :: t2
  16     Integer, Allocatable :: i
  17   End Type
  18   Type, Extends (t1) :: t3
  19     Type (t2) :: j
  20   End Type
  21   Type, Extends (t3) :: t4
  22     Integer, Allocatable :: k
  23   End Type
  24   Call s
  25   Print *, 'ok'
  26 Contains
  27   Subroutine s
  28     Class (t1), Allocatable :: x
  29     Allocate (t4 :: x)
  30   End Subroutine
  31 End Program
  32 ! { dg-output "ok" }