gcc/testsuite/gfortran.dg/transfer_assumed_size_1.f90

   1 ! { dg-do run }
   2 ! Tests the fix for the regression PR34080, in which the character
   3 ! length of the assumed length arguments to TRANSFER were getting
   4 ! lost.
   5 !
   6 ! Drew McCormack <drewmccormack@mac.com>
   7 !
   8 module TransferBug
   9    type ByteType
  10       private
  11       character(len=1)                                  :: singleByte
  12    end type
  13
  14    type (ByteType), save                                :: BytesPrototype(1)
  15
  16 contains
  17
  18    function StringToBytes(v) result (bytes)
  19       character(len=*), intent(in)                      :: v
  20       type (ByteType)                                   :: bytes(size(transfer(v, BytesPrototype)))
  21       bytes = transfer(v, BytesPrototype)
  22    end function
  23
  24    subroutine BytesToString(bytes, string)
  25       type (ByteType), intent(in)                       :: bytes(:)
  26       character(len=*), intent(out)                     :: string
  27       character(len=1)                                  :: singleChar(1)
  28       integer                                           :: numChars
  29       numChars = size(transfer(bytes,singleChar))
  30       string = ''
  31       string = transfer(bytes, string)
  32       string(numChars+1:) = ''
  33    end subroutine
  34
  35 end module
  36
  37
  38 program main
  39    use TransferBug
  40    character(len=100) :: str
  41    call BytesToString( StringToBytes('Hi'), str )
  42    if (trim(str) .ne. "Hi") call abort ()
  43 end program
  44 ! { dg-final { cleanup-modules "TransferBug" } }
  45