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
 102 ! Two procedures that differ only by attributes are not distinguishable
 103 module m8
 104   !ERROR: Generic 'g' may not have specific procedures 's1' and 's2' as their interfaces are not distinguishable
 105   interface g
 106     pure subroutine s1(x)
 107       real, intent(in) :: x
 108     end subroutine
 109     subroutine s2(x)
 110       real, intent(in) :: x
 111     end subroutine
 112   end interface
 113 end
 114
 115 module m9
 116   !ERROR: Generic 'g' may not have specific procedures 's1' and 's2' as their interfaces are not distinguishable
 117   interface g
 118     subroutine s1(x)
 119       real :: x(10)
 120     end subroutine
 121     subroutine s2(x)
 122       real :: x(100)
 123     end subroutine
 124   end interface
 125 end
 126
 127 module m10
 128   !ERROR: Generic 'g' may not have specific procedures 's1' and 's2' as their interfaces are not distinguishable
 129   interface g
 130     subroutine s1(x)
 131       real :: x(10)
 132     end subroutine
 133     subroutine s2(x)
 134       real :: x(..)
 135     end subroutine
 136   end interface
 137 end
 138
 139 program m11
 140   interface g1
 141     subroutine s1(x)
 142       real, pointer, intent(out) :: x
 143     end subroutine
 144     subroutine s2(x)
 145       real, allocatable :: x
 146     end subroutine
 147   end interface
 148   !ERROR: Generic 'g2' may not have specific procedures 's3' and 's4' as their interfaces are not distinguishable
 149   interface g2
 150     subroutine s3(x)
 151       real, pointer, intent(in) :: x
 152     end subroutine
 153     subroutine s4(x)
 154       real, allocatable :: x
 155     end subroutine
 156   end interface
 157 end
 158
 159 module m12
 160   !ERROR: Generic 'g1' may not have specific procedures 's1' and 's2' as their interfaces are not distinguishable
 161   generic :: g1 => s1, s2  ! rank-1 and assumed-rank
 162   !ERROR: Generic 'g2' may not have specific procedures 's2' and 's3' as their interfaces are not distinguishable
 163   generic :: g2 => s2, s3  ! scalar and assumed-rank
 164   !ERROR: Generic 'g3' may not have specific procedures 's1' and 's4' as their interfaces are not distinguishable
 165   generic :: g3 => s1, s4  ! different shape, same rank
 166 contains
 167   subroutine s1(x)
 168     real :: x(10)
 169   end
 170   subroutine s2(x)
 171     real :: x(..)
 172   end
 173   subroutine s3(x)
 174     real :: x
 175   end
 176   subroutine s4(x)
 177     real :: x(100)
 178   end
 179 end
 180
 181 ! Procedures that are distinguishable by return type of a dummy argument
 182 module m13
 183   interface g1
 184     procedure s1
 185     procedure s2
 186   end interface
 187   interface g2
 188     procedure s1
 189     procedure s3
 190   end interface
 191 contains
 192   subroutine s1(x)
 193     procedure(real), pointer :: x
 194   end
 195   subroutine s2(x)
 196     procedure(integer), pointer :: x
 197   end
 198   subroutine s3(x)
 199     interface
 200       function x()
 201         procedure(real), pointer :: x
 202       end function
 203     end interface
 204   end
 205 end
 206
 207 ! Check user-defined operators
 208 module m14
 209   interface operator(*)
 210     module procedure f1
 211     module procedure f2
 212   end interface
 213   !ERROR: Generic 'OPERATOR(+)' may not have specific procedures 'f1' and 'f3' as their interfaces are not distinguishable
 214   interface operator(+)
 215     module procedure f1
 216     module procedure f3
 217   end interface
 218   interface operator(.foo.)
 219     module procedure f1
 220     module procedure f2
 221   end interface
 222   !ERROR: Generic 'OPERATOR(.bar.)' may not have specific procedures 'f1' and 'f3' as their interfaces are not distinguishable
 223   interface operator(.bar.)
 224     module procedure f1
 225     module procedure f3
 226   end interface
 227 contains
 228   real function f1(x, y)
 229     real, intent(in) :: x
 230     logical, intent(in) :: y
 231   end
 232   integer function f2(x, y)
 233     integer, intent(in) :: x
 234     logical, intent(in) :: y
 235   end
 236   real function f3(x, y)
 237     real, value :: x
 238     logical, value :: y
 239   end
 240 end module
 241
 242 ! Types distinguished by kind (but not length) parameters
 243 module m15
 244   type :: t1(k1, l1)
 245     integer, kind :: k1 = 1
 246     integer, len :: l1 = 101
 247   end type
 248
 249   type, extends(t1) :: t2(k2a, l2, k2b)
 250     integer, kind :: k2a = 2
 251     integer, kind :: k2b = 3
 252     integer, len :: l2 = 102
 253   end type
 254
 255   type, extends(t2) :: t3(l3, k3)
 256     integer, kind :: k3 = 4
 257     integer, len :: l3 = 103
 258   end type
 259
 260   interface g1
 261     procedure s1
 262     procedure s2
 263   end interface
 264   !ERROR: Generic 'g2' may not have specific procedures 's1' and 's3' as their interfaces are not distinguishable
 265   interface g2
 266     procedure s1
 267     procedure s3
 268   end interface
 269   !ERROR: Generic 'g3' may not have specific procedures 's4' and 's5' as their interfaces are not distinguishable
 270   interface g3
 271     procedure s4
 272     procedure s5
 273   end interface
 274   interface g4
 275     procedure s5
 276     procedure s6
 277     procedure s9
 278   end interface
 279   interface g5
 280     procedure s4
 281     procedure s7
 282     procedure s9
 283   end interface
 284   interface g6
 285     procedure s5
 286     procedure s8
 287     procedure s9
 288   end interface
 289   !ERROR: Generic 'g7' may not have specific procedures 's6' and 's7' as their interfaces are not distinguishable
 290   interface g7
 291     procedure s6
 292     procedure s7
 293   end interface
 294   !ERROR: Generic 'g8' may not have specific procedures 's6' and 's8' as their interfaces are not distinguishable
 295   interface g8
 296     procedure s6
 297     procedure s8
 298   end interface
 299   !ERROR: Generic 'g9' may not have specific procedures 's7' and 's8' as their interfaces are not distinguishable
 300   interface g9
 301     procedure s7
 302     procedure s8
 303   end interface
 304
 305 contains
 306   subroutine s1(x)
 307     type(t1(1, 5)) :: x
 308   end
 309   subroutine s2(x)
 310     type(t1(2, 4)) :: x
 311   end
 312   subroutine s3(x)
 313     type(t1(l1=5)) :: x
 314   end
 315   subroutine s4(x)
 316     type(t3(1, 101, 2, 102, 3, 103, 4)) :: x
 317   end subroutine
 318   subroutine s5(x)
 319     type(t3) :: x
 320   end subroutine
 321   subroutine s6(x)
 322     type(t3(1, 99, k2b=2, k2a=3, l2=*, l3=103, k3=4)) :: x
 323   end subroutine
 324   subroutine s7(x)
 325     type(t3(k1=1, l1=99, k2a=3, k2b=2, k3=4)) :: x
 326   end subroutine
 327   subroutine s8(x)
 328     type(t3(1, :, 3, :, 2, :, 4)), allocatable :: x
 329   end subroutine
 330   subroutine s9(x)
 331     type(t3(k1=2)) :: x
 332   end subroutine
 333 end
 334
 335 ! Check that specifics for type-bound generics can be distinguished
 336 module m16
 337   type :: t
 338   contains
 339     procedure, nopass :: s1
 340     procedure, nopass :: s2
 341     procedure, nopass :: s3
 342     generic :: g1 => s1, s2
 343     !ERROR: Generic 'g2' may not have specific procedures 's1' and 's3' as their interfaces are not distinguishable
 344     generic :: g2 => s1, s3
 345   end type
 346 contains
 347   subroutine s1(x)
 348     real :: x
 349   end
 350   subroutine s2(x)
 351     integer :: x
 352   end
 353   subroutine s3(x)
 354     real :: x
 355   end
 356 end
 357
 358 ! Check polymorphic types
 359 module m17
 360   type :: t
 361   end type
 362   type, extends(t) :: t1
 363   end type
 364   type, extends(t) :: t2
 365   end type
 366   type, extends(t2) :: t2a
 367   end type
 368   interface g1
 369     procedure s1
 370     procedure s2
 371   end interface
 372   !ERROR: Generic 'g2' may not have specific procedures 's3' and 's4' as their interfaces are not distinguishable
 373   interface g2
 374     procedure s3
 375     procedure s4
 376   end interface
 377   interface g3
 378     procedure s1
 379     procedure s4
 380   end interface
 381   !ERROR: Generic 'g4' may not have specific procedures 's2' and 's3' as their interfaces are not distinguishable
 382   interface g4
 383     procedure s2
 384     procedure s3
 385   end interface
 386   !ERROR: Generic 'g5' may not have specific procedures 's2' and 's5' as their interfaces are not distinguishable
 387   interface g5
 388     procedure s2
 389     procedure s5
 390   end interface
 391   !ERROR: Generic 'g6' may not have specific procedures 's2' and 's6' as their interfaces are not distinguishable
 392   interface g6
 393     procedure s2
 394     procedure s6
 395   end interface
 396 contains
 397   subroutine s1(x)
 398     type(t) :: x
 399   end
 400   subroutine s2(x)
 401     type(t2a) :: x
 402   end
 403   subroutine s3(x)
 404     class(t) :: x
 405   end
 406   subroutine s4(x)
 407     class(t2) :: x
 408   end
 409   subroutine s5(x)
 410     class(*) :: x
 411   end
 412   subroutine s6(x)
 413     type(*) :: x
 414   end
 415 end
 416
 417 ! Test C1514 rule 3 -- distinguishable passed-object dummy arguments
 418 module m18
 419   type :: t(k)
 420     integer, kind :: k
 421   contains
 422     procedure, pass(x) :: p1 => s
 423     procedure, pass    :: p2 => s
 424     procedure          :: p3 => s
 425     procedure, pass(y) :: p4 => s
 426     generic :: g1 => p1, p4
 427     generic :: g2 => p2, p4
 428     generic :: g3 => p3, p4
 429   end type
 430 contains
 431   subroutine s(x, y)
 432     class(t(1)) :: x
 433     class(t(2)) :: y
 434   end
 435 end
 436
 437 ! C1511 - rules for operators
 438 module m19
 439   interface operator(.foo.)
 440     module procedure f1
 441     module procedure f2
 442   end interface
 443   !ERROR: Generic 'OPERATOR(.bar.)' may not have specific procedures 'f2' and 'f3' as their interfaces are not distinguishable
 444   interface operator(.bar.)
 445     module procedure f2
 446     module procedure f3
 447   end interface
 448 contains
 449   integer function f1(i)
 450     integer, intent(in) :: i
 451   end
 452   integer function f2(i, j)
 453     integer, value :: i, j
 454   end
 455   integer function f3(i, j)
 456     integer, intent(in) :: i, j
 457   end
 458 end
 459
 460 module m20
 461   interface operator(.not.)
 462     real function f(x)
 463       character(*),intent(in) :: x
 464     end function
 465   end interface
 466   interface operator(+)
 467     procedure f
 468   end interface
 469 end module
 470
 471 subroutine s1()
 472   use m20
 473   interface operator(.not.)
 474     !ERROR: Procedure 'f' from module 'm20' is already specified in generic 'OPERATOR(.NOT.)'
 475     procedure f
 476   end interface
 477   interface operator(+)
 478     !ERROR: Procedure 'f' from module 'm20' is already specified in generic 'OPERATOR(+)'
 479     procedure f
 480   end interface
 481 end subroutine s1
 482
 483 ! Extensions for distinguishable allocatable arguments; these should not
 484 ! elicit errors from f18
 485 module m21
 486   type :: t
 487   end type
 488   interface int1
 489     procedure s1a, s1b ! only one is polymorphic
 490   end interface
 491   interface int2
 492     procedure s2a, s2b ! only one is unlimited polymorphic
 493   end interface
 494  contains
 495   subroutine s1a(x)
 496     type(t), allocatable :: x
 497   end subroutine
 498   subroutine s1b(x)
 499     class(t), allocatable :: x
 500   end subroutine
 501   subroutine s2a(x)
 502     class(t), allocatable :: x
 503   end subroutine
 504   subroutine s2b(x)
 505     class(*), allocatable :: x
 506   end subroutine
 507 end module