llvm-project/flang/test/Semantics/separate-mp02.f90

! RUN: %B/test/Semantics/test_errors.sh %s %flang %t

! When a module subprogram has the MODULE prefix the following must match
! with the corresponding separate module procedure interface body:
! - C1549: characteristics and dummy argument names
! - C1550: binding label
! - C1551: NON_RECURSIVE prefix

module m1
  interface
    module subroutine s4(x)
      real, intent(in) :: x
    end
    module subroutine s5(x, y)
      real, pointer :: x
      real, value :: y
    end
    module subroutine s6(x, y)
      real :: x
      real :: y
    end
    module subroutine s7(x, y, z)
      real :: x(8)
      real :: y(8)
      real :: z(8)
    end
    module subroutine s8(x, y, z)
      real :: x(8)
      real :: y(*)
      real :: z(*)
    end
    module subroutine s9(x, y, z, w)
      character(len=4) :: x
      character(len=4) :: y
      character(len=*) :: z
      character(len=*) :: w
    end
  end interface
end

submodule(m1) sm1
contains
  module subroutine s4(x)
    !ERROR: The intent of dummy argument 'x' does not match the intent of the corresponding argument in the interface body
    real, intent(out) :: x
  end
  module subroutine s5(x, y)
    !ERROR: Dummy argument 'x' has the OPTIONAL attribute; the corresponding argument in the interface body does not
    real, pointer, optional :: x
    !ERROR: Dummy argument 'y' does not have the VALUE attribute; the corresponding argument in the interface body does
    real :: y
  end
  module subroutine s6(x, y)
    !ERROR: Dummy argument 'x' has type INTEGER(4); the corresponding argument in the interface body has type REAL(4)
    integer :: x
    !ERROR: Dummy argument 'y' has type REAL(8); the corresponding argument in the interface body has type REAL(4)
    real(8) :: y
  end
  module subroutine s7(x, y, z)
    integer, parameter :: n = 8
    real :: x(n)
    real :: y(2:n+1)
    !ERROR: The shape of dummy argument 'z' does not match the shape of the corresponding argument in the interface body
    real :: z(n+1)
  end
  module subroutine s8(x, y, z)
    !ERROR: The shape of dummy argument 'x' does not match the shape of the corresponding argument in the interface body
    real :: x(*)
    real :: y(*)
    !ERROR: The shape of dummy argument 'z' does not match the shape of the corresponding argument in the interface body
    real :: z(8)
  end
  module subroutine s9(x, y, z, w)
    character(len=4) :: x
    !ERROR: Dummy argument 'y' has type CHARACTER(KIND=1,LEN=5_4); the corresponding argument in the interface body has type CHARACTER(KIND=1,LEN=4_4)
    character(len=5) :: y
    character(len=*) :: z
    !ERROR: Dummy argument 'w' has type CHARACTER(KIND=1,LEN=4_4); the corresponding argument in the interface body has type CHARACTER(KIND=1,LEN=*)
    character(len=4) :: w
  end
end

module m2
  interface
    module subroutine s1(x, y)
      real, intent(in) :: x
      real, intent(out) :: y
    end
    module subroutine s2(x, y)
      real, intent(in) :: x
      real, intent(out) :: y
    end
    module subroutine s3(x, y)
      real(4) :: x
      procedure(real) :: y
    end
    module subroutine s4()
    end
    non_recursive module subroutine s5()
    end
  end interface
end

submodule(m2) sm2
contains
  !ERROR: Module subprogram 's1' has 3 args but the corresponding interface body has 2
  module subroutine s1(x, y, z)
    real, intent(in) :: x
    real, intent(out) :: y
    real :: z
  end
  !ERROR: Dummy argument name 'z' does not match corresponding name 'y' in interface body
  module subroutine s2(x, z)
    real, intent(in) :: x
    real, intent(out) :: y
  end
  module subroutine s3(x, y)
    !ERROR: Dummy argument 'x' is a procedure; the corresponding argument in the interface body is not
    procedure(real) :: x
    !ERROR: Dummy argument 'y' is a data object; the corresponding argument in the interface body is not
    real :: y
  end
  !ERROR: Module subprogram 's4' has NON_RECURSIVE prefix but the corresponding interface body does not
  non_recursive module subroutine s4()
  end
  !ERROR: Module subprogram 's5' does not have NON_RECURSIVE prefix but the corresponding interface body does
  module subroutine s5()
  end
end

module m2b
  interface
    module subroutine s1()
    end
    module subroutine s2() bind(c, name="s2")
    end
    module subroutine s3() bind(c, name="s3")
    end
  end interface
end

submodule(m2b) sm2b
  character(*), parameter :: suffix = "_xxx"
contains
  !ERROR: Module subprogram 's1' has a binding label but the corresponding interface body does not
  module subroutine s1() bind(c, name="s1")
  end
  !ERROR: Module subprogram 's2' does not have a binding label but the corresponding interface body does
  module subroutine s2()
  end
  !ERROR: Module subprogram 's3' has binding label "s3_xxx" but the corresponding interface body has "s3"
  module subroutine s3() bind(c, name="s3" // suffix)
  end
end


module m3
  interface
    module subroutine s1(x, y, z)
      procedure(real), intent(in) :: x
      procedure(real), intent(out) :: y
      procedure(real), intent(out) :: z
    end
    module subroutine s2(x, y)
      procedure(real), pointer :: x
      procedure(real) :: y
    end
  end interface
end

submodule(m3) sm3
contains
  module subroutine s1(x, y, z)
    procedure(real), intent(in) :: x
    !ERROR: The intent of dummy argument 'y' does not match the intent of the corresponding argument in the interface body
    procedure(real), intent(inout) :: y
    !ERROR: The intent of dummy argument 'z' does not match the intent of the corresponding argument in the interface body
    procedure(real) :: z
  end
  module subroutine s2(x, y)
    !ERROR: Dummy argument 'x' has the OPTIONAL attribute; the corresponding argument in the interface body does not
    !ERROR: Dummy argument 'x' does not have the POINTER attribute; the corresponding argument in the interface body does
    procedure(real), optional :: x
    !ERROR: Dummy argument 'y' has the POINTER attribute; the corresponding argument in the interface body does not
    procedure(real), pointer :: y
  end
end

module m4
  interface
    subroutine s_real(x)
      real :: x
    end
    subroutine s_real2(x)
      real :: x
    end
    subroutine s_integer(x)
      integer :: x
    end
    module subroutine s1(x)
      procedure(s_real) :: x
    end
    module subroutine s2(x)
      procedure(s_real) :: x
    end
  end interface
end

submodule(m4) sm4
contains
  module subroutine s1(x)
    !OK
    procedure(s_real2) :: x
  end
  module subroutine s2(x)
    !ERROR: Dummy procedure 'x' does not match the corresponding argument in the interface body
    procedure(s_integer) :: x
  end
end

module m5
  interface
    module function f1()
      real :: f1
    end
    module subroutine s2()
    end
  end interface
end

submodule(m5) sm5
contains
  !ERROR: Module subroutine 'f1' was declared as a function in the corresponding interface body
  module subroutine f1()
  end
  !ERROR: Module function 's2' was declared as a subroutine in the corresponding interface body
  module function s2()
  end
end

module m6
  interface
    module function f1()
      real :: f1
    end
    module function f2()
      real :: f2
    end
    module function f3()
      real :: f3
    end
  end interface
end

submodule(m6) ms6
contains
  !OK
  real module function f1()
  end
  !ERROR: Return type of function 'f2' does not match return type of the corresponding interface body
  integer module function f2()
  end
  !ERROR: Return type of function 'f3' does not match return type of the corresponding interface body
  module function f3()
    real :: f3
    pointer :: f3
  end
end

module m7
  interface
    module subroutine s1(x, *)
      real :: x
    end
  end interface
end

submodule(m7) sm7
contains
  !ERROR: Dummy argument 1 of 's1' is an alternate return indicator but the corresponding argument in the interface body is not
  !ERROR: Dummy argument 2 of 's1' is not an alternate return indicator but the corresponding argument in the interface body is
  module subroutine s1(*, x)
    real :: x
  end
end