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