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