flang/test/Semantics/separate-mp02.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   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   end interface
  39 end
  40
  41 submodule(m1) sm1
  42 contains
  43   module subroutine s4(x)
  44     !ERROR: The intent of dummy argument 'x' does not match the intent of the corresponding argument in the interface body
  45     real, intent(out) :: x
  46   end
  47   module subroutine s5(x, y)
  48     !ERROR: Dummy argument 'x' has the OPTIONAL attribute; the corresponding argument in the interface body does not
  49     real, pointer, optional :: x
  50     !ERROR: Dummy argument 'y' does not have the VALUE attribute; the corresponding argument in the interface body does
  51     real :: y
  52   end
  53   module subroutine s6(x, y)
  54     !ERROR: Dummy argument 'x' has type INTEGER(4); the corresponding argument in the interface body has type REAL(4)
  55     integer :: x
  56     !ERROR: Dummy argument 'y' has type REAL(8); the corresponding argument in the interface body has type REAL(4)
  57     real(8) :: y
  58   end
  59   module subroutine s7(x, y, z)
  60     integer, parameter :: n = 8
  61     real :: x(n)
  62     real :: y(2:n+1)
  63     !ERROR: The shape of dummy argument 'z' does not match the shape of the corresponding argument in the interface body
  64     real :: z(n+1)
  65   end
  66   module subroutine s8(x, y, z)
  67     !ERROR: The shape of dummy argument 'x' does not match the shape of the corresponding argument in the interface body
  68     real :: x(*)
  69     real :: y(*)
  70     !ERROR: The shape of dummy argument 'z' does not match the shape of the corresponding argument in the interface body
  71     real :: z(8)
  72   end
  73   module subroutine s9(x, y, z, w)
  74     character(len=4) :: x
  75     !ERROR: Dummy argument 'y' has type CHARACTER(KIND=1,LEN=5_8); the corresponding argument in the interface body has type CHARACTER(KIND=1,LEN=4_8)
  76     character(len=5) :: y
  77     character(len=*) :: z
  78     !ERROR: Dummy argument 'w' has type CHARACTER(KIND=1,LEN=4_8); the corresponding argument in the interface body has type CHARACTER(KIND=1,LEN=*)
  79     character(len=4) :: w
  80   end
  81 end
  82
  83 module m2
  84   interface
  85     module subroutine s1(x, y)
  86       real, intent(in) :: x
  87       real, intent(out) :: y
  88     end
  89     module subroutine s2(x, y)
  90       real, intent(in) :: x
  91       real, intent(out) :: y
  92     end
  93     module subroutine s3(x, y)
  94       real(4) :: x
  95       procedure(real) :: y
  96     end
  97     module subroutine s4()
  98     end
  99     non_recursive module subroutine s5()
 100     end
 101   end interface
 102 end
 103
 104 submodule(m2) sm2
 105 contains
 106   !ERROR: Module subprogram 's1' has 3 args but the corresponding interface body has 2
 107   module subroutine s1(x, y, z)
 108     real, intent(in) :: x
 109     real, intent(out) :: y
 110     real :: z
 111   end
 112   module subroutine s2(x, z)
 113     real, intent(in) :: x
 114   !ERROR: Dummy argument name 'z' does not match corresponding name 'y' in interface body
 115     real, intent(out) :: z
 116   end
 117   module subroutine s3(x, y)
 118     !ERROR: Dummy argument 'x' is a procedure; the corresponding argument in the interface body is not
 119     procedure(real) :: x
 120     !ERROR: Dummy argument 'y' is a data object; the corresponding argument in the interface body is not
 121     real :: y
 122   end
 123   !ERROR: Module subprogram 's4' has NON_RECURSIVE prefix but the corresponding interface body does not
 124   non_recursive module subroutine s4()
 125   end
 126   !ERROR: Module subprogram 's5' does not have NON_RECURSIVE prefix but the corresponding interface body does
 127   module subroutine s5()
 128   end
 129 end
 130
 131 module m2b
 132   interface
 133     module subroutine s1()
 134     end
 135     module subroutine s2() bind(c, name="s2")
 136     end
 137     module subroutine s3() bind(c, name="s3")
 138     end
 139     module subroutine s4() bind(c, name=" s4")
 140     end
 141     module subroutine s5() bind(c)
 142     end
 143     module subroutine s6() bind(c)
 144     end
 145   end interface
 146 end
 147
 148 submodule(m2b) sm2b
 149   character(*), parameter :: suffix = "_xxx"
 150 contains
 151   !ERROR: Module subprogram 's1' has a binding label but the corresponding interface body does not
 152   !ERROR: Module subprogram 's1' and its corresponding interface body are not both BIND(C)
 153   module subroutine s1() bind(c, name="s1")
 154   end
 155   !ERROR: Module subprogram 's2' does not have a binding label but the corresponding interface body does
 156   !ERROR: Module subprogram 's2' and its corresponding interface body are not both BIND(C)
 157   module subroutine s2()
 158   end
 159   !ERROR: Module subprogram 's3' has binding label 's3_xxx' but the corresponding interface body has 's3'
 160   module subroutine s3() bind(c, name="s3" // suffix)
 161   end
 162   module subroutine s4() bind(c, name="s4  ")
 163   end
 164   module subroutine s5() bind(c, name=" s5")
 165   end
 166   !ERROR: Module subprogram 's6' has binding label 'not_s6' but the corresponding interface body has 's6'
 167   module subroutine s6() bind(c, name="not_s6")
 168   end
 169 end
 170
 171
 172 module m3
 173   interface
 174     module subroutine s1(x, y, z)
 175       procedure(real), pointer, intent(in) :: x
 176       procedure(real), pointer, intent(out) :: y
 177       procedure(real), pointer, intent(out) :: z
 178     end
 179     module subroutine s2(x, y)
 180       procedure(real), pointer :: x
 181       procedure(real) :: y
 182     end
 183   end interface
 184 end
 185
 186 submodule(m3) sm3
 187 contains
 188   module subroutine s1(x, y, z)
 189     procedure(real), pointer, intent(in) :: x
 190     !ERROR: The intent of dummy argument 'y' does not match the intent of the corresponding argument in the interface body
 191     procedure(real), pointer, intent(inout) :: y
 192     !ERROR: The intent of dummy argument 'z' does not match the intent of the corresponding argument in the interface body
 193     procedure(real), pointer :: z
 194   end
 195   module subroutine s2(x, y)
 196     !ERROR: Dummy argument 'x' has the OPTIONAL attribute; the corresponding argument in the interface body does not
 197     !ERROR: Dummy argument 'x' does not have the POINTER attribute; the corresponding argument in the interface body does
 198     procedure(real), optional :: x
 199     !ERROR: Dummy argument 'y' has the POINTER attribute; the corresponding argument in the interface body does not
 200     procedure(real), pointer :: y
 201   end
 202 end
 203
 204 module m4
 205   interface
 206     subroutine s_real(x)
 207       real :: x
 208     end
 209     subroutine s_real2(x)
 210       real :: x
 211     end
 212     subroutine s_integer(x)
 213       integer :: x
 214     end
 215     module subroutine s1(x)
 216       procedure(s_real) :: x
 217     end
 218     module subroutine s2(x)
 219       procedure(s_real) :: x
 220     end
 221   end interface
 222 end
 223
 224 submodule(m4) sm4
 225 contains
 226   module subroutine s1(x)
 227     !OK
 228     procedure(s_real2) :: x
 229   end
 230   module subroutine s2(x)
 231     !ERROR: Dummy procedure 'x' does not match the corresponding argument in the interface body
 232     procedure(s_integer) :: x
 233   end
 234 end
 235
 236 module m5
 237   interface
 238     module function f1()
 239       real :: f1
 240     end
 241     module subroutine s2()
 242     end
 243   end interface
 244 end
 245
 246 submodule(m5) sm5
 247 contains
 248   !ERROR: Module subroutine 'f1' was declared as a function in the corresponding interface body
 249   module subroutine f1()
 250   end
 251   !ERROR: Module function 's2' was declared as a subroutine in the corresponding interface body
 252   module function s2()
 253   end
 254 end
 255
 256 module m6
 257   interface
 258     module function f1()
 259       real :: f1
 260     end
 261     module function f2()
 262       real :: f2
 263     end
 264     module function f3()
 265       real :: f3
 266     end
 267   end interface
 268 end
 269
 270 submodule(m6) ms6
 271 contains
 272   !OK
 273   real module function f1()
 274   end
 275   !ERROR: Return type of function 'f2' does not match return type of the corresponding interface body
 276   integer module function f2()
 277   end
 278   !ERROR: Return type of function 'f3' does not match return type of the corresponding interface body
 279   module function f3()
 280     real :: f3
 281     pointer :: f3
 282   end
 283 end
 284
 285 module m7
 286   interface
 287     module subroutine s1(x, *)
 288       real :: x
 289     end
 290   end interface
 291 end
 292
 293 submodule(m7) sm7
 294 contains
 295   !ERROR: Dummy argument 1 of 's1' is an alternate return indicator but the corresponding argument in the interface body is not
 296   !ERROR: Dummy argument 2 of 's1' is not an alternate return indicator but the corresponding argument in the interface body is
 297   module subroutine s1(*, x)
 298     real :: x
 299   end
 300 end
 301
 302 module m8
 303   interface
 304     pure elemental module subroutine s1
 305     end subroutine
 306   end interface
 307 end module
 308
 309 submodule(m8) sm8
 310  contains
 311   !Ensure no spurious error about mismatching attributes
 312   module procedure s1
 313   end procedure
 314 end submodule
 315
 316 module m9
 317   interface
 318     module subroutine sub1(s)
 319       character(len=0) s
 320     end subroutine
 321     module subroutine sub2(s)
 322       character(len=0) s
 323     end subroutine
 324   end interface
 325 end module
 326
 327 submodule(m9) sm1
 328  contains
 329   module subroutine sub1(s)
 330     character(len=-1) s ! ok
 331   end subroutine
 332   module subroutine sub2(s)
 333     !ERROR: Dummy argument 's' has type CHARACTER(KIND=1,LEN=1_8); the corresponding argument in the interface body has type CHARACTER(KIND=1,LEN=0_8)
 334     character(len=1) s
 335   end subroutine
 336 end submodule