1! { dg-do compile }
2! Tests the  fix for PR31424.
3!
4module InternalCompilerError
5
6   type Byte
7      private
8      character(len=1)     :: singleByte
9   end type
10
11   type (Byte)             :: BytesPrototype(1)
12
13   type UserType
14      real :: r
15   end type
16
17contains
18
19   function UserTypeToBytes(user) result (bytes)
20      type(UserType) :: user
21      type(Byte)     :: bytes(size(transfer(user, BytesPrototype)))
22      bytes = transfer(user, BytesPrototype)
23   end function
24
25   subroutine DoSomethingWithBytes(bytes)
26      type(Byte), intent(in)     :: bytes(:)
27   end subroutine
28
29end module
30
31
32program main
33   use InternalCompilerError
34   type (UserType) :: user
35
36   ! The following line caused the ICE
37   call DoSomethingWithBytes( UserTypeToBytes(user) )
38
39end program
40