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     module subroutine t24(x)
  96 !dir$ ignore_tkr(t) x
  97       real x(:)
  98     end
  99
 100   end interface
 101
 102  contains
 103     subroutine t15(x)
 104 !dir$ ignore_tkr x
 105 !ERROR: !DIR$ IGNORE_TKR may not apply to an allocatable or pointer
 106       real, intent(in), allocatable :: x
 107     end
 108
 109     subroutine t16(x)
 110 !dir$ ignore_tkr x
 111 !ERROR: !DIR$ IGNORE_TKR may not apply to an allocatable or pointer
 112       real, intent(in), pointer :: x
 113     end
 114
 115   subroutine t17(x)
 116     real x
 117     x = x + 1.
 118 !ERROR: !DIR$ IGNORE_TKR directive must appear in the specification part
 119 !dir$ ignore_tkr x
 120   end
 121
 122   subroutine t18(x)
 123 !ERROR: 'q' is not a valid letter for !DIR$ IGNORE_TKR directive
 124 !dir$ ignore_tkr(q) x
 125     real x
 126     x = x + 1.
 127   end
 128
 129   subroutine t19(x)
 130     real x
 131    contains
 132     subroutine inner
 133 !ERROR: 'x' must be local to this subprogram
 134 !dir$ ignore_tkr x
 135     end
 136   end
 137
 138   subroutine t20(x)
 139     real x
 140     block
 141 !ERROR: 'x' must be local to this subprogram
 142 !dir$ ignore_tkr x
 143     end block
 144   end
 145
 146   subroutine t22(x)
 147 !dir$ ignore_tkr(r) x
 148 !WARNING: !DIR$ IGNORE_TKR(R) is not meaningful for an assumed-rank array
 149     real x(..)
 150   end
 151
 152   subroutine t23(x)
 153 !dir$ ignore_tkr(r) x
 154 !ERROR: !DIR$ IGNORE_TKR(R) may not apply to a dummy argument passed via descriptor
 155     real x(:)
 156   end
 157
 158 end
 159
 160 subroutine bad1(x)
 161 !dir$ ignore_tkr x
 162 !ERROR: !DIR$ IGNORE_TKR may apply only in an interface or a module procedure
 163   real, intent(in) :: x
 164 end
 165
 166 submodule(m) subm
 167  contains
 168   module subroutine t24(x)
 169 !dir$ ignore_tkr(t) x
 170     real x(:)
 171   end
 172 end
 173
 174 program test
 175
 176 !ERROR: !DIR$ IGNORE_TKR directive must appear in a subroutine or function
 177 !dir$ ignore_tkr
 178
 179   use m
 180   real x
 181   real a(2)
 182   real m(2,2)
 183   double precision dx
 184
 185   call t1(1)
 186   call t1(dx)
 187   call t1('a')
 188   call t1((1.,2.))
 189   call t1(.true.)
 190
 191   call t2(1)
 192   !ERROR: Actual argument type 'REAL(8)' is not compatible with dummy argument type 'REAL(4)'
 193   call t2(dx)
 194   call t2('a')
 195   call t2((1.,2.))
 196   call t2(.true.)
 197
 198   !ERROR: Actual argument type 'INTEGER(4)' is not compatible with dummy argument type 'REAL(4)'
 199   call t3(1)
 200   call t3(dx)
 201   !ERROR: passing Hollerith or character literal as if it were BOZ
 202   call t3('a')
 203   !ERROR: Actual argument type 'COMPLEX(4)' is not compatible with dummy argument type 'REAL(4)'
 204   call t3((1.,2.))
 205   !ERROR: Actual argument type 'LOGICAL(4)' is not compatible with dummy argument type 'REAL(4)'
 206   call t3(.true.)
 207
 208   call t4(x)
 209   call t4(m)
 210   call t5(x)
 211   !WARNING: Actual argument array has fewer elements (2) than dummy argument 'm=' array (4)
 212   call t5(a)
 213
 214   call t6(1)
 215   call t6(dx)
 216   call t6('a')
 217   call t6((1.,2.))
 218   call t6(.true.)
 219   call t6(a)
 220
 221   call t8(1)
 222   call t8(dx)
 223   call t8('a')
 224   call t8((1.,2.))
 225   call t8(.true.)
 226   call t8(a)
 227
 228  contains
 229   subroutine inner(x)
 230 !dir$ ignore_tkr x
 231 !ERROR: !DIR$ IGNORE_TKR may apply only in an interface or a module procedure
 232     real, intent(in) :: x
 233   end
 234 end