gcc/testsuite/gfortran.dg/select_type_44.f90

   1 ! { dg-do run }
   2 !
   3 ! Test the fix for PR87566
   4 !
   5 ! Contributed by Antony Lewis  <antony@cosmologist.info>
   6 !
   7   call AddArray
   8 contains
   9   subroutine AddArray()
  10     type Object_array_pointer
  11         class(*), pointer :: p(:) => null()
  12     end type Object_array_pointer
  13     class(*), pointer :: Pt => null()
  14     type (Object_array_pointer) :: obj
  15     character(3), target :: tgt1(2) = ['one','two']
  16     character(5), target :: tgt2(2) = ['three','four ']
  17
  18     allocate (Pt, source = Object_array_pointer ())
  19     select type (Pt)
  20       type is (object_array_pointer)
  21         Pt%p => tgt1
  22     end select
  23
  24     select type (Pt)
  25       class is (object_array_pointer)
  26         select type (Point=> Pt%P)
  27           type is (character(*))
  28             if (any (Point .ne. tgt1)) stop 1
  29             Point = ['abc','efg']
  30         end select
  31     end select
  32
  33     select type (Pt)
  34       class is (object_array_pointer)
  35         select type (Point=> Pt%P)
  36           type is (character(*))
  37             if (any (Point .ne. ['abc','efg'])) stop 2
  38         end select
  39     end select
  40
  41   end subroutine AddArray
  42 end