|
111
|
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 !
|
|
|
9 subroutine 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
|
|
|
12 end subroutine one
|
|
|
13
|
|
|
14 subroutine 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
|
|
|
17 end subroutine two
|
|
|
18
|
|
|
19 subroutine 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
|
|
|
22 end subroutine three
|
|
|
23
|
|
|
24 subroutine four(a) ! { dg-error "may not have the ALLOCATABLE, CODIMENSION, POINTER or VALUE attribute" }
|
|
|
25 !GCC$ attributes NO_ARG_CHECK :: a
|
|
|
26 integer :: a[*]
|
|
|
27 end subroutine four
|
|
|
28
|
|
|
29 subroutine 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)
|
|
|
32 end subroutine five
|
|
|
33
|
|
|
34 subroutine six()
|
|
|
35 !GCC$ attributes NO_ARG_CHECK :: nodum ! { dg-error "with NO_ARG_CHECK attribute shall be a dummy argument" }
|
|
|
36 integer :: nodum
|
|
|
37 end subroutine six
|
|
|
38
|
|
|
39 subroutine 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" }
|
|
|
43 contains
|
|
|
44 subroutine a7(x)
|
|
|
45 !GCC$ attributes NO_ARG_CHECK :: x
|
|
|
46 integer :: x(*)
|
|
|
47 end subroutine a7
|
|
|
48 end subroutine seven
|
|
|
49
|
|
|
50 subroutine 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) ! { dg-error "Ambiguous interfaces" }
|
|
|
59 !GCC$ attributes NO_ARG_CHECK :: x
|
|
|
60 integer :: x
|
|
|
61 end subroutine ambig1
|
|
|
62 subroutine ambig2(x) ! { dg-error "Ambiguous interfaces" }
|
|
|
63 !GCC$ attributes NO_ARG_CHECK :: x
|
|
|
64 integer :: x(*)
|
|
|
65 end subroutine ambig2
|
|
|
66 end interface
|
|
|
67 interface three
|
|
|
68 subroutine ambig3(x) ! { dg-error "Ambiguous interfaces" }
|
|
|
69 !GCC$ attributes NO_ARG_CHECK :: x
|
|
|
70 integer :: x
|
|
|
71 end subroutine ambig3
|
|
|
72 subroutine ambig4(x) ! { dg-error "Ambiguous interfaces" }
|
|
|
73 integer :: x
|
|
|
74 end subroutine ambig4
|
|
|
75 end interface
|
|
|
76 end subroutine nine
|
|
|
77
|
|
|
78 subroutine 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" }
|
|
|
89 contains
|
|
|
90 subroutine sub(a)
|
|
|
91 !GCC$ attributes NO_ARG_CHECK :: a
|
|
|
92 integer :: a
|
|
|
93 end subroutine sub
|
|
|
94 end subroutine ten
|
|
|
95
|
|
|
96 subroutine 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" }
|
|
|
101 end subroutine eleven
|
|
|
102
|
|
|
103 subroutine twelf(x)
|
|
|
104 !GCC$ attributes NO_ARG_CHECK :: x
|
|
|
105 integer :: x
|
|
|
106 call bar(x) ! { dg-error "Type mismatch in argument" }
|
|
|
107 contains
|
|
|
108 subroutine bar(x)
|
|
|
109 integer :: x
|
|
|
110 end subroutine bar
|
|
|
111 end subroutine twelf
|
|
|
112
|
|
|
113 subroutine 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" }
|
|
|
118 end subroutine thirteen
|
|
|
119
|
|
|
120 subroutine 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" }
|
|
|
124 end subroutine fourteen
|
