gcc/testsuite/gfortran.dg/associated_target_4.f90

   1 ! { dg-do run }
   2 !
   3 ! PR 44696: [OOP] ASSOCIATED fails on polymorphic variables
   4 !
   5 ! Original test case by Hans-Werner Boschmann <boschmann@tp1.physik.uni-siegen.de>
   6 ! Modified by Janus Weil <janus@gcc.gnu.org>
   7
   8 program rte1
   9   implicit none
  10   type::node_type
  11      class(node_type),pointer::parent,child
  12      integer::id
  13   end type node_type
  14   class(node_type),pointer::root
  15   allocate(root)
  16   allocate(root%child)
  17   root%child%parent=>root
  18   root%id=1
  19   root%child%id=2
  20   print *,root%child%id," is child of ",root%id,":"
  21   print *,root%child%parent%id,root%id
  22   if (.not. associated(root%child%parent,root)) call abort()
  23 end program rte1