gcc/testsuite/gfortran.dg/deferred_character_15.f90

   1 ! { dg-do run }
   2 !
   3 ! Test the fix for PR69423.
   4 !
   5 ! Contributed by Antony Lewis  <antony@cosmologist.info>
   6 !
   7 program tester
   8   character(LEN=:), allocatable :: S
   9   S= test(2)
  10   if (len(S) .ne. 4) call abort
  11   if (S .ne. "test") call abort
  12   if (allocated (S)) deallocate (S)
  13
  14   S= test2(2)
  15   if (len(S) .ne. 4) call abort
  16   if (S .ne. "test") call abort
  17   if (allocated (S)) deallocate (S)
  18 contains
  19   function test(alen)
  20     character(LEN=:), allocatable :: test
  21     integer alen, i
  22     do i = alen, 1, -1
  23       test = 'test'
  24       exit
  25     end do
  26 !       This line would print nothing when compiled with -O1 and higher.
  27 !       print *, len(test),test
  28     if (len(test) .ne. 4) call abort
  29     if (test .ne. "test") call abort
  30   end function test
  31
  32   function test2(alen) result (test)
  33     character(LEN=:), allocatable :: test
  34     integer alen, i
  35     do i = alen, 1, -1
  36       test = 'test'
  37       exit
  38     end do
  39 !       This worked before the fix.
  40 !       print *, len(test),test
  41     if (len(test) .ne. 4) call abort
  42     if (test .ne. "test") call abort
  43   end function test2
  44 end program tester