flang/test/Semantics/resolve69.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 subroutine s1()
   3   ! C701 (R701) The type-param-value for a kind type parameter shall be a
   4   ! constant expression.
   5   !
   6   ! C702 (R701) A colon shall not be used as a type-param-value except in the
   7   ! declaration of an entity that has the POINTER or ALLOCATABLE attribute.
   8   !
   9   ! C704 (R703) In a declaration-type-spec, every type-param-value that is
  10   ! not a colon or an asterisk shall be a specification expression.
  11   !   Section 10.1.11 defines specification expressions
  12   !
  13   ! 15.4.2.2(4)(c) A procedure must have an explicit interface if it has a
  14   ! result that has a nonassumed type parameter value that is not a constant
  15   ! expression.
  16   !
  17   integer, parameter :: constVal = 1
  18   integer :: nonConstVal = 1
  19 !PORTABILITY: specification expression refers to local object 'nonconstval' (initialized and saved)
  20   character(nonConstVal) :: colonString1
  21   character(len=20, kind=constVal + 1) :: constKindString
  22   character(len=:, kind=constVal + 1), pointer :: constKindString1
  23 !ERROR: 'constkindstring2' has a type CHARACTER(KIND=2,LEN=:) with a deferred type parameter but is neither an allocatable nor an object pointer
  24   character(len=:, kind=constVal + 1) :: constKindString2
  25 !ERROR: Must be a constant value
  26   character(len=20, kind=nonConstVal) :: nonConstKindString
  27 !ERROR: 'deferredstring' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable nor an object pointer
  28   character(len=:) :: deferredString
  29 !ERROR: 'colonstring2' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable nor an object pointer
  30   character(:) :: colonString2
  31   !OK because of the allocatable attribute
  32   character(:), allocatable :: colonString3
  33 !ERROR: 'foo1' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable nor an object pointer
  34   character(:), external :: foo1
  35 !ERROR: 'foo2' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable nor an object pointer
  36   procedure(character(:)) :: foo2
  37   interface
  38     function foo3()
  39 !ERROR: 'foo3' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable nor an object pointer
  40       character(:) foo3
  41     end function
  42   end interface
  43
  44 !ERROR: Must have INTEGER type, but is REAL(4)
  45   character(3.5) :: badParamValue
  46
  47   type derived(typeKind, typeLen)
  48     integer, kind :: typeKind
  49     integer, len :: typeLen
  50     character(typeKind) :: kindValue
  51     character(typeLen) :: lenValue
  52   end type derived
  53
  54   type (derived(constVal, 3)) :: constDerivedKind
  55 !ERROR: Value of KIND type parameter 'typekind' must be constant
  56 !PORTABILITY: specification expression refers to local object 'nonconstval' (initialized and saved)
  57   type (derived(nonConstVal, 3)) :: nonConstDerivedKind
  58
  59   !OK because all type-params are constants
  60   type (derived(3, constVal)) :: constDerivedLen
  61
  62 !PORTABILITY: specification expression refers to local object 'nonconstval' (initialized and saved)
  63   type (derived(3, nonConstVal)) :: nonConstDerivedLen
  64 !ERROR: 'colonderivedlen' has a type derived(typekind=3_4,typelen=:) with a deferred type parameter but is neither an allocatable nor an object pointer
  65   type (derived(3, :)) :: colonDerivedLen
  66 !ERROR: Value of KIND type parameter 'typekind' must be constant
  67 !ERROR: 'colonderivedlen1' has a type derived(typekind=:,typelen=:) with a deferred type parameter but is neither an allocatable nor an object pointer
  68   type (derived( :, :)) :: colonDerivedLen1
  69   type (derived( :, :)), pointer :: colonDerivedLen2
  70   type (derived(4, :)), pointer :: colonDerivedLen3
  71 end subroutine s1
  72
  73 !C702
  74 !ERROR: 'f1' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable nor an object pointer
  75 character(:) function f1
  76 end function
  77
  78 function f2
  79 !ERROR: 'f2' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable nor an object pointer
  80   character(:) f2
  81 end function
  82
  83 function f3() result(res)
  84 !ERROR: 'res' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable nor an object pointer
  85   character(:) res
  86 end function
  87
  88 !ERROR: 'f4' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable nor an object pointer
  89 function f4
  90   implicit character(:)(f)
  91 end function
  92
  93 !Not errors.
  94
  95 Program d5
  96   Type string(maxlen)
  97     Integer,Kind :: maxlen
  98     Character(maxlen) :: value
  99   End Type
 100   Type(string(80)) line
 101   line%value = 'ok'
 102   Print *,Trim(line%value)
 103 End Program
 104
 105 subroutine outer
 106   integer n
 107  contains
 108   character(n) function inner1()
 109     inner1 = ''
 110   end function inner1
 111   function inner2()
 112     real inner2(n)
 113   end function inner2
 114 end subroutine outer
 115
 116 subroutine s2(dp,dpp)
 117   !ERROR: 'dp' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable nor an object pointer
 118   procedure(character(:)) :: dp
 119   !ERROR: 'dpp' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable nor an object pointer
 120   procedure(character(:)), pointer :: dpp
 121   !ERROR: 'pp' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable nor an object pointer
 122   procedure(character(:)), pointer :: pp
 123   !ERROR: 'xp' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable nor an object pointer
 124   procedure(character(:)) :: xp
 125 end subroutine