flang/test/Semantics/separate-mp02.f90

   1 ! RUN: %S/test_errors.sh %s %t %flang_fc1
   2 ! REQUIRES: shell
   3
   4 ! When a module subprogram has the MODULE prefix the following must match
   5 ! with the corresponding separate module procedure interface body:
   6 ! - C1549: characteristics and dummy argument names
   7 ! - C1550: binding label
   8 ! - C1551: NON_RECURSIVE prefix
   9
  10 module m1
  11   interface
  12     module subroutine s4(x)
  13       real, intent(in) :: x
  14     end
  15     module subroutine s5(x, y)
  16       real, pointer :: x
  17       real, value :: y
  18     end
  19     module subroutine s6(x, y)
  20       real :: x
  21       real :: y
  22     end
  23     module subroutine s7(x, y, z)
  24       real :: x(8)
  25       real :: y(8)
  26       real :: z(8)
  27     end
  28     module subroutine s8(x, y, z)
  29       real :: x(8)
  30       real :: y(*)
  31       real :: z(*)
  32     end
  33     module subroutine s9(x, y, z, w)
  34       character(len=4) :: x
  35       character(len=4) :: y
  36       character(len=*) :: z
  37       character(len=*) :: w
  38     end
  39   end interface
  40 end
  41
  42 submodule(m1) sm1
  43 contains
  44   module subroutine s4(x)
  45     !ERROR: The intent of dummy argument 'x' does not match the intent of the corresponding argument in the interface body
  46     real, intent(out) :: x
  47   end
  48   module subroutine s5(x, y)
  49     !ERROR: Dummy argument 'x' has the OPTIONAL attribute; the corresponding argument in the interface body does not
  50     real, pointer, optional :: x
  51     !ERROR: Dummy argument 'y' does not have the VALUE attribute; the corresponding argument in the interface body does
  52     real :: y
  53   end
  54   module subroutine s6(x, y)
  55     !ERROR: Dummy argument 'x' has type INTEGER(4); the corresponding argument in the interface body has type REAL(4)
  56     integer :: x
  57     !ERROR: Dummy argument 'y' has type REAL(8); the corresponding argument in the interface body has type REAL(4)
  58     real(8) :: y
  59   end
  60   module subroutine s7(x, y, z)
  61     integer, parameter :: n = 8
  62     real :: x(n)
  63     real :: y(2:n+1)
  64     !ERROR: The shape of dummy argument 'z' does not match the shape of the corresponding argument in the interface body
  65     real :: z(n+1)
  66   end
  67   module subroutine s8(x, y, z)
  68     !ERROR: The shape of dummy argument 'x' does not match the shape of the corresponding argument in the interface body
  69     real :: x(*)
  70     real :: y(*)
  71     !ERROR: The shape of dummy argument 'z' does not match the shape of the corresponding argument in the interface body
  72     real :: z(8)
  73   end
  74   module subroutine s9(x, y, z, w)
  75     character(len=4) :: x
  76     !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)
  77     character(len=5) :: y
  78     character(len=*) :: z
  79     !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=*)
  80     character(len=4) :: w
  81   end
  82 end
  83
  84 module m2
  85   interface
  86     module subroutine s1(x, y)
  87       real, intent(in) :: x
  88       real, intent(out) :: y
  89     end
  90     module subroutine s2(x, y)
  91       real, intent(in) :: x
  92       real, intent(out) :: y
  93     end
  94     module subroutine s3(x, y)
  95       real(4) :: x
  96       procedure(real) :: y
  97     end
  98     module subroutine s4()
  99     end
 100     non_recursive module subroutine s5()
 101     end
 102   end interface
 103 end
 104
 105 submodule(m2) sm2
 106 contains
 107   !ERROR: Module subprogram 's1' has 3 args but the corresponding interface body has 2
 108   module subroutine s1(x, y, z)
 109     real, intent(in) :: x
 110     real, intent(out) :: y
 111     real :: z
 112   end
 113   module subroutine s2(x, z)
 114     real, intent(in) :: x
 115   !ERROR: Dummy argument name 'z' does not match corresponding name 'y' in interface body
 116     real, intent(out) :: z
 117   end
 118   module subroutine s3(x, y)
 119     !ERROR: Dummy argument 'x' is a procedure; the corresponding argument in the interface body is not
 120     procedure(real) :: x
 121     !ERROR: Dummy argument 'y' is a data object; the corresponding argument in the interface body is not
 122     real :: y
 123   end
 124   !ERROR: Module subprogram 's4' has NON_RECURSIVE prefix but the corresponding interface body does not
 125   non_recursive module subroutine s4()
 126   end
 127   !ERROR: Module subprogram 's5' does not have NON_RECURSIVE prefix but the corresponding interface body does
 128   module subroutine s5()
 129   end
 130 end
 131
 132 module m2b
 133   interface
 134     module subroutine s1()
 135     end
 136     module subroutine s2() bind(c, name="s2")
 137     end
 138     module subroutine s3() bind(c, name="s3")
 139     end
 140     module subroutine s4() bind(c, name=" s4")
 141     end
 142     module subroutine s5() bind(c)
 143     end
 144     module subroutine s6() bind(c)
 145     end
 146   end interface
 147 end
 148
 149 submodule(m2b) sm2b
 150   character(*), parameter :: suffix = "_xxx"
 151 contains
 152   !ERROR: Module subprogram 's1' has a binding label but the corresponding interface body does not
 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   module subroutine s2()
 157   end
 158   !ERROR: Module subprogram 's3' has binding label 's3_xxx' but the corresponding interface body has 's3'
 159   module subroutine s3() bind(c, name="s3" // suffix)
 160   end
 161   module subroutine s4() bind(c, name="s4  ")
 162   end
 163   module subroutine s5() bind(c, name=" s5")
 164   end
 165   !ERROR: Module subprogram 's6' has binding label 'not_s6' but the corresponding interface body has 's6'
 166   module subroutine s6() bind(c, name="not_s6")
 167   end
 168 end
 169
 170
 171 module m3
 172   interface
 173     module subroutine s1(x, y, z)
 174       procedure(real), pointer, intent(in) :: x
 175       procedure(real), pointer, intent(out) :: y
 176       procedure(real), pointer, intent(out) :: z
 177     end
 178     module subroutine s2(x, y)
 179       procedure(real), pointer :: x
 180       procedure(real) :: y
 181     end
 182   end interface
 183 end
 184
 185 submodule(m3) sm3
 186 contains
 187   module subroutine s1(x, y, z)
 188     procedure(real), pointer, intent(in) :: x
 189     !ERROR: The intent of dummy argument 'y' does not match the intent of the corresponding argument in the interface body
 190     procedure(real), pointer, intent(inout) :: y
 191     !ERROR: The intent of dummy argument 'z' does not match the intent of the corresponding argument in the interface body
 192     procedure(real), pointer :: z
 193   end
 194   module subroutine s2(x, y)
 195     !ERROR: Dummy argument 'x' has the OPTIONAL attribute; the corresponding argument in the interface body does not
 196     !ERROR: Dummy argument 'x' does not have the POINTER attribute; the corresponding argument in the interface body does
 197     procedure(real), optional :: x
 198     !ERROR: Dummy argument 'y' has the POINTER attribute; the corresponding argument in the interface body does not
 199     procedure(real), pointer :: y
 200   end
 201 end
 202
 203 module m4
 204   interface
 205     subroutine s_real(x)
 206       real :: x
 207     end
 208     subroutine s_real2(x)
 209       real :: x
 210     end
 211     subroutine s_integer(x)
 212       integer :: x
 213     end
 214     module subroutine s1(x)
 215       procedure(s_real) :: x
 216     end
 217     module subroutine s2(x)
 218       procedure(s_real) :: x
 219     end
 220   end interface
 221 end
 222
 223 submodule(m4) sm4
 224 contains
 225   module subroutine s1(x)
 226     !OK
 227     procedure(s_real2) :: x
 228   end
 229   module subroutine s2(x)
 230     !ERROR: Dummy procedure 'x' does not match the corresponding argument in the interface body
 231     procedure(s_integer) :: x
 232   end
 233 end
 234
 235 module m5
 236   interface
 237     module function f1()
 238       real :: f1
 239     end
 240     module subroutine s2()
 241     end
 242   end interface
 243 end
 244
 245 submodule(m5) sm5
 246 contains
 247   !ERROR: Module subroutine 'f1' was declared as a function in the corresponding interface body
 248   module subroutine f1()
 249   end
 250   !ERROR: Module function 's2' was declared as a subroutine in the corresponding interface body
 251   module function s2()
 252   end
 253 end
 254
 255 module m6
 256   interface
 257     module function f1()
 258       real :: f1
 259     end
 260     module function f2()
 261       real :: f2
 262     end
 263     module function f3()
 264       real :: f3
 265     end
 266   end interface
 267 end
 268
 269 submodule(m6) ms6
 270 contains
 271   !OK
 272   real module function f1()
 273   end
 274   !ERROR: Return type of function 'f2' does not match return type of the corresponding interface body
 275   integer module function f2()
 276   end
 277   !ERROR: Return type of function 'f3' does not match return type of the corresponding interface body
 278   module function f3()
 279     real :: f3
 280     pointer :: f3
 281   end
 282 end
 283
 284 module m7
 285   interface
 286     module subroutine s1(x, *)
 287       real :: x
 288     end
 289   end interface
 290 end
 291
 292 submodule(m7) sm7
 293 contains
 294   !ERROR: Dummy argument 1 of 's1' is an alternate return indicator but the corresponding argument in the interface body is not
 295   !ERROR: Dummy argument 2 of 's1' is not an alternate return indicator but the corresponding argument in the interface body is
 296   module subroutine s1(*, x)
 297     real :: x
 298   end
 299 end