Subversion Repositories openrisc

! { dg-do compile }

! { dg-options "-fdump-tree-optimized -O" }

!

! PR fortran/46974

program test

  use ISO_C_BINDING

  implicit none

  type(c_ptr) :: m

  integer(c_intptr_t) :: a

  integer(transfer(transfer(4_c_intptr_t, c_null_ptr),1_c_intptr_t)) :: b

  a = transfer (transfer("ABCE", m), 1_c_intptr_t)

  print '(z8)', a

  if (     int(z'45434241') /= a  &

     .and. int(z'41424345') /= a  &

     .and. int(z'4142434500000000',kind=8) /= a) &

    call i_do_not_exist()

end program test

! Examples contributed by Steve Kargl and James Van Buskirk

subroutine bug1

   use ISO_C_BINDING

   implicit none

   type(c_ptr) :: m

   type mytype

     integer a, b, c

   end type mytype

   type(mytype) x

   print *, transfer(32512, x)  ! Works.

   print *, transfer(32512, m)  ! Caused ICE.

end subroutine bug1

subroutine bug6

   use ISO_C_BINDING

   implicit none

   interface

      function fun()

         use ISO_C_BINDING

         implicit none

         type(C_FUNPTR) fun

      end function fun

   end interface

   type(C_PTR) array(2)

   type(C_FUNPTR) result

   integer(C_INTPTR_T), parameter :: const(*) = [32512,32520]

   result = fun()

   array = transfer([integer(C_INTPTR_T)::32512,32520],array)

!   write(*,*) transfer(result,const)

!   write(*,*) transfer(array,const)

end subroutine bug6

function fun()

   use ISO_C_BINDING

   implicit none

   type(C_FUNPTR) fun

   fun = transfer(32512_C_INTPTR_T,fun)

end function fun

! { dg-final { scan-tree-dump-times "i_do_not_exist" 0 "optimized" } }

! { dg-final { cleanup-tree-dump "optimized" } }