Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/gfortran.dg/no_arg_check_3.f90 @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
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