gcc/testsuite/gfortran.dg/assumed_type_5.f90

   1 ! { dg-do compile }
   2 !
   3 ! PR fortran/57035
   4 !
   5 !
   6
   7 subroutine assumed_rank (a)
   8   use iso_c_binding
   9   integer, intent(in), target :: a(..)
  10   integer :: c(1:4)
  11   type(c_ptr) :: xx
  12   c = ubound(c,a) ! { dg-error "Assumed-rank argument at .1. is only permitted as first actual argument to the intrinsic inquiry function ubound" }
  13   c = transfer(a,1) ! { dg-error "Assumed-rank argument at .1. is only permitted as actual argument to intrinsic inquiry functions" }
  14   xx = c_loc(a)
  15 end subroutine
  16
  17 subroutine assumed_type (a)
  18   use iso_c_binding
  19   type(*), intent(in), target :: a
  20   integer :: c(1:4)
  21   type(c_ptr) :: xx
  22   c = ubound(c,a) ! { dg-error "Assumed-type argument at .1. is only permitted as first actual argument to the intrinsic ubound" }
  23   c = transfer(a,1) ! { dg-error "Assumed-type argument at .1. is not permitted as actual argument to the intrinsic transfer" }
  24   xx = c_loc(a)
  25 end subroutine
  26
  27 subroutine no_arg_check (a)
  28   use iso_c_binding
  29   integer, intent(in), target :: a
  30   !gcc$ attributes no_arg_check :: a
  31   integer :: c(1:4)
  32   type(c_ptr) :: xx
  33   c = ubound(c,a) ! { dg-error "Variable with NO_ARG_CHECK attribute at .1. is only permitted as argument to the intrinsic functions C_LOC and PRESENT" }
  34   c = transfer(a,1) ! { dg-error "Variable with NO_ARG_CHECK attribute at .1. is only permitted as argument to the intrinsic functions C_LOC and PRESENT" }
  35   xx = c_loc(a)
  36 end subroutine