1! { dg-do compile } 2! { dg-options "-fcoarray=single" } 3! 4! PR fortran/39505 5! 6! Test NO_ARG_CHECK 7! Copied from assumed_type_2.f90 8! 9subroutine one(a) ! { dg-error "may not have the ALLOCATABLE, CODIMENSION, POINTER or VALUE attribute" } 10!GCC$ attributes NO_ARG_CHECK :: a 11 integer, value :: a 12end subroutine one 13 14subroutine two(a) ! { dg-error "may not have the ALLOCATABLE, CODIMENSION, POINTER or VALUE attribute" } 15!GCC$ attributes NO_ARG_CHECK :: a 16 integer, pointer :: a 17end subroutine two 18 19subroutine three(a) ! { dg-error "may not have the ALLOCATABLE, CODIMENSION, POINTER or VALUE attribute" } 20!GCC$ attributes NO_ARG_CHECK :: a 21 integer, allocatable :: a 22end subroutine three 23 24subroutine four(a) ! { dg-error "may not have the ALLOCATABLE, CODIMENSION, POINTER or VALUE attribute" } 25!GCC$ attributes NO_ARG_CHECK :: a 26 integer :: a[*] 27end subroutine four 28 29subroutine five(a) ! { dg-error "with NO_ARG_CHECK attribute shall either be a scalar or an assumed-size array" } 30!GCC$ attributes NO_ARG_CHECK :: a 31 integer :: a(3) 32end subroutine five 33 34subroutine six() 35!GCC$ attributes NO_ARG_CHECK :: nodum ! { dg-error "with NO_ARG_CHECK attribute shall be a dummy argument" } 36 integer :: nodum 37end subroutine six 38 39subroutine seven(y) 40!GCC$ attributes NO_ARG_CHECK :: y 41 integer :: y(*) 42 call a7(y(3:5)) ! { dg-error "with NO_ARG_CHECK attribute shall not have a subobject reference" } 43contains 44 subroutine a7(x) 45!GCC$ attributes NO_ARG_CHECK :: x 46 integer :: x(*) 47 end subroutine a7 48end subroutine seven 49 50subroutine nine() 51 interface one 52 subroutine okay(x) 53!GCC$ attributes NO_ARG_CHECK :: x 54 integer :: x 55 end subroutine okay 56 end interface 57 interface two 58 subroutine ambig1(x) 59!GCC$ attributes NO_ARG_CHECK :: x 60 integer :: x 61 end subroutine ambig1 62 subroutine ambig2(x) 63!GCC$ attributes NO_ARG_CHECK :: x 64 integer :: x(*) 65 end subroutine ambig2 ! { dg-error "Ambiguous interfaces 'ambig2' and 'ambig1' in generic interface 'two'" } 66 end interface 67 interface three 68 subroutine ambig3(x) 69!GCC$ attributes NO_ARG_CHECK :: x 70 integer :: x 71 end subroutine ambig3 72 subroutine ambig4(x) 73 integer :: x 74 end subroutine ambig4 ! { dg-error "Ambiguous interfaces 'ambig4' and 'ambig3' in generic interface 'three'" } 75 end interface 76end subroutine nine 77 78subroutine ten() 79 interface 80 subroutine bar() 81 end subroutine 82 end interface 83 type t 84 contains 85 procedure, nopass :: proc => bar 86 end type 87 type(t) :: xx 88 call sub(xx) ! { dg-error "is of derived type with type-bound or FINAL procedures" } 89contains 90 subroutine sub(a) 91!GCC$ attributes NO_ARG_CHECK :: a 92 integer :: a 93 end subroutine sub 94end subroutine ten 95 96subroutine eleven(x) 97 external bar 98!GCC$ attributes NO_ARG_CHECK :: x 99 integer :: x 100 call bar(x) ! { dg-error "Assumed-type argument x at .1. requires an explicit interface" } 101end subroutine eleven 102 103subroutine twelf(x) 104!GCC$ attributes NO_ARG_CHECK :: x 105 integer :: x 106 call bar(x) ! { dg-error "Type mismatch in argument" } 107contains 108 subroutine bar(x) 109 integer :: x 110 end subroutine bar 111end subroutine twelf 112 113subroutine thirteen(x, y) 114!GCC$ attributes NO_ARG_CHECK :: x 115 integer :: x 116 integer :: y(:) 117 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" } 118end subroutine thirteen 119 120subroutine fourteen(x) 121!GCC$ attributes NO_ARG_CHECK :: x 122 integer :: x 123 x = x ! { dg-error "with NO_ARG_CHECK attribute may only be used as actual argument" } 124end subroutine fourteen 125