gcc/testsuite/gfortran.dg/class_result_6.f90

   1 ! { dg-do run }
   2 !
   3 ! Test the fix for PR79072 comment #12. A description of the problem
   4 ! is to be found in class_result_5.f90.
   5 !
   6 ! Contributed by Neil Carlson  <neil.n.carlson@gmail.com>
   7 !
   8   character(3), target :: a = 'foo'
   9   class(*), pointer :: b
  10   b => ptr()
  11   select type (b)
  12     type is (character(*))
  13       if (a .ne. "bar") call abort
  14   end select
  15 contains
  16   function ptr()
  17     class(*), pointer :: ptr
  18     ptr => a
  19     select type (ptr)
  20       type is (character(*))
  21         ptr = "bar"
  22     end select
  23   end function
  24 end