flang/test/Semantics/resolve89.f90

   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.
  14 impure function impureFunc()
  15   integer :: impureFunc
  16
  17   impureFunc = 3
  18 end function impureFunc
  19
  20 pure function pureFunc()
  21   integer :: pureFunc
  22
  23   pureFunc = 3
  24 end function pureFunc
  25
  26 module m
  27   real, allocatable :: mVar
  28 end module m
  29
  30 subroutine 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
  91 end subroutine s
  92
  93 subroutine 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
 118 end subroutine s1
 119
 120 subroutine 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
 157 end subroutine s2