gcc/testsuite/gfortran.dg/select_type_35.f03

   1 ! { dg-do run }
   2 !
   3 ! Contributed by Nathanael Huebbe
   4 ! Check fix for PR/70842
   5
   6 program foo
   7
   8   TYPE, ABSTRACT :: t_Intermediate
   9   END TYPE t_Intermediate
  10
  11   type, extends(t_Intermediate) :: t_Foo
  12     character(:), allocatable :: string
  13   end type t_Foo
  14
  15   class(t_Foo), allocatable :: obj
  16
  17   allocate(obj)
  18   obj%string = "blabarfoo"
  19
  20   call bar(obj)
  21
  22   deallocate(obj)
  23 contains
  24   subroutine bar(me)
  25     class(t_Intermediate), target :: me
  26
  27     class(*), pointer :: alias
  28
  29     select type(me)
  30       type is(t_Foo)
  31       if (len(me%string) /= 9) STOP 1
  32     end select
  33
  34     alias => me
  35     select type(alias)
  36       type is(t_Foo)
  37         if (len(alias%string) /= 9) STOP 2
  38     end select
  39   end subroutine bar
  40 end program foo
  41