flang/test/Semantics/resolve53.f90

   1 ! RUN: %S/test_errors.sh %s %t %flang_fc1
   2 ! REQUIRES: shell
   3 ! 15.4.3.4.5 Restrictions on generic declarations
   4 ! Specific procedures of generic interfaces must be distinguishable.
   5
   6 module m1
   7   !ERROR: Generic 'g' may not have specific procedures 's2' and 's4' as their interfaces are not distinguishable
   8   interface g
   9     procedure s1
  10     procedure s2
  11     procedure s3
  12     procedure s4
  13   end interface
  14 contains
  15   subroutine s1(x)
  16     integer(8) x
  17   end
  18   subroutine s2(x)
  19     integer x
  20   end
  21   subroutine s3
  22   end
  23   subroutine s4(x)
  24     integer x
  25   end
  26 end
  27
  28 module m2
  29   !ERROR: Generic 'g' may not have specific procedures 's1' and 's2' as their interfaces are not distinguishable
  30   interface g
  31     subroutine s1(x)
  32     end subroutine
  33     subroutine s2(x)
  34       real x
  35     end subroutine
  36   end interface
  37 end
  38
  39 module m3
  40   !ERROR: Generic 'g' may not have specific procedures 'f1' and 'f2' as their interfaces are not distinguishable
  41   interface g
  42     integer function f1()
  43     end function
  44     real function f2()
  45     end function
  46   end interface
  47 end
  48
  49 module m4
  50   type :: t1
  51   end type
  52   type, extends(t1) :: t2
  53   end type
  54   interface g
  55     subroutine s1(x)
  56       import :: t1
  57       type(t1) :: x
  58     end
  59     subroutine s2(x)
  60       import :: t2
  61       type(t2) :: x
  62     end
  63   end interface
  64 end
  65
  66 ! These are all different ranks so they are distinguishable
  67 module m5
  68   interface g
  69     subroutine s1(x)
  70       real x
  71     end subroutine
  72     subroutine s2(x)
  73       real x(:)
  74     end subroutine
  75     subroutine s3(x)
  76       real x(:,:)
  77     end subroutine
  78   end interface
  79 end
  80
  81 module m6
  82   use m5
  83   !ERROR: Generic 'g' may not have specific procedures 's1' and 's4' as their interfaces are not distinguishable
  84   interface g
  85     subroutine s4(x)
  86     end subroutine
  87   end interface
  88 end
  89
  90 module m7
  91   use m5
  92   !ERROR: Generic 'g' may not have specific procedures 's1' and 's5' as their interfaces are not distinguishable
  93   !ERROR: Generic 'g' may not have specific procedures 's2' and 's5' as their interfaces are not distinguishable
  94   !ERROR: Generic 'g' may not have specific procedures 's3' and 's5' as their interfaces are not distinguishable
  95   interface g
  96     subroutine s5(x)
  97       real x(..)
  98     end subroutine
  99   end interface
 100 end
 101
 102
 103 ! Two procedures that differ only by attributes are not distinguishable
 104 module m8
 105   !ERROR: Generic 'g' may not have specific procedures 's1' and 's2' as their interfaces are not distinguishable
 106   interface g
 107     pure subroutine s1(x)
 108       real, intent(in) :: x
 109     end subroutine
 110     subroutine s2(x)
 111       real, intent(in) :: x
 112     end subroutine
 113   end interface
 114 end
 115
 116 module m9
 117   !ERROR: Generic 'g' may not have specific procedures 's1' and 's2' as their interfaces are not distinguishable
 118   interface g
 119     subroutine s1(x)
 120       real :: x(10)
 121     end subroutine
 122     subroutine s2(x)
 123       real :: x(100)
 124     end subroutine
 125   end interface
 126 end
 127
 128 module m10
 129   !ERROR: Generic 'g' may not have specific procedures 's1' and 's2' as their interfaces are not distinguishable
 130   interface g
 131     subroutine s1(x)
 132       real :: x(10)
 133     end subroutine
 134     subroutine s2(x)
 135       real :: x(..)
 136     end subroutine
 137   end interface
 138 end
 139
 140 program m11
 141   interface g1
 142     subroutine s1(x)
 143       real, pointer, intent(out) :: x
 144     end subroutine
 145     subroutine s2(x)
 146       real, allocatable :: x
 147     end subroutine
 148   end interface
 149   !ERROR: Generic 'g2' may not have specific procedures 's3' and 's4' as their interfaces are not distinguishable
 150   interface g2
 151     subroutine s3(x)
 152       real, pointer, intent(in) :: x
 153     end subroutine
 154     subroutine s4(x)
 155       real, allocatable :: x
 156     end subroutine
 157   end interface
 158 end
 159
 160 module m12
 161   !ERROR: Generic 'g1' may not have specific procedures 's1' and 's2' as their interfaces are not distinguishable
 162   generic :: g1 => s1, s2  ! rank-1 and assumed-rank
 163   !ERROR: Generic 'g2' may not have specific procedures 's2' and 's3' as their interfaces are not distinguishable
 164   generic :: g2 => s2, s3  ! scalar and assumed-rank
 165   !ERROR: Generic 'g3' may not have specific procedures 's1' and 's4' as their interfaces are not distinguishable
 166   generic :: g3 => s1, s4  ! different shape, same rank
 167 contains
 168   subroutine s1(x)
 169     real :: x(10)
 170   end
 171   subroutine s2(x)
 172     real :: x(..)
 173   end
 174   subroutine s3(x)
 175     real :: x
 176   end
 177   subroutine s4(x)
 178     real :: x(100)
 179   end
 180 end
 181
 182 ! Procedures that are distinguishable by return type of a dummy argument
 183 module m13
 184   interface g1
 185     procedure s1
 186     procedure s2
 187   end interface
 188   interface g2
 189     procedure s1
 190     procedure s3
 191   end interface
 192 contains
 193   subroutine s1(x)
 194     procedure(real), pointer :: x
 195   end
 196   subroutine s2(x)
 197     procedure(integer), pointer :: x
 198   end
 199   subroutine s3(x)
 200     interface
 201       function x()
 202         procedure(real), pointer :: x
 203       end function
 204     end interface
 205   end
 206 end
 207
 208 ! Check user-defined operators
 209 module m14
 210   interface operator(*)
 211     module procedure f1
 212     module procedure f2
 213   end interface
 214   !ERROR: Generic 'OPERATOR(+)' may not have specific procedures 'f1' and 'f3' as their interfaces are not distinguishable
 215   interface operator(+)
 216     module procedure f1
 217     module procedure f3
 218   end interface
 219   interface operator(.foo.)
 220     module procedure f1
 221     module procedure f2
 222   end interface
 223   !ERROR: Generic 'OPERATOR(.bar.)' may not have specific procedures 'f1' and 'f3' as their interfaces are not distinguishable
 224   interface operator(.bar.)
 225     module procedure f1
 226     module procedure f3
 227   end interface
 228 contains
 229   real function f1(x, y)
 230     real, intent(in) :: x
 231     logical, intent(in) :: y
 232   end
 233   integer function f2(x, y)
 234     integer, intent(in) :: x
 235     logical, intent(in) :: y
 236   end
 237   real function f3(x, y)
 238     real, value :: x
 239     logical, value :: y
 240   end
 241 end module
 242
 243 ! Types distinguished by kind (but not length) parameters
 244 module m15
 245   type :: t1(k1, l1)
 246     integer, kind :: k1 = 1
 247     integer, len :: l1 = 101
 248   end type
 249
 250   type, extends(t1) :: t2(k2a, l2, k2b)
 251     integer, kind :: k2a = 2
 252     integer, kind :: k2b = 3
 253     integer, len :: l2 = 102
 254   end type
 255
 256   type, extends(t2) :: t3(l3, k3)
 257     integer, kind :: k3 = 4
 258     integer, len :: l3 = 103
 259   end type
 260
 261   interface g1
 262     procedure s1
 263     procedure s2
 264   end interface
 265   !ERROR: Generic 'g2' may not have specific procedures 's1' and 's3' as their interfaces are not distinguishable
 266   interface g2
 267     procedure s1
 268     procedure s3
 269   end interface
 270   !ERROR: Generic 'g3' may not have specific procedures 's4' and 's5' as their interfaces are not distinguishable
 271   interface g3
 272     procedure s4
 273     procedure s5
 274   end interface
 275   interface g4
 276     procedure s5
 277     procedure s6
 278     procedure s9
 279   end interface
 280   interface g5
 281     procedure s4
 282     procedure s7
 283     procedure s9
 284   end interface
 285   interface g6
 286     procedure s5
 287     procedure s8
 288     procedure s9
 289   end interface
 290   !ERROR: Generic 'g7' may not have specific procedures 's6' and 's7' as their interfaces are not distinguishable
 291   interface g7
 292     procedure s6
 293     procedure s7
 294   end interface
 295   !ERROR: Generic 'g8' may not have specific procedures 's6' and 's8' as their interfaces are not distinguishable
 296   interface g8
 297     procedure s6
 298     procedure s8
 299   end interface
 300   !ERROR: Generic 'g9' may not have specific procedures 's7' and 's8' as their interfaces are not distinguishable
 301   interface g9
 302     procedure s7
 303     procedure s8
 304   end interface
 305
 306 contains
 307   subroutine s1(x)
 308     type(t1(1, 5)) :: x
 309   end
 310   subroutine s2(x)
 311     type(t1(2, 4)) :: x
 312   end
 313   subroutine s3(x)
 314     type(t1(l1=5)) :: x
 315   end
 316   subroutine s4(x)
 317     type(t3(1, 101, 2, 102, 3, 103, 4)) :: x
 318   end subroutine
 319   subroutine s5(x)
 320     type(t3) :: x
 321   end subroutine
 322   subroutine s6(x)
 323     type(t3(1, 99, k2b=2, k2a=3, l2=*, l3=103, k3=4)) :: x
 324   end subroutine
 325   subroutine s7(x)
 326     type(t3(k1=1, l1=99, k2a=3, k2b=2, k3=4)) :: x
 327   end subroutine
 328   subroutine s8(x)
 329     type(t3(1, :, 3, :, 2, :, 4)), allocatable :: x
 330   end subroutine
 331   subroutine s9(x)
 332     type(t3(k1=2)) :: x
 333   end subroutine
 334 end
 335
 336 ! Check that specifics for type-bound generics can be distinguished
 337 module m16
 338   type :: t
 339   contains
 340     procedure, nopass :: s1
 341     procedure, nopass :: s2
 342     procedure, nopass :: s3
 343     generic :: g1 => s1, s2
 344     !ERROR: Generic 'g2' may not have specific procedures 's1' and 's3' as their interfaces are not distinguishable
 345     generic :: g2 => s1, s3
 346   end type
 347 contains
 348   subroutine s1(x)
 349     real :: x
 350   end
 351   subroutine s2(x)
 352     integer :: x
 353   end
 354   subroutine s3(x)
 355     real :: x
 356   end
 357 end
 358
 359 ! Check polymorphic types
 360 module m17
 361   type :: t
 362   end type
 363   type, extends(t) :: t1
 364   end type
 365   type, extends(t) :: t2
 366   end type
 367   type, extends(t2) :: t2a
 368   end type
 369   interface g1
 370     procedure s1
 371     procedure s2
 372   end interface
 373   !ERROR: Generic 'g2' may not have specific procedures 's3' and 's4' as their interfaces are not distinguishable
 374   interface g2
 375     procedure s3
 376     procedure s4
 377   end interface
 378   interface g3
 379     procedure s1
 380     procedure s4
 381   end interface
 382   !ERROR: Generic 'g4' may not have specific procedures 's2' and 's3' as their interfaces are not distinguishable
 383   interface g4
 384     procedure s2
 385     procedure s3
 386   end interface
 387   !ERROR: Generic 'g5' may not have specific procedures 's2' and 's5' as their interfaces are not distinguishable
 388   interface g5
 389     procedure s2
 390     procedure s5
 391   end interface
 392   !ERROR: Generic 'g6' may not have specific procedures 's2' and 's6' as their interfaces are not distinguishable
 393   interface g6
 394     procedure s2
 395     procedure s6
 396   end interface
 397 contains
 398   subroutine s1(x)
 399     type(t) :: x
 400   end
 401   subroutine s2(x)
 402     type(t2a) :: x
 403   end
 404   subroutine s3(x)
 405     class(t) :: x
 406   end
 407   subroutine s4(x)
 408     class(t2) :: x
 409   end
 410   subroutine s5(x)
 411     class(*) :: x
 412   end
 413   subroutine s6(x)
 414     type(*) :: x
 415   end
 416 end
 417
 418 ! Test C1514 rule 3 -- distinguishable passed-object dummy arguments
 419 module m18
 420   type :: t(k)
 421     integer, kind :: k
 422   contains
 423     procedure, pass(x) :: p1 => s
 424     procedure, pass    :: p2 => s
 425     procedure          :: p3 => s
 426     procedure, pass(y) :: p4 => s
 427     generic :: g1 => p1, p4
 428     generic :: g2 => p2, p4
 429     generic :: g3 => p3, p4
 430   end type
 431 contains
 432   subroutine s(x, y)
 433     class(t(1)) :: x
 434     class(t(2)) :: y
 435   end
 436 end
 437
 438 ! C1511 - rules for operators
 439 module m19
 440   interface operator(.foo.)
 441     module procedure f1
 442     module procedure f2
 443   end interface
 444   !ERROR: Generic 'OPERATOR(.bar.)' may not have specific procedures 'f2' and 'f3' as their interfaces are not distinguishable
 445   interface operator(.bar.)
 446     module procedure f2
 447     module procedure f3
 448   end interface
 449 contains
 450   integer function f1(i)
 451     integer, intent(in) :: i
 452   end
 453   integer function f2(i, j)
 454     integer, value :: i, j
 455   end
 456   integer function f3(i, j)
 457     integer, intent(in) :: i, j
 458   end
 459 end
 460
 461 module m20
 462   interface operator(.not.)
 463     real function f(x)
 464       character(*),intent(in) :: x
 465     end function
 466   end interface
 467   interface operator(+)
 468     procedure f
 469   end interface
 470 end module
 471
 472 subroutine s1()
 473   use m20
 474   interface operator(.not.)
 475     !ERROR: Procedure 'f' from module 'm20' is already specified in generic 'OPERATOR(.NOT.)'
 476     procedure f
 477   end interface
 478   interface operator(+)
 479     !ERROR: Procedure 'f' from module 'm20' is already specified in generic 'OPERATOR(+)'
 480     procedure f
 481   end interface
 482 end subroutine s1