1! { dg-do compile }
2!
3! PR fortran/57035
4!
5!
6
7subroutine 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)
15end subroutine
16
17subroutine 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)
25end subroutine
26
27subroutine 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)
36end subroutine
37