flang/test/Semantics/resolve89.f90

   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.
  13 impure function impureFunc()
  14   integer :: impureFunc
  15
  16   impureFunc = 3
  17 end function impureFunc
  18
  19 pure function iPureFunc()
  20   integer :: iPureFunc
  21
  22   iPureFunc = 3
  23 end function iPureFunc
  24
  25 module m
  26   real, allocatable :: mVar
  27 end module m
  28
  29 subroutine 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
  89 end subroutine s
  90
  91 subroutine 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
 116 end subroutine s1
 117
 118 subroutine 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
 155 end subroutine s2