flang/test/Semantics/ignore_tkr01.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
   2 ! !DIR$ IGNORE_TKR tests
   3
   4 !ERROR: !DIR$ IGNORE_TKR directive must appear in a subroutine or function
   5 !dir$ ignore_tkr
   6
   7 module m
   8
   9 !ERROR: !DIR$ IGNORE_TKR directive must appear in a subroutine or function
  10 !dir$ ignore_tkr
  11
  12   interface
  13     subroutine t1(x)
  14 !dir$ ignore_tkr
  15       real, intent(in) :: x
  16     end
  17
  18     subroutine t2(x)
  19 !dir$ ignore_tkr(t) x
  20       real, intent(in) :: x
  21     end
  22
  23     subroutine t3(x)
  24 !dir$ ignore_tkr(k) x
  25       real, intent(in) :: x
  26     end
  27
  28     subroutine t4(a)
  29 !dir$ ignore_tkr(r) a
  30       real, intent(in) :: a(2)
  31     end
  32
  33     subroutine t5(m)
  34 !dir$ ignore_tkr(r) m
  35       real, intent(in) :: m(2,2)
  36     end
  37
  38     subroutine t6(x)
  39 !dir$ ignore_tkr(a) x
  40       real, intent(in) :: x
  41     end
  42
  43     subroutine t7(x)
  44 !ERROR: !DIR$ IGNORE_TKR directive may not have an empty parenthesized list of letters
  45 !dir$ ignore_tkr() x
  46       real, intent(in) :: x
  47     end
  48
  49     subroutine t8(x)
  50 !dir$ ignore_tkr x
  51       real, intent(in) :: x
  52     end
  53
  54     subroutine t9(x)
  55 !dir$ ignore_tkr x
  56 !WARNING: !DIR$ IGNORE_TKR should not apply to an allocatable or pointer
  57       real, intent(in), allocatable :: x
  58     end
  59
  60     subroutine t10(x)
  61 !dir$ ignore_tkr x
  62 !WARNING: !DIR$ IGNORE_TKR should not apply to an allocatable or pointer
  63       real, intent(in), pointer :: x
  64     end
  65
  66     subroutine t11
  67 !dir$ ignore_tkr x
  68 !ERROR: !DIR$ IGNORE_TKR directive may apply only to a dummy data argument
  69       real :: x
  70     end
  71
  72     subroutine t12(p,q,r)
  73 !dir$ ignore_tkr p, q
  74 !ERROR: 'p' is a data object and may not be EXTERNAL
  75       real, external :: p
  76 !ERROR: 'q' is already declared as an object
  77       procedure(real) :: q
  78       procedure(), pointer :: r
  79 !ERROR: 'r' must be an object
  80 !dir$ ignore_tkr r
  81     end
  82
  83     elemental subroutine t13(x)
  84 !dir$ ignore_tkr(r) x
  85 !ERROR: !DIR$ IGNORE_TKR(R) may not apply in an ELEMENTAL procedure
  86       real, intent(in) :: x
  87     end
  88
  89     subroutine t14(x)
  90 !dir$ ignore_tkr(r) x
  91 !WARNING: !DIR$ IGNORE_TKR(R) should not apply to a dummy argument passed via descriptor
  92       real x(:)
  93     end
  94
  95   end interface
  96
  97  contains
  98     subroutine t15(x)
  99 !dir$ ignore_tkr x
 100 !ERROR: !DIR$ IGNORE_TKR may not apply to an allocatable or pointer
 101       real, intent(in), allocatable :: x
 102     end
 103
 104     subroutine t16(x)
 105 !dir$ ignore_tkr x
 106 !ERROR: !DIR$ IGNORE_TKR may not apply to an allocatable or pointer
 107       real, intent(in), pointer :: x
 108     end
 109
 110   subroutine t17(x)
 111     real x
 112     x = x + 1.
 113 !ERROR: !DIR$ IGNORE_TKR directive must appear in the specification part
 114 !dir$ ignore_tkr x
 115   end
 116
 117   subroutine t18(x)
 118 !ERROR: 'q' is not a valid letter for !DIR$ IGNORE_TKR directive
 119 !dir$ ignore_tkr(q) x
 120     real x
 121     x = x + 1.
 122   end
 123
 124   subroutine t19(x)
 125     real x
 126    contains
 127     subroutine inner
 128 !ERROR: 'x' must be local to this subprogram
 129 !dir$ ignore_tkr x
 130     end
 131   end
 132
 133   subroutine t20(x)
 134     real x
 135     block
 136 !ERROR: 'x' must be local to this subprogram
 137 !dir$ ignore_tkr x
 138     end block
 139   end
 140
 141   subroutine t21(x)
 142 !dir$ ignore_tkr(c) x
 143 !ERROR: !DIR$ IGNORE_TKR(C) may apply only to an assumed-shape array
 144     real x(1)
 145   end
 146
 147   subroutine t22(x)
 148 !dir$ ignore_tkr(r) x
 149 !WARNING: !DIR$ IGNORE_TKR(R) is not meaningful for an assumed-rank array
 150     real x(..)
 151   end
 152
 153   subroutine t23(x)
 154 !dir$ ignore_tkr(r) x
 155 !ERROR: !DIR$ IGNORE_TKR(R) may not apply to a dummy argument passed via descriptor
 156     real x(:)
 157   end
 158
 159 end
 160
 161 subroutine bad1(x)
 162 !dir$ ignore_tkr x
 163 !ERROR: !DIR$ IGNORE_TKR may apply only in an interface or a module procedure
 164   real, intent(in) :: x
 165 end
 166
 167 program test
 168
 169 !ERROR: !DIR$ IGNORE_TKR directive must appear in a subroutine or function
 170 !dir$ ignore_tkr
 171
 172   use m
 173   real x
 174   real a(2)
 175   real m(2,2)
 176   double precision dx
 177
 178   call t1(1)
 179   call t1(dx)
 180   call t1('a')
 181   call t1((1.,2.))
 182   call t1(.true.)
 183
 184   call t2(1)
 185   !ERROR: Actual argument type 'REAL(8)' is not compatible with dummy argument type 'REAL(4)'
 186   call t2(dx)
 187   call t2('a')
 188   call t2((1.,2.))
 189   call t2(.true.)
 190
 191   !ERROR: Actual argument type 'INTEGER(4)' is not compatible with dummy argument type 'REAL(4)'
 192   call t3(1)
 193   call t3(dx)
 194   !ERROR: passing Hollerith or character literal as if it were BOZ
 195   call t3('a')
 196   !ERROR: Actual argument type 'COMPLEX(4)' is not compatible with dummy argument type 'REAL(4)'
 197   call t3((1.,2.))
 198   !ERROR: Actual argument type 'LOGICAL(4)' is not compatible with dummy argument type 'REAL(4)'
 199   call t3(.true.)
 200
 201   call t4(x)
 202   call t4(m)
 203   call t5(x)
 204   !WARNING: Actual argument array has fewer elements (2) than dummy argument 'm=' array (4)
 205   call t5(a)
 206
 207   call t6(1)
 208   call t6(dx)
 209   call t6('a')
 210   call t6((1.,2.))
 211   call t6(.true.)
 212   call t6(a)
 213
 214   call t8(1)
 215   call t8(dx)
 216   call t8('a')
 217   call t8((1.,2.))
 218   call t8(.true.)
 219   call t8(a)
 220
 221  contains
 222   subroutine inner(x)
 223 !dir$ ignore_tkr x
 224 !ERROR: !DIR$ IGNORE_TKR may apply only in an interface or a module procedure
 225     real, intent(in) :: x
 226   end
 227 end