flang/test/Semantics/separate-mp02.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
   2
   3 ! When a module subprogram has the MODULE prefix the following must match
   4 ! with the corresponding separate module procedure interface body:
   5 ! - C1549: characteristics and dummy argument names
   6 ! - C1550: binding label
   7 ! - C1551: NON_RECURSIVE prefix
   8
   9 module m1
  10   interface
  11     module subroutine s4(x)
  12       real, intent(in) :: x
  13     end
  14     module subroutine s5(x, y)
  15       real, pointer :: x
  16       real, value :: y
  17     end
  18     module subroutine s6(x, y)
  19       real :: x
  20       real :: y
  21     end
  22     module subroutine s7(x, y, z)
  23       real :: x(8)
  24       real :: y(8)
  25       real :: z(8)
  26     end
  27     module subroutine s8(x, y, z)
  28       real :: x(8)
  29       real :: y(*)
  30       real :: z(*)
  31     end
  32     module subroutine s9(x, y, z, w)
  33       character(len=4) :: x
  34       character(len=4) :: y
  35       character(len=*) :: z
  36       character(len=*) :: w
  37     end
  38     module subroutine s10(x, y, z, w)
  39       real x(0:), y(:), z(0:*), w(*)
  40     end
  41   end interface
  42 end
  43
  44 submodule(m1) sm1
  45 contains
  46   module subroutine s4(x)
  47     !ERROR: The intent of dummy argument 'x' does not match the intent of the corresponding argument in the interface body
  48     real, intent(out) :: x
  49   end
  50   module subroutine s5(x, y)
  51     !ERROR: Dummy argument 'x' has the OPTIONAL attribute; the corresponding argument in the interface body does not
  52     real, pointer, optional :: x
  53     !ERROR: Dummy argument 'y' does not have the VALUE attribute; the corresponding argument in the interface body does
  54     real :: y
  55   end
  56   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 :: x
  59     !ERROR: Dummy argument 'y' has type REAL(8); the corresponding argument in the interface body has distinct type REAL(4)
  60     real(8) :: y
  61   end
  62   module subroutine s7(x, y, z)
  63     integer, parameter :: n = 8
  64     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 body
  67     real :: z(n+1)
  68   end
  69   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 body
  71     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 body
  74     real :: z(8)
  75   end
  76   module subroutine s9(x, y, z, w)
  77     character(len=4) :: x
  78     !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) :: y
  80     character(len=*) :: z
  81     !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) :: w
  83   end
  84   module subroutine s10(x, y, z, w)
  85     real x(:), y(0:), z(*), w(0:*) ! all ok, lower bounds don't matter
  86   end
  87 end
  88
  89 module m2
  90   interface
  91     module subroutine s1(x, y)
  92       real, intent(in) :: x
  93       real, intent(out) :: y
  94     end
  95     module subroutine s2(x, y)
  96       real, intent(in) :: x
  97       real, intent(out) :: y
  98     end
  99     module subroutine s3(x, y)
 100       real(4) :: x
 101       procedure(real) :: y
 102     end
 103     module subroutine s4()
 104     end
 105     non_recursive module subroutine s5()
 106     end
 107   end interface
 108 end
 109
 110 submodule(m2) sm2
 111 contains
 112   !ERROR: Module subprogram 's1' has 3 args but the corresponding interface body has 2
 113   module subroutine s1(x, y, z)
 114     real, intent(in) :: x
 115     real, intent(out) :: y
 116     real :: z
 117   end
 118   module subroutine s2(x, z)
 119     real, intent(in) :: x
 120   !ERROR: Dummy argument name 'z' does not match corresponding name 'y' in interface body
 121     real, intent(out) :: z
 122   end
 123   module subroutine s3(x, y)
 124     !ERROR: Dummy argument 'x' is a procedure; the corresponding argument in the interface body is not
 125     procedure(real) :: x
 126     !ERROR: Dummy argument 'y' is a data object; the corresponding argument in the interface body is not
 127     real :: y
 128   end
 129   !ERROR: Module subprogram 's4' has NON_RECURSIVE prefix but the corresponding interface body does not
 130   non_recursive module subroutine s4()
 131   end
 132   !ERROR: Module subprogram 's5' does not have NON_RECURSIVE prefix but the corresponding interface body does
 133   module subroutine s5()
 134   end
 135 end
 136
 137 module m2b
 138   interface
 139     module subroutine s1()
 140     end
 141     module subroutine s2() bind(c, name="s2")
 142     end
 143     module subroutine s3() bind(c, name="s3")
 144     end
 145     module subroutine s4() bind(c, name=" s4")
 146     end
 147     module subroutine s5() bind(c)
 148     end
 149     module subroutine s6() bind(c)
 150     end
 151     module subroutine s7() bind(c, name="s7")
 152     end
 153   end interface
 154 end
 155
 156 submodule(m2b) sm2b
 157   character(*), parameter :: suffix = "_xxx"
 158 contains
 159   !ERROR: Module subprogram 's1' has a binding label but the corresponding interface body does not
 160   !ERROR: Module subprogram 's1' and its corresponding interface body are not both BIND(C)
 161   module subroutine s1() bind(c, name="s1")
 162   end
 163   !ERROR: Module subprogram 's2' does not have a binding label but the corresponding interface body does
 164   !ERROR: Module subprogram 's2' and its corresponding interface body are not both BIND(C)
 165   module subroutine s2()
 166   end
 167   !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   end
 170   module subroutine s4() bind(c, name="s4  ")
 171   end
 172   module subroutine s5() bind(c, name=" s5")
 173   end
 174   !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   end
 177   module procedure s7
 178   end
 179 end
 180
 181
 182 module m3
 183   interface
 184     module subroutine s1(x, y, z)
 185       procedure(real), pointer, intent(in) :: x
 186       procedure(real), pointer, intent(out) :: y
 187       procedure(real), pointer, intent(out) :: z
 188     end
 189     module subroutine s2(x, y)
 190       procedure(real), pointer :: x
 191       procedure(real) :: y
 192     end
 193   end interface
 194 end
 195
 196 submodule(m3) sm3
 197 contains
 198   module subroutine s1(x, y, z)
 199     procedure(real), pointer, intent(in) :: x
 200     !ERROR: The intent of dummy argument 'y' does not match the intent of the corresponding argument in the interface body
 201     procedure(real), pointer, intent(inout) :: y
 202     !ERROR: The intent of dummy argument 'z' does not match the intent of the corresponding argument in the interface body
 203     procedure(real), pointer :: z
 204   end
 205   module subroutine s2(x, y)
 206     !ERROR: Dummy argument 'x' has the OPTIONAL attribute; the corresponding argument in the interface body does not
 207     !ERROR: Dummy argument 'x' does not have the POINTER attribute; the corresponding argument in the interface body does
 208     procedure(real), optional :: x
 209     !ERROR: Dummy argument 'y' has the POINTER attribute; the corresponding argument in the interface body does not
 210     procedure(real), pointer :: y
 211   end
 212 end
 213
 214 module m4
 215   interface
 216     subroutine s_real(x)
 217       real :: x
 218     end
 219     subroutine s_real2(x)
 220       real :: x
 221     end
 222     subroutine s_integer(x)
 223       integer :: x
 224     end
 225     module subroutine s1(x)
 226       procedure(s_real) :: x
 227     end
 228     module subroutine s2(x)
 229       procedure(s_real) :: x
 230     end
 231   end interface
 232 end
 233
 234 submodule(m4) sm4
 235 contains
 236   module subroutine s1(x)
 237     !OK
 238     procedure(s_real2) :: x
 239   end
 240   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) :: x
 243   end
 244 end
 245
 246 module m5
 247   interface
 248     module function f1()
 249       real :: f1
 250     end
 251     module subroutine s2()
 252     end
 253   end interface
 254 end
 255
 256 submodule(m5) sm5
 257 contains
 258   !ERROR: Module subroutine 'f1' was declared as a function in the corresponding interface body
 259   module subroutine f1()
 260   end
 261   !ERROR: Module function 's2' was declared as a subroutine in the corresponding interface body
 262   module function s2()
 263   end
 264 end
 265
 266 module m6
 267   interface
 268     module function f1()
 269       real :: f1
 270     end
 271     module function f2()
 272       real :: f2
 273     end
 274     module function f3()
 275       real :: f3
 276     end
 277   end interface
 278 end
 279
 280 submodule(m6) ms6
 281 contains
 282   !OK
 283   real module function f1()
 284   end
 285   !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   end
 288   !ERROR: Result of function 'f3' is not compatible with the result of the corresponding interface body: function results have incompatible attributes
 289   module function f3()
 290     real :: f3
 291     pointer :: f3
 292   end
 293 end
 294
 295 module m7
 296   interface
 297     module subroutine s1(x, *)
 298       real :: x
 299     end
 300   end interface
 301 end
 302
 303 submodule(m7) sm7
 304 contains
 305   !ERROR: Dummy argument 1 of 's1' is an alternate return indicator but the corresponding argument in the interface body is not
 306   !ERROR: Dummy argument 2 of 's1' is not an alternate return indicator but the corresponding argument in the interface body is
 307   module subroutine s1(*, x)
 308     real :: x
 309   end
 310 end
 311
 312 module m8
 313   interface
 314     pure elemental module subroutine s1
 315     end subroutine
 316   end interface
 317 end module
 318
 319 submodule(m8) sm8
 320  contains
 321   !Ensure no spurious error about mismatching attributes
 322   module procedure s1
 323   end procedure
 324 end submodule
 325
 326 module m9
 327   interface
 328     module subroutine sub1(s)
 329       character(len=0) s
 330     end subroutine
 331     module subroutine sub2(s)
 332       character(len=0) s
 333     end subroutine
 334   end interface
 335 end module
 336
 337 submodule(m9) sm1
 338  contains
 339   module subroutine sub1(s)
 340     character(len=-1) s ! ok
 341   end subroutine
 342   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) s
 345   end subroutine
 346 end submodule
 347
 348 module m10
 349   interface
 350     module character(2) function f()
 351     end function
 352   end interface
 353 end module
 354 submodule(m10) sm10
 355  contains
 356   !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 function
 359 end submodule
 360
 361 module m11
 362   interface
 363     module subroutine s(x)
 364       ! The subroutine/function distinction is not known.
 365       external x
 366     end
 367   end interface
 368 end
 369 submodule(m11) sm11
 370  contains
 371   !WARNING: Dummy procedure 'x' does not exactly match the corresponding argument in the interface body
 372   module subroutine s(x)
 373     call x ! no error
 374   end
 375 end