| ! { 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 |