blob: 3a95d0eff05c39cf2bc012ce3fe7602dc29b71e8 [file] [log] [blame]
! { dg-do compile }
! { dg-options "-fcoarray=single" }
!
! PR fortran/39505
!
! Test NO_ARG_CHECK
! Copied from assumed_type_2.f90
!
subroutine one(a) ! { dg-error "may not have the ALLOCATABLE, CODIMENSION, POINTER or VALUE attribute" }
!GCC$ attributes NO_ARG_CHECK :: a
integer, value :: a
end subroutine one
subroutine two(a) ! { dg-error "may not have the ALLOCATABLE, CODIMENSION, POINTER or VALUE attribute" }
!GCC$ attributes NO_ARG_CHECK :: a
integer, pointer :: a
end subroutine two
subroutine three(a) ! { dg-error "may not have the ALLOCATABLE, CODIMENSION, POINTER or VALUE attribute" }
!GCC$ attributes NO_ARG_CHECK :: a
integer, allocatable :: a
end subroutine three
subroutine four(a) ! { dg-error "may not have the ALLOCATABLE, CODIMENSION, POINTER or VALUE attribute" }
!GCC$ attributes NO_ARG_CHECK :: a
integer :: a[*]
end subroutine four
subroutine five(a) ! { dg-error "with NO_ARG_CHECK attribute shall either be a scalar or an assumed-size array" }
!GCC$ attributes NO_ARG_CHECK :: a
integer :: a(3)
end subroutine five
subroutine six()
!GCC$ attributes NO_ARG_CHECK :: nodum ! { dg-error "with NO_ARG_CHECK attribute shall be a dummy argument" }
integer :: nodum
end subroutine six
subroutine seven(y)
!GCC$ attributes NO_ARG_CHECK :: y
integer :: y(*)
call a7(y(3:5)) ! { dg-error "with NO_ARG_CHECK attribute shall not have a subobject reference" }
contains
subroutine a7(x)
!GCC$ attributes NO_ARG_CHECK :: x
integer :: x(*)
end subroutine a7
end subroutine seven
subroutine nine()
interface one
subroutine okay(x)
!GCC$ attributes NO_ARG_CHECK :: x
integer :: x
end subroutine okay
end interface
interface two
subroutine ambig1(x) ! { dg-error "Ambiguous interfaces" }
!GCC$ attributes NO_ARG_CHECK :: x
integer :: x
end subroutine ambig1
subroutine ambig2(x) ! { dg-error "Ambiguous interfaces" }
!GCC$ attributes NO_ARG_CHECK :: x
integer :: x(*)
end subroutine ambig2
end interface
interface three
subroutine ambig3(x) ! { dg-error "Ambiguous interfaces" }
!GCC$ attributes NO_ARG_CHECK :: x
integer :: x
end subroutine ambig3
subroutine ambig4(x) ! { dg-error "Ambiguous interfaces" }
integer :: x
end subroutine ambig4
end interface
end subroutine nine
subroutine ten()
interface
subroutine bar()
end subroutine
end interface
type t
contains
procedure, nopass :: proc => bar
end type
type(t) :: xx
call sub(xx) ! { dg-error "is of derived type with type-bound or FINAL procedures" }
contains
subroutine sub(a)
!GCC$ attributes NO_ARG_CHECK :: a
integer :: a
end subroutine sub
end subroutine ten
subroutine eleven(x)
external bar
!GCC$ attributes NO_ARG_CHECK :: x
integer :: x
call bar(x) ! { dg-error "Assumed-type argument x at .1. requires an explicit interface" }
end subroutine eleven
subroutine twelf(x)
!GCC$ attributes NO_ARG_CHECK :: x
integer :: x
call bar(x) ! { dg-error "Type mismatch in argument" }
contains
subroutine bar(x)
integer :: x
end subroutine bar
end subroutine twelf
subroutine thirteen(x, y)
!GCC$ attributes NO_ARG_CHECK :: x
integer :: x
integer :: y(:)
print *, ubound(y, dim=x) ! { dg-error "Variable with NO_ARG_CHECK attribute at .1. is only permitted as argument to the intrinsic functions C_LOC and PRESENT" }
end subroutine thirteen
subroutine fourteen(x)
!GCC$ attributes NO_ARG_CHECK :: x
integer :: x
x = x ! { dg-error "with NO_ARG_CHECK attribute may only be used as actual argument" }
end subroutine fourteen