gcc/testsuite/gfortran.dg/pr107900.f90

   1 ! { dg-do run }
   2 !
   3 ! Contributed by Karl Kaiser  <kaiserkarl31@yahoo.com>
   4 !
   5 program test
   6
   7    class(*), pointer :: ptr1, ptr2(:)
   8    integer, target :: i = 42
   9    integer :: check = 0
  10 ! First with associate name and no selector in select types
  11    associate (c => ptr1)
  12         select type (c)  ! Segfault - vptr not set
  13            type is (integer)
  14               stop 1
  15            class default
  16               check = 1
  17         end select
  18    end associate
  19 ! Now do the same with the array version
  20    associate (c => ptr2)
  21         select type (d =>c)  ! Segfault - vptr not set
  22            type is (integer)
  23               stop 2
  24            class default
  25               check = check + 10
  26         end select
  27    end associate
  28
  29 ! And now with the associate name and selector
  30    associate (c => ptr1)
  31         select type (d => c)  ! Segfault - vptr not set
  32            type is (integer)
  33               stop 3
  34            class default
  35               check = check + 100
  36         end select
  37    end associate
  38 ! Now do the same with the array version
  39 !   ptr2 => NULL()            !This did not fix the problem
  40    associate (c => ptr2)
  41         select type (d => c)  ! Segfault - vptr not set
  42            type is (integer)
  43               stop 4
  44            class default
  45               check = check + 1000
  46         end select
  47    end associate
  48    if (check .ne. 1111) stop 5
  49 end program test