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!
8module TransferBug
9   type ByteType
10      private
11      character(len=1)                                  :: singleByte
12   end type
13
14   type (ByteType), save                                :: BytesPrototype(1)
15
16contains
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
35end module
36
37
38program main
39   use TransferBug
40   character(len=100) :: str
41   call BytesToString( StringToBytes('Hi'), str )
42   if (trim(str) .ne. "Hi") call abort ()
43end program
44