brintos

brintos / llvm-project-archived public Read only

0
0
Text · 10.6 KiB · 7d8ea6e Raw
376 lines · plain
1! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic2 3! When a module subprogram has the MODULE prefix the following must match4! with the corresponding separate module procedure interface body:5! - C1549: characteristics and dummy argument names6! - C1550: binding label7! - C1551: NON_RECURSIVE prefix8 9module m110  interface11    module subroutine s4(x)12      real, intent(in) :: x13    end14    module subroutine s5(x, y)15      real, pointer :: x16      real, value :: y17    end18    module subroutine s6(x, y)19      real :: x20      real :: y21    end22    module subroutine s7(x, y, z)23      real :: x(8)24      real :: y(8)25      real :: z(8)26    end27    module subroutine s8(x, y, z)28      real :: x(8)29      real :: y(*)30      real :: z(*)31    end32    module subroutine s9(x, y, z, w)33      character(len=4) :: x34      character(len=4) :: y35      character(len=*) :: z36      character(len=*) :: w37    end38    module subroutine s10(x, y, z, w)39      real x(0:), y(:), z(0:*), w(*)40    end41  end interface42end43 44submodule(m1) sm145contains46  module subroutine s4(x)47    !ERROR: The intent of dummy argument 'x' does not match the intent of the corresponding argument in the interface body48    real, intent(out) :: x49  end50  module subroutine s5(x, y)51    !ERROR: Dummy argument 'x' has the OPTIONAL attribute; the corresponding argument in the interface body does not52    real, pointer, optional :: x53    !ERROR: Dummy argument 'y' does not have the VALUE attribute; the corresponding argument in the interface body does54    real :: y55  end56  module subroutine s6(x, y)57    !ERROR: Dummy argument 'x' has type INTEGER(4); the corresponding argument in the interface body has distinct type REAL(4)58    integer :: x59    !ERROR: Dummy argument 'y' has type REAL(8); the corresponding argument in the interface body has distinct type REAL(4)60    real(8) :: y61  end62  module subroutine s7(x, y, z)63    integer, parameter :: n = 864    real :: x(n)65    real :: y(2:n+1)66    !ERROR: The shape of dummy argument 'z' does not match the shape of the corresponding argument in the interface body67    real :: z(n+1)68  end69  module subroutine s8(x, y, z)70    !ERROR: The shape of dummy argument 'x' does not match the shape of the corresponding argument in the interface body71    real :: x(*)72    real :: y(*)73    !ERROR: The shape of dummy argument 'z' does not match the shape of the corresponding argument in the interface body74    real :: z(8)75  end76  module subroutine s9(x, y, z, w)77    character(len=4) :: x78    !ERROR: Dummy argument 'y' has type CHARACTER(KIND=1,LEN=5_8); the corresponding argument in the interface body has distinct type CHARACTER(KIND=1,LEN=4_8)79    character(len=5) :: y80    character(len=*) :: z81    !ERROR: Dummy argument 'w' has type CHARACTER(KIND=1,LEN=4_8); the corresponding argument in the interface body has distinct type CHARACTER(KIND=1,LEN=*)82    character(len=4) :: w83  end84  module subroutine s10(x, y, z, w)85    real x(:), y(0:), z(*), w(0:*) ! all ok, lower bounds don't matter86  end87end88 89module m290  interface91    module subroutine s1(x, y)92      real, intent(in) :: x93      real, intent(out) :: y94    end95    module subroutine s2(x, y)96      real, intent(in) :: x97      real, intent(out) :: y98    end99    module subroutine s3(x, y)100      real(4) :: x101      procedure(real) :: y102    end103    module subroutine s4()104    end105    non_recursive module subroutine s5()106    end107  end interface108end109 110submodule(m2) sm2111contains112  !ERROR: Module subprogram 's1' has 3 args but the corresponding interface body has 2113  module subroutine s1(x, y, z)114    real, intent(in) :: x115    real, intent(out) :: y116    real :: z117  end118  module subroutine s2(x, z)119    real, intent(in) :: x120  !ERROR: Dummy argument name 'z' does not match corresponding name 'y' in interface body121    real, intent(out) :: z122  end123  module subroutine s3(x, y)124    !ERROR: Dummy argument 'x' is a procedure; the corresponding argument in the interface body is not125    procedure(real) :: x126    !ERROR: Dummy argument 'y' is a data object; the corresponding argument in the interface body is not127    real :: y128  end129  !ERROR: Module subprogram 's4' has NON_RECURSIVE prefix but the corresponding interface body does not130  non_recursive module subroutine s4()131  end132  !ERROR: Module subprogram 's5' does not have NON_RECURSIVE prefix but the corresponding interface body does133  module subroutine s5()134  end135end136 137module m2b138  interface139    module subroutine s1()140    end141    module subroutine s2() bind(c, name="s2")142    end143    module subroutine s3() bind(c, name="s3")144    end145    module subroutine s4() bind(c, name=" s4")146    end147    module subroutine s5() bind(c)148    end149    module subroutine s6() bind(c)150    end151    module subroutine s7() bind(c, name="s7")152    end153  end interface154end155 156submodule(m2b) sm2b157  character(*), parameter :: suffix = "_xxx"158contains159  !ERROR: Module subprogram 's1' has a binding label but the corresponding interface body does not160  !ERROR: Module subprogram 's1' and its corresponding interface body are not both BIND(C)161  module subroutine s1() bind(c, name="s1")162  end163  !ERROR: Module subprogram 's2' does not have a binding label but the corresponding interface body does164  !ERROR: Module subprogram 's2' and its corresponding interface body are not both BIND(C)165  module subroutine s2()166  end167  !ERROR: Module subprogram 's3' has binding label 's3_xxx' but the corresponding interface body has 's3'168  module subroutine s3() bind(c, name="s3" // suffix)169  end170  module subroutine s4() bind(c, name="s4  ")171  end172  module subroutine s5() bind(c, name=" s5")173  end174  !ERROR: Module subprogram 's6' has binding label 'not_s6' but the corresponding interface body has 's6'175  module subroutine s6() bind(c, name="not_s6")176  end177  module procedure s7178  end179end180 181 182module m3183  interface184    module subroutine s1(x, y, z)185      procedure(real), pointer, intent(in) :: x186      procedure(real), pointer, intent(out) :: y187      procedure(real), pointer, intent(out) :: z188    end189    module subroutine s2(x, y)190      procedure(real), pointer :: x191      procedure(real) :: y192    end193  end interface194end195 196submodule(m3) sm3197contains198  module subroutine s1(x, y, z)199    procedure(real), pointer, intent(in) :: x200    !ERROR: The intent of dummy argument 'y' does not match the intent of the corresponding argument in the interface body201    procedure(real), pointer, intent(inout) :: y202    !ERROR: The intent of dummy argument 'z' does not match the intent of the corresponding argument in the interface body203    procedure(real), pointer :: z204  end205  module subroutine s2(x, y)206    !ERROR: Dummy argument 'x' has the OPTIONAL attribute; the corresponding argument in the interface body does not207    !ERROR: Dummy argument 'x' does not have the POINTER attribute; the corresponding argument in the interface body does208    procedure(real), optional :: x209    !ERROR: Dummy argument 'y' has the POINTER attribute; the corresponding argument in the interface body does not210    procedure(real), pointer :: y211  end212end213 214module m4215  interface216    subroutine s_real(x)217      real :: x218    end219    subroutine s_real2(x)220      real :: x221    end222    subroutine s_integer(x)223      integer :: x224    end225    module subroutine s1(x)226      procedure(s_real) :: x227    end228    module subroutine s2(x)229      procedure(s_real) :: x230    end231  end interface232end233 234submodule(m4) sm4235contains236  module subroutine s1(x)237    !OK238    procedure(s_real2) :: x239  end240  module subroutine s2(x)241    !ERROR: Dummy procedure 'x' is not compatible with the corresponding argument in the interface body: incompatible dummy procedure interfaces: incompatible dummy argument #1: incompatible dummy data object types: INTEGER(4) vs REAL(4)242    procedure(s_integer) :: x243  end244end245 246module m5247  interface248    module function f1()249      real :: f1250    end251    module subroutine s2()252    end253  end interface254end255 256submodule(m5) sm5257contains258  !ERROR: Module subroutine 'f1' was declared as a function in the corresponding interface body259  module subroutine f1()260  end261  !ERROR: Module function 's2' was declared as a subroutine in the corresponding interface body262  module function s2()263  end264end265 266module m6267  interface268    module function f1()269      real :: f1270    end271    module function f2()272      real :: f2273    end274    module function f3()275      real :: f3276    end277  end interface278end279 280submodule(m6) ms6281contains282  !OK283  real module function f1()284  end285  !ERROR: Result of function 'f2' is not compatible with the result of the corresponding interface body: function results have distinct types: INTEGER(4) vs REAL(4)286  integer module function f2()287  end288  !ERROR: Result of function 'f3' is not compatible with the result of the corresponding interface body: function results have incompatible attributes289  module function f3()290    real :: f3291    pointer :: f3292  end293end294 295module m7296  interface297    module subroutine s1(x, *)298      real :: x299    end300  end interface301end302 303submodule(m7) sm7304contains305  !ERROR: Dummy argument 1 of 's1' is an alternate return indicator but the corresponding argument in the interface body is not306  !ERROR: Dummy argument 2 of 's1' is not an alternate return indicator but the corresponding argument in the interface body is307  module subroutine s1(*, x)308    real :: x309  end310end311 312module m8313  interface314    pure elemental module subroutine s1315    end subroutine316  end interface317end module318 319submodule(m8) sm8320 contains321  !Ensure no spurious error about mismatching attributes322  module procedure s1323  end procedure324end submodule325 326module m9327  interface328    module subroutine sub1(s)329      character(len=0) s330    end subroutine331    module subroutine sub2(s)332      character(len=0) s333    end subroutine334  end interface335end module336 337submodule(m9) sm1338 contains339  module subroutine sub1(s)340    character(len=-1) s ! ok341  end subroutine342  module subroutine sub2(s)343    !ERROR: Dummy argument 's' has type CHARACTER(KIND=1,LEN=1_8); the corresponding argument in the interface body has distinct type CHARACTER(KIND=1,LEN=0_8)344    character(len=1) s345  end subroutine346end submodule347 348module m10349  interface350    module character(2) function f()351    end function352  end interface353end module354submodule(m10) sm10355 contains356  !ERROR: Result of function 'f' is not compatible with the result of the corresponding interface body: function results have distinct types: CHARACTER(KIND=1,LEN=3_8) vs CHARACTER(KIND=1,LEN=2_8)357  module character(3) function f()358  end function359end submodule360 361module m11362  interface363    module subroutine s(x)364      ! The subroutine/function distinction is not known.365      external x366    end367  end interface368end369submodule(m11) sm11370 contains371  !WARNING: Dummy procedure 'x' does not exactly match the corresponding argument in the interface body [-Wmismatching-dummy-procedure]372  module subroutine s(x)373    call x ! no error374  end375end376