flang/test/Semantics/resolve53.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   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 's1' and 's2' as their interfaces are not distinguishable
  29   interface g
  30     subroutine s1(x)
  31     end subroutine
  32     subroutine s2(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 'f1' and 'f2' as their interfaces are not distinguishable
  40   interface g
  41     integer function f1()
  42     end function
  43     real function f2()
  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 s1(x)
  55       import :: t1
  56       type(t1) :: x
  57     end
  58     subroutine s2(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 s1(x)
  69       real x
  70     end subroutine
  71     subroutine s2(x)
  72       real x(:)
  73     end subroutine
  74     subroutine s3(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 's1' and 's4' as their interfaces are not distinguishable
  83   interface g
  84     subroutine s4(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 's1' and 's5' as their interfaces are not distinguishable
  92   !ERROR: Generic 'g' may not have specific procedures 's2' and 's5' as their interfaces are not distinguishable
  93   !ERROR: Generic 'g' may not have specific procedures 's3' and 's5' as their interfaces are not distinguishable
  94   interface g
  95     subroutine s5(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 's1' and 's2' as their interfaces are not distinguishable
 104   interface g
 105     pure subroutine s1(x)
 106       real, intent(in) :: x
 107     end subroutine
 108     subroutine s2(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 's1' and 's2' as their interfaces are not distinguishable
 116   interface g
 117     subroutine s1(x)
 118       real :: x(10)
 119     end subroutine
 120     subroutine s2(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 's1' and 's2' as their interfaces are not distinguishable
 128   interface g
 129     subroutine s1(x)
 130       real :: x(10)
 131     end subroutine
 132     subroutine s2(x)
 133       real :: x(..)
 134     end subroutine
 135   end interface
 136 end
 137
 138 program m11
 139   interface g1
 140     subroutine s1(x)
 141       real, pointer, intent(out) :: x
 142     end subroutine
 143     subroutine s2(x)
 144       real, allocatable :: x
 145     end subroutine
 146   end interface
 147   !ERROR: Generic 'g2' may not have specific procedures 's3' and 's4' as their interfaces are not distinguishable
 148   interface g2
 149     subroutine s3(x)
 150       real, pointer, intent(in) :: x
 151     end subroutine
 152     subroutine s4(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   end
 231   integer function f2(x, y)
 232     integer, intent(in) :: x
 233     logical, intent(in) :: y
 234   end
 235   real function f3(x, y)
 236     real, value :: x
 237     logical, value :: y
 238   end
 239 end module
 240
 241 ! Types distinguished by kind (but not length) parameters
 242 module m15
 243   type :: t1(k1, l1)
 244     integer, kind :: k1 = 1
 245     integer, len :: l1 = 101
 246   end type
 247
 248   type, extends(t1) :: t2(k2a, l2, k2b)
 249     integer, kind :: k2a = 2
 250     integer, kind :: k2b = 3
 251     integer, len :: l2 = 102
 252   end type
 253
 254   type, extends(t2) :: t3(l3, k3)
 255     integer, kind :: k3 = 4
 256     integer, len :: l3 = 103
 257   end type
 258
 259   interface g1
 260     procedure s1
 261     procedure s2
 262   end interface
 263   !ERROR: Generic 'g2' may not have specific procedures 's1' and 's3' as their interfaces are not distinguishable
 264   interface g2
 265     procedure s1
 266     procedure s3
 267   end interface
 268   !ERROR: Generic 'g3' may not have specific procedures 's4' and 's5' as their interfaces are not distinguishable
 269   interface g3
 270     procedure s4
 271     procedure s5
 272   end interface
 273   interface g4
 274     procedure s5
 275     procedure s6
 276     procedure s9
 277   end interface
 278   interface g5
 279     procedure s4
 280     procedure s7
 281     procedure s9
 282   end interface
 283   interface g6
 284     procedure s5
 285     procedure s8
 286     procedure s9
 287   end interface
 288   !ERROR: Generic 'g7' may not have specific procedures 's6' and 's7' as their interfaces are not distinguishable
 289   interface g7
 290     procedure s6
 291     procedure s7
 292   end interface
 293   !ERROR: Generic 'g8' may not have specific procedures 's6' and 's8' as their interfaces are not distinguishable
 294   interface g8
 295     procedure s6
 296     procedure s8
 297   end interface
 298   !ERROR: Generic 'g9' may not have specific procedures 's7' and 's8' as their interfaces are not distinguishable
 299   interface g9
 300     procedure s7
 301     procedure s8
 302   end interface
 303
 304 contains
 305   subroutine s1(x)
 306     type(t1(1, 5)) :: x
 307   end
 308   subroutine s2(x)
 309     type(t1(2, 4)) :: x
 310   end
 311   subroutine s3(x)
 312     type(t1(l1=5)) :: x
 313   end
 314   subroutine s4(x)
 315     type(t3(1, 101, 2, 102, 3, 103, 4)) :: x
 316   end subroutine
 317   subroutine s5(x)
 318     type(t3) :: x
 319   end subroutine
 320   subroutine s6(x)
 321     type(t3(1, 99, k2b=2, k2a=3, l2=*, l3=103, k3=4)) :: x
 322   end subroutine
 323   subroutine s7(x)
 324     type(t3(k1=1, l1=99, k2a=3, k2b=2, k3=4)) :: x
 325   end subroutine
 326   subroutine s8(x)
 327     type(t3(1, :, 3, :, 2, :, 4)), allocatable :: x
 328   end subroutine
 329   subroutine s9(x)
 330     type(t3(k1=2)) :: x
 331   end subroutine
 332 end
 333
 334 ! Check that specifics for type-bound generics can be distinguished
 335 module m16
 336   type :: t
 337   contains
 338     procedure, nopass :: s1
 339     procedure, nopass :: s2
 340     procedure, nopass :: s3
 341     generic :: g1 => s1, s2
 342     !ERROR: Generic 'g2' may not have specific procedures 's1' and 's3' as their interfaces are not distinguishable
 343     generic :: g2 => s1, s3
 344   end type
 345 contains
 346   subroutine s1(x)
 347     real :: x
 348   end
 349   subroutine s2(x)
 350     integer :: x
 351   end
 352   subroutine s3(x)
 353     real :: x
 354   end
 355 end
 356
 357 ! Check polymorphic types
 358 module m17
 359   type :: t
 360   end type
 361   type, extends(t) :: t1
 362   end type
 363   type, extends(t) :: t2
 364   end type
 365   type, extends(t2) :: t2a
 366   end type
 367   interface g1
 368     procedure s1
 369     procedure s2
 370   end interface
 371   !ERROR: Generic 'g2' may not have specific procedures 's3' and 's4' as their interfaces are not distinguishable
 372   interface g2
 373     procedure s3
 374     procedure s4
 375   end interface
 376   interface g3
 377     procedure s1
 378     procedure s4
 379   end interface
 380   !ERROR: Generic 'g4' may not have specific procedures 's2' and 's3' as their interfaces are not distinguishable
 381   interface g4
 382     procedure s2
 383     procedure s3
 384   end interface
 385   !ERROR: Generic 'g5' may not have specific procedures 's2' and 's5' as their interfaces are not distinguishable
 386   interface g5
 387     procedure s2
 388     procedure s5
 389   end interface
 390   !ERROR: Generic 'g6' may not have specific procedures 's2' and 's6' as their interfaces are not distinguishable
 391   interface g6
 392     procedure s2
 393     procedure s6
 394   end interface
 395 contains
 396   subroutine s1(x)
 397     type(t) :: x
 398   end
 399   subroutine s2(x)
 400     type(t2a) :: x
 401   end
 402   subroutine s3(x)
 403     class(t) :: x
 404   end
 405   subroutine s4(x)
 406     class(t2) :: x
 407   end
 408   subroutine s5(x)
 409     class(*) :: x
 410   end
 411   subroutine s6(x)
 412     type(*) :: x
 413   end
 414 end
 415
 416 ! Test C1514 rule 3 -- distinguishable passed-object dummy arguments
 417 module m18
 418   type :: t(k)
 419     integer, kind :: k
 420   contains
 421     procedure, pass(x) :: p1 => s
 422     procedure, pass    :: p2 => s
 423     procedure          :: p3 => s
 424     procedure, pass(y) :: p4 => s
 425     generic :: g1 => p1, p4
 426     generic :: g2 => p2, p4
 427     generic :: g3 => p3, p4
 428   end type
 429 contains
 430   subroutine s(x, y)
 431     class(t(1)) :: x
 432     class(t(2)) :: y
 433   end
 434 end
 435
 436 ! C1511 - rules for operators
 437 module m19
 438   interface operator(.foo.)
 439     module procedure f1
 440     module procedure f2
 441   end interface
 442   !ERROR: Generic 'OPERATOR(.bar.)' may not have specific procedures 'f2' and 'f3' as their interfaces are not distinguishable
 443   interface operator(.bar.)
 444     module procedure f2
 445     module procedure f3
 446   end interface
 447 contains
 448   integer function f1(i)
 449     integer, intent(in) :: i
 450   end
 451   integer function f2(i, j)
 452     integer, value :: i, j
 453   end
 454   integer function f3(i, j)
 455     integer, intent(in) :: i, j
 456   end
 457 end
 458
 459 module m20
 460   interface operator(.not.)
 461     real function f(x)
 462       character(*),intent(in) :: x
 463     end function
 464   end interface
 465   interface operator(+)
 466     procedure f
 467   end interface
 468 end module
 469
 470 subroutine subr1()
 471   use m20
 472   interface operator(.not.)
 473     !ERROR: Procedure 'f' from module 'm20' is already specified in generic 'OPERATOR(.NOT.)'
 474     procedure f
 475   end interface
 476   interface operator(+)
 477     !ERROR: Procedure 'f' from module 'm20' is already specified in generic 'OPERATOR(+)'
 478     procedure f
 479   end interface
 480 end subroutine subr1
 481
 482 ! Extensions for distinguishable allocatable arguments; these should not
 483 ! elicit errors from f18
 484 module m21
 485   type :: t
 486   end type
 487   interface int1
 488     procedure s1a, s1b ! only one is polymorphic
 489   end interface
 490   interface int2
 491     procedure s2a, s2b ! only one is unlimited polymorphic
 492   end interface
 493  contains
 494   subroutine s1a(x)
 495     type(t), allocatable :: x
 496   end subroutine
 497   subroutine s1b(x)
 498     class(t), allocatable :: x
 499   end subroutine
 500   subroutine s2a(x)
 501     class(t), allocatable :: x
 502   end subroutine
 503   subroutine s2b(x)
 504     class(*), allocatable :: x
 505   end subroutine
 506 end module