aboutsummaryrefslogtreecommitdiff
blob: eaa902bf54ebc571982e4d9d672c0101ee1c4d8f (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
! RUN: %S/test_errors.sh %s %t %f18
! C750 Each bound in the explicit-shape-spec shall be a specification
! expression in which there are no references to specification functions or
! the intrinsic functions ALLOCATED, ASSOCIATED, EXTENDS_TYPE_OF, PRESENT,
! or SAME_TYPE_AS, every specification inquiry reference is a constant
! expression, and the value does not depend on the value of a variable.
!
! C754 Each type-param-value within a component-def-stmt shall be a colon or 
! a specification expression in which there are no references to specification 
! functions or the intrinsic functions ALLOCATED, ASSOCIATED, EXTENDS_TYPE_OF,
! PRESENT, or SAME_TYPE_AS, every specification inquiry reference is a 
! constant expression, and the value does not depend on the value of a variable.
impure function impureFunc()
  integer :: impureFunc

  impureFunc = 3
end function impureFunc

pure function pureFunc()
  integer :: pureFunc

  pureFunc = 3
end function pureFunc

module m
  real, allocatable :: mVar
end module m

subroutine s(iArg, allocArg, pointerArg, arrayArg, ioArg, optionalArg)
! C750
  use m
  implicit logical(l)
  integer, intent(in) :: iArg
  real, allocatable, intent(in) :: allocArg
  real, pointer, intent(in) :: pointerArg
  integer, dimension(:), intent(in) :: arrayArg
  integer, intent(inout) :: ioArg
  real, optional, intent(in) :: optionalArg

  ! These declarations are OK since they're not in a derived type
  real :: realVar
  real, volatile :: volatileVar
  real, dimension(merge(1, 2, allocated(allocArg))) :: realVar1
  real, dimension(merge(1, 2, associated(pointerArg))) :: realVar2
  real, dimension(merge(1, 2, is_contiguous(arrayArg))) :: realVar3
  real, dimension(ioArg) :: realVar4
  real, dimension(merge(1, 2, present(optionalArg))) :: realVar5

  ! statement functions referenced below
  iVolatileStmtFunc() = 3 * volatileVar
  iImpureStmtFunc() = 3 * impureFunc()
  iPureStmtFunc() = 3 * pureFunc()

  ! This is OK
  real, dimension(merge(1, 2, allocated(mVar))) :: rVar


  integer :: var = 3
    !ERROR: Invalid specification expression: reference to impure function 'ivolatilestmtfunc'
  real, dimension(iVolatileStmtFunc()) :: arrayVarWithVolatile
    !ERROR: Invalid specification expression: reference to impure function 'iimpurestmtfunc'
  real, dimension(iImpureStmtFunc()) :: arrayVarWithImpureFunction
    !ERROR: Invalid specification expression: reference to statement function 'ipurestmtfunc'
  real, dimension(iPureStmtFunc()) :: arrayVarWithPureFunction
  real, dimension(iabs(iArg)) :: arrayVarWithIntrinsic

  type arrayType
    !ERROR: Invalid specification expression: derived type component or type parameter value not allowed to reference variable 'var'
    real, dimension(var) :: varField
    !ERROR: Invalid specification expression: reference to impure function 'ivolatilestmtfunc'
    real, dimension(iVolatileStmtFunc()) :: arrayFieldWithVolatile
    !ERROR: Invalid specification expression: reference to impure function 'iimpurestmtfunc'
    real, dimension(iImpureStmtFunc()) :: arrayFieldWithImpureFunction
    !ERROR: Invalid specification expression: reference to statement function 'ipurestmtfunc'
    real, dimension(iPureStmtFunc()) :: arrayFieldWithPureFunction
    !ERROR: Invalid specification expression: derived type component or type parameter value not allowed to reference variable 'iarg'
    real, dimension(iabs(iArg)) :: arrayFieldWithIntrinsic
    !ERROR: Invalid specification expression: reference to intrinsic 'allocated' not allowed for derived type components or type parameter values
    real, dimension(merge(1, 2, allocated(allocArg))) :: realField1
    !ERROR: Invalid specification expression: reference to intrinsic 'associated' not allowed for derived type components or type parameter values
    real, dimension(merge(1, 2, associated(pointerArg))) :: realField2
    !ERROR: Invalid specification expression: non-constant reference to inquiry intrinsic 'is_contiguous' not allowed for derived type components or type parameter values
    real, dimension(merge(1, 2, is_contiguous(arrayArg))) :: realField3
    !ERROR: Invalid specification expression: derived type component or type parameter value not allowed to reference variable 'ioarg'
    real, dimension(ioArg) :: realField4
    !ERROR: Invalid specification expression: reference to intrinsic 'present' not allowed for derived type components or type parameter values
    real, dimension(merge(1, 2, present(optionalArg))) :: realField5
  end type arrayType

end subroutine s

subroutine s1()
  ! C750, check for a constant specification inquiry that's a type parameter
  ! inquiry which are defined in 9.4.5
  type derived(kindParam, lenParam)
    integer, kind :: kindParam = 3
    integer, len :: lenParam = 3
  end type

  contains
    subroutine inner (derivedArg)
      type(derived), intent(in), dimension(3) :: derivedArg
      integer :: localInt

      type(derived), parameter :: localderived = derived()

      type localDerivedType
        ! OK because the specification inquiry is a constant
        integer, dimension(localDerived%kindParam) :: goodField
        ! OK because the value of lenParam is constant in this context
        integer, dimension(derivedArg%lenParam) :: badField
      end type localDerivedType

      ! OK because we're not defining a component
      integer, dimension(derivedArg%kindParam) :: localVar
    end subroutine inner
end subroutine s1

subroutine s2(iArg, allocArg, pointerArg, arrayArg, optionalArg)
  ! C754
  integer, intent(in) :: iArg
  real, allocatable, intent(in) :: allocArg
  real, pointer, intent(in) :: pointerArg
  integer, dimension(:), intent(in) :: arrayArg
  real, optional, intent(in) :: optionalArg

  type paramType(lenParam)
    integer, len :: lenParam = 4
  end type paramType

  type charType
    !ERROR: Invalid specification expression: derived type component or type parameter value not allowed to reference variable 'iarg'
    character(iabs(iArg)) :: fieldWithIntrinsic
    !ERROR: Invalid specification expression: reference to intrinsic 'allocated' not allowed for derived type components or type parameter values
    character(merge(1, 2, allocated(allocArg))) :: allocField
    !ERROR: Invalid specification expression: reference to intrinsic 'associated' not allowed for derived type components or type parameter values
    character(merge(1, 2, associated(pointerArg))) :: assocField
    !ERROR: Invalid specification expression: non-constant reference to inquiry intrinsic 'is_contiguous' not allowed for derived type components or type parameter values
    character(merge(1, 2, is_contiguous(arrayArg))) :: contigField
    !ERROR: Invalid specification expression: reference to intrinsic 'present' not allowed for derived type components or type parameter values
    character(merge(1, 2, present(optionalArg))) :: presentField
  end type charType

  type derivedType
    !ERROR: Invalid specification expression: derived type component or type parameter value not allowed to reference variable 'iarg'
    type(paramType(iabs(iArg))) :: fieldWithIntrinsic
    !ERROR: Invalid specification expression: reference to intrinsic 'allocated' not allowed for derived type components or type parameter values
    type(paramType(merge(1, 2, allocated(allocArg)))) :: allocField
    !ERROR: Invalid specification expression: reference to intrinsic 'associated' not allowed for derived type components or type parameter values
    type(paramType(merge(1, 2, associated(pointerArg)))) :: assocField
    !ERROR: Invalid specification expression: non-constant reference to inquiry intrinsic 'is_contiguous' not allowed for derived type components or type parameter values
    type(paramType(merge(1, 2, is_contiguous(arrayArg)))) :: contigField
    !ERROR: Invalid specification expression: reference to intrinsic 'present' not allowed for derived type components or type parameter values
    type(paramType(merge(1, 2, present(optionalArg)))) :: presentField
  end type derivedType
end subroutine s2