gcc/testsuite/gfortran.dg/extends_type_of_2.f03

   1 ! { dg-do run }
   2 !
   3 ! PR 47180: [OOP] EXTENDS_TYPE_OF returns the wrong result for disassociated polymorphic pointers
   4 !
   5 ! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
   6
   7 implicit none
   8
   9 type t1
  10   integer :: a
  11 end type t1
  12
  13 type, extends(t1):: t11
  14   integer :: b
  15 end type t11
  16
  17 type(t1)  , target  :: a1
  18 type(t11) , target  :: a11
  19 class(t1) , pointer :: b1
  20 class(t11), pointer :: b11
  21
  22 b1  => NULL()
  23 b11 => NULL()
  24
  25 if (.not. extends_type_of(b1 , a1)) call abort()
  26 if (.not. extends_type_of(b11, a1)) call abort()
  27 if (.not. extends_type_of(b11,a11)) call abort()
  28
  29 b1  => a1
  30 b11 => a11
  31
  32 if (.not. extends_type_of(b1 , a1)) call abort()
  33 if (.not. extends_type_of(b11, a1)) call abort()
  34 if (.not. extends_type_of(b11,a11)) call abort()
  35
  36 end