gcc/testsuite/gfortran.dg/char_pointer_func.f90

   1 ! { dg-do run }
   2 program char_pointer_func
   3 ! Test assignments from character pointer functions, required
   4 ! to fix PR17192 and PR17202
   5 ! Provided by Paul Thomas pault@gcc.gnu.org
   6   implicit none
   7   character*4                :: c0
   8   character*4, pointer       :: c1
   9   character*4, pointer       :: c2(:)
  10   allocate (c1, c2(1))
  11 ! Check that we have not broken non-pointer characters.
  12   c0 = foo ()
  13   if (c0 /= "abcd") call abort ()
  14 ! Value assignments
  15   c1 = sfoo ()
  16   if (c1 /= "abcd") call abort ()
  17   c2 = afoo (c0)
  18   if (c2(1) /= "abcd") call abort ()
  19   deallocate (c1, c2)
  20 ! Pointer assignments
  21   c1 => sfoo ()
  22   if (c1 /= "abcd") call abort ()
  23   c2 => afoo (c0)
  24   if (c2(1) /= "abcd") call abort ()
  25   deallocate (c1, c2)
  26 contains
  27   function foo () result (cc1)
  28     character*4                :: cc1
  29     cc1 = "abcd"
  30   end function foo
  31   function sfoo () result (sc1)
  32     character*4, pointer       :: sc1
  33     allocate (sc1)
  34     sc1 = "abcd"
  35   end function sfoo
  36   function afoo (c0) result (ac1)
  37     character*4                :: c0
  38     character*4, pointer       :: ac1(:)
  39     allocate (ac1(1))
  40     ac1 = "abcd"
  41   end function afoo
  42 end program char_pointer_func