gcc/testsuite/gfortran.dg/char_pointer_func.f90

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