1! RUN: %S/test_errors.sh %s %t %flang_fc1
2! REQUIRES: shell
3! C750 Each bound in the explicit-shape-spec shall be a specification
4! expression in which there are no references to specification functions or
5! the intrinsic functions ALLOCATED, ASSOCIATED, EXTENDS_TYPE_OF, PRESENT,
6! or SAME_TYPE_AS, every specification inquiry reference is a constant
7! expression, and the value does not depend on the value of a variable.
8!
9! C754 Each type-param-value within a component-def-stmt shall be a colon or
10! a specification expression in which there are no references to specification
11! functions or the intrinsic functions ALLOCATED, ASSOCIATED, EXTENDS_TYPE_OF,
12! PRESENT, or SAME_TYPE_AS, every specification inquiry reference is a
13! constant expression, and the value does not depend on the value of a variable.
14impure function impureFunc()
15  integer :: impureFunc
16
17  impureFunc = 3
18end function impureFunc
19
20pure function pureFunc()
21  integer :: pureFunc
22
23  pureFunc = 3
24end function pureFunc
25
26module m
27  real, allocatable :: mVar
28end module m
29
30subroutine s(iArg, allocArg, pointerArg, arrayArg, ioArg, optionalArg)
31! C750
32  use m
33  implicit logical(l)
34  integer, intent(in) :: iArg
35  real, allocatable, intent(in) :: allocArg
36  real, pointer, intent(in) :: pointerArg
37  integer, dimension(:), intent(in) :: arrayArg
38  integer, intent(inout) :: ioArg
39  real, optional, intent(in) :: optionalArg
40
41  ! These declarations are OK since they're not in a derived type
42  real :: realVar
43  real, volatile :: volatileVar
44  real, dimension(merge(1, 2, allocated(allocArg))) :: realVar1
45  real, dimension(merge(1, 2, associated(pointerArg))) :: realVar2
46  real, dimension(merge(1, 2, is_contiguous(arrayArg))) :: realVar3
47  real, dimension(ioArg) :: realVar4
48  real, dimension(merge(1, 2, present(optionalArg))) :: realVar5
49
50  ! statement functions referenced below
51  iVolatileStmtFunc() = 3 * volatileVar
52  iImpureStmtFunc() = 3 * impureFunc()
53  iPureStmtFunc() = 3 * pureFunc()
54
55  ! This is OK
56  real, dimension(merge(1, 2, allocated(mVar))) :: rVar
57
58
59  integer :: var = 3
60    !ERROR: Invalid specification expression: reference to impure function 'ivolatilestmtfunc'
61  real, dimension(iVolatileStmtFunc()) :: arrayVarWithVolatile
62    !ERROR: Invalid specification expression: reference to impure function 'iimpurestmtfunc'
63  real, dimension(iImpureStmtFunc()) :: arrayVarWithImpureFunction
64    !ERROR: Invalid specification expression: reference to statement function 'ipurestmtfunc'
65  real, dimension(iPureStmtFunc()) :: arrayVarWithPureFunction
66  real, dimension(iabs(iArg)) :: arrayVarWithIntrinsic
67
68  type arrayType
69    !ERROR: Invalid specification expression: derived type component or type parameter value not allowed to reference variable 'var'
70    real, dimension(var) :: varField
71    !ERROR: Invalid specification expression: reference to impure function 'ivolatilestmtfunc'
72    real, dimension(iVolatileStmtFunc()) :: arrayFieldWithVolatile
73    !ERROR: Invalid specification expression: reference to impure function 'iimpurestmtfunc'
74    real, dimension(iImpureStmtFunc()) :: arrayFieldWithImpureFunction
75    !ERROR: Invalid specification expression: reference to statement function 'ipurestmtfunc'
76    real, dimension(iPureStmtFunc()) :: arrayFieldWithPureFunction
77    !ERROR: Invalid specification expression: derived type component or type parameter value not allowed to reference variable 'iarg'
78    real, dimension(iabs(iArg)) :: arrayFieldWithIntrinsic
79    !ERROR: Invalid specification expression: reference to intrinsic 'allocated' not allowed for derived type components or type parameter values
80    real, dimension(merge(1, 2, allocated(allocArg))) :: realField1
81    !ERROR: Invalid specification expression: reference to intrinsic 'associated' not allowed for derived type components or type parameter values
82    real, dimension(merge(1, 2, associated(pointerArg))) :: realField2
83    !ERROR: Invalid specification expression: non-constant reference to inquiry intrinsic 'is_contiguous' not allowed for derived type components or type parameter values
84    real, dimension(merge(1, 2, is_contiguous(arrayArg))) :: realField3
85    !ERROR: Invalid specification expression: derived type component or type parameter value not allowed to reference variable 'ioarg'
86    real, dimension(ioArg) :: realField4
87    !ERROR: Invalid specification expression: reference to intrinsic 'present' not allowed for derived type components or type parameter values
88    real, dimension(merge(1, 2, present(optionalArg))) :: realField5
89  end type arrayType
90
91end subroutine s
92
93subroutine s1()
94  ! C750, check for a constant specification inquiry that's a type parameter
95  ! inquiry which are defined in 9.4.5
96  type derived(kindParam, lenParam)
97    integer, kind :: kindParam = 3
98    integer, len :: lenParam = 3
99  end type
100
101  contains
102    subroutine inner (derivedArg)
103      type(derived), intent(in), dimension(3) :: derivedArg
104      integer :: localInt
105
106      type(derived), parameter :: localderived = derived()
107
108      type localDerivedType
109        ! OK because the specification inquiry is a constant
110        integer, dimension(localDerived%kindParam) :: goodField
111        ! OK because the value of lenParam is constant in this context
112        integer, dimension(derivedArg%lenParam) :: badField
113      end type localDerivedType
114
115      ! OK because we're not defining a component
116      integer, dimension(derivedArg%kindParam) :: localVar
117    end subroutine inner
118end subroutine s1
119
120subroutine s2(iArg, allocArg, pointerArg, arrayArg, optionalArg)
121  ! C754
122  integer, intent(in) :: iArg
123  real, allocatable, intent(in) :: allocArg
124  real, pointer, intent(in) :: pointerArg
125  integer, dimension(:), intent(in) :: arrayArg
126  real, optional, intent(in) :: optionalArg
127
128  type paramType(lenParam)
129    integer, len :: lenParam = 4
130  end type paramType
131
132  type charType
133    !ERROR: Invalid specification expression: derived type component or type parameter value not allowed to reference variable 'iarg'
134    character(iabs(iArg)) :: fieldWithIntrinsic
135    !ERROR: Invalid specification expression: reference to intrinsic 'allocated' not allowed for derived type components or type parameter values
136    character(merge(1, 2, allocated(allocArg))) :: allocField
137    !ERROR: Invalid specification expression: reference to intrinsic 'associated' not allowed for derived type components or type parameter values
138    character(merge(1, 2, associated(pointerArg))) :: assocField
139    !ERROR: Invalid specification expression: non-constant reference to inquiry intrinsic 'is_contiguous' not allowed for derived type components or type parameter values
140    character(merge(1, 2, is_contiguous(arrayArg))) :: contigField
141    !ERROR: Invalid specification expression: reference to intrinsic 'present' not allowed for derived type components or type parameter values
142    character(merge(1, 2, present(optionalArg))) :: presentField
143  end type charType
144
145  type derivedType
146    !ERROR: Invalid specification expression: derived type component or type parameter value not allowed to reference variable 'iarg'
147    type(paramType(iabs(iArg))) :: fieldWithIntrinsic
148    !ERROR: Invalid specification expression: reference to intrinsic 'allocated' not allowed for derived type components or type parameter values
149    type(paramType(merge(1, 2, allocated(allocArg)))) :: allocField
150    !ERROR: Invalid specification expression: reference to intrinsic 'associated' not allowed for derived type components or type parameter values
151    type(paramType(merge(1, 2, associated(pointerArg)))) :: assocField
152    !ERROR: Invalid specification expression: non-constant reference to inquiry intrinsic 'is_contiguous' not allowed for derived type components or type parameter values
153    type(paramType(merge(1, 2, is_contiguous(arrayArg)))) :: contigField
154    !ERROR: Invalid specification expression: reference to intrinsic 'present' not allowed for derived type components or type parameter values
155    type(paramType(merge(1, 2, present(optionalArg)))) :: presentField
156  end type derivedType
157end subroutine s2
158