1! { dg-do compile }
2! { dg-options "-fdump-tree-optimized -O" }
3!
4! PR fortran/46974
5
6program test
7  use ISO_C_BINDING
8  implicit none
9  type(c_ptr) :: m
10  integer(c_intptr_t) :: a
11  integer(transfer(transfer(4_c_intptr_t, c_null_ptr),1_c_intptr_t)) :: b
12  a = transfer (transfer("ABCE", m), 1_c_intptr_t)
13  print '(z8)', a
14  if (     int(z'45434241') /= a  &
15     .and. int(z'41424345') /= a  &
16     .and. int(z'4142434500000000',kind=8) /= a) &
17    call i_do_not_exist()
18end program test
19
20! Examples contributed by Steve Kargl and James Van Buskirk
21
22subroutine bug1
23   use ISO_C_BINDING
24   implicit none
25   type(c_ptr) :: m
26   type mytype
27     integer a, b, c
28   end type mytype
29   type(mytype) x
30   print *, transfer(32512, x)  ! Works.
31   print *, transfer(32512, m)  ! Caused ICE.
32end subroutine bug1
33
34subroutine bug6
35   use ISO_C_BINDING
36   implicit none
37   interface
38      function fun()
39         use ISO_C_BINDING
40         implicit none
41         type(C_FUNPTR) fun
42      end function fun
43   end interface
44   type(C_PTR) array(2)
45   type(C_FUNPTR) result
46   integer(C_INTPTR_T), parameter :: const(*) = [32512,32520]
47
48   result = fun()
49   array = transfer([integer(C_INTPTR_T)::32512,32520],array)
50!   write(*,*) transfer(result,const)
51!   write(*,*) transfer(array,const)
52end subroutine bug6
53
54function fun()
55   use ISO_C_BINDING
56   implicit none
57   type(C_FUNPTR) fun
58   fun = transfer(32512_C_INTPTR_T,fun)
59end function fun
60
61! { dg-final { scan-tree-dump-times "i_do_not_exist" 0 "optimized" } }
62! { dg-final { cleanup-tree-dump "optimized" } }
63