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