flang/test/Semantics/resolve53.f90

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