gcc/testsuite/gfortran.dg/transfer_intrinsic_2.f90

   1 ! { dg-do run }
   2 !
   3 ! Check the fix for PR34955 in which three bytes would be copied
   4 ! from bytes by TRANSFER, instead of the required two and the
   5 ! resulting string length would be incorrect.
   6 !
   7 ! Contributed by Dominique Dhumieres  <dominiq@lps.ens.fr>
   8 !
   9   character(len = 1)  :: string = "z"
  10   character(len = 20) :: tmp = ""
  11   tmp = Upper ("abcdefgh")
  12   if (trim(tmp) .ne. "ab") STOP 1
  13 contains
  14   Character (len = 20) Function Upper (string)
  15     Character(len = *) string
  16     integer :: ij
  17     i = size (transfer (string,"xy",len (string)))
  18     if (i /= len (string)) STOP 2
  19     Upper = ""
  20     Upper(1:2) = &
  21     transfer (merge (transfer (string,"xy",len (string)),    &
  22       string(1:2), .true.), "xy")
  23     return
  24   end function Upper
  25 end