gcc/testsuite/gfortran.dg/associate_42.f90

   1 ! { dg-do run }
   2 !
   3 ! Tests the fix for a bug that was found in the course of fixing PR87566.
   4 !
   5 ! Contributed by Paul Thomas  <pault@gcc.gnu.org>
   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
  14     type (Object_array_pointer) :: obj
  15     character(3), target :: tgt1(2) = ['one','two']
  16     character(5), target :: tgt2(2) = ['three','four ']
  17     real, target :: tgt3(3) = [1.0,2.0,3.0]
  18
  19     obj%p => tgt1
  20     associate (point => obj%p)
  21       select type (point)         ! Used to ICE here.
  22         type is (character(*))
  23           if (any (point .ne. tgt1)) stop 1
  24       end select
  25       point => tgt2
  26     end associate
  27
  28     select type (z => obj%p)
  29       type is (character(*))
  30         if (any (z .ne. tgt2)) stop 2
  31     end select
  32
  33     obj%p => tgt3
  34     associate (point => obj%p)
  35       select type (point)
  36         type is (real)
  37           if (any (point .ne. tgt3)) stop 3
  38       end select
  39     end associate
  40   end subroutine AddArray
  41 end