test/Semantics/resolve18.f90

! RUN: %python %S/test_errors.py %s %flang_fc1
module m1
  implicit none
contains
  subroutine foo(x)
    real :: x
  end subroutine
end module

!Note: PGI, Intel, GNU, and NAG allow this; Sun does not
module m2
  use m1
  implicit none
  !WARNING: 'foo' should not be the name of both a generic interface and a procedure unless it is a specific procedure of the generic
  interface foo
    module procedure s
  end interface
contains
  subroutine s(i)
    integer :: i
  end subroutine
end module

subroutine foo
  !ERROR: Cannot use-associate 'foo'; it is already declared in this scope
  use m1
end

subroutine bar
  !ERROR: Cannot use-associate 'bar'; it is already declared in this scope
  use m1, bar => foo
end

!OK to use-associate a type with the same name as a generic
module m3a
  type :: foo
  end type
end
module m3b
  use m3a
  interface foo
  end interface
end

! Can't have derived type and function with same name
module m4a
  type :: foo
  end type
contains
  !ERROR: 'foo' is already declared in this scoping unit
  function foo(x)
  end
end
! Even if there is also a generic interface of that name
module m4b
  type :: foo
  end type
  interface foo
    procedure :: foo
  end interface foo
contains
  !ERROR: 'foo' is already declared in this scoping unit
  function foo(x)
  end
end
module m4c
  type :: foo
  end type
  interface foo
    !ERROR: 'foo' is already declared in this scoping unit
    real function foo()
    end function foo
  end interface foo
end

! Use associating a name that is a generic and a derived type
module m5a
  interface g
  end interface
  type g
  end type
end module
module m5b
  use m5a
  interface g
    procedure f
  end interface
  type(g) :: x
contains
  function f(i)
  end function
end module
subroutine s5
  use m5b
  type(g) :: y
end

module m6
  real :: f6
  interface g6
  !ERROR: 'f6' is already declared in this scoping unit
    real function f6()
    end function f6
  end interface g6
end module m6

module m7
  integer :: f7
  interface g7
    !ERROR: 'f7' is already declared in this scoping unit
    real function f7()
    end function f7
  end interface g7
end module m7

module m8
  real :: f8
  interface g8
    !ERROR: 'f8' is already declared in this scoping unit
    subroutine f8()
    end subroutine f8
  end interface g8
end module m8

module m9
  type f9
  end type f9
  interface f9
    real function f9()
    end function f9
  end interface f9
contains
  !ERROR: 'f9' is already declared in this scoping unit
  function f9(x)
  end function f9
end module m9

module m10
  type :: t10
  end type t10
  interface f10
    function f10()
    end function f10
  end interface f10
contains
  !ERROR: 'f10' is already declared in this scoping unit
  function f10(x)
  end function f10
end module m10

module m11
  type :: t11
  end type t11
  interface i11
    function f11()
    end function f11
  end interface i11
contains
  !ERROR: 'f11' is already declared in this scoping unit
  function f11(x)
  end function f11
end module m11

module m12
  interface f12
    function f12()
    end function f12
  end interface f12
contains
  !ERROR: 'f12' is already declared in this scoping unit
  function f12(x)
  end function f12
end module m12

module m13
  interface f13
    function f13()
    end function f13
  end interface f13
contains
  !ERROR: 'f13' is already declared in this scoping unit
  function f13()
  end function f13
end module m13

! Not an error
module m14
  interface gen1
    module procedure s
  end interface
  generic :: gen2 => s
 contains
  subroutine s(x)
    integer(1) :: x
  end subroutine s
end module m14
module m15
  use m14
  interface gen1
    module procedure gen1
  end interface
  generic :: gen2 => gen2
 contains
  subroutine gen1(x)
    integer(2) :: x
  end subroutine gen1
  subroutine gen2(x)
    integer(4) :: x
  end subroutine gen2
end module m15

module m15a
  interface foo
    module procedure foo
  end interface
 contains
  function foo()
  end
end

module m15b
  interface foo
    module procedure foo
  end interface
 contains
  function foo(x)
  end
end

subroutine test15
  use m15a
  use m15b ! ok
end


module m16a
  type foo
    integer j
  end type
  interface foo
    module procedure bar
  end interface
 contains
  function bar(j)
  end
end

module m16b
  type foo
    integer j, k
  end type
  interface foo
    module procedure bar
  end interface
 contains
  function bar(x,y)
  end
end

subroutine test16
  use m16a
  use m16b ! ok
end

subroutine test17
  use m15a
  use m16a ! ok
end

subroutine test18
  use m16a
  use m15a ! ok
end

module m21
  type foo
    integer a
  end type
  interface foo
    module procedure f1
  end interface
 contains
  function f1(a)
    f1 = a
  end
end

module m22
  type foo
    real b
  end type
  interface foo
    module procedure f2
  end interface
 contains
  function f2(a,b)
    f2 = a + b
  end
end

module m23
  interface foo
    module procedure foo
    module procedure f3
  end interface
 contains
  function foo()
    foo = 0.
  end
  function f3(a,b,c)
    f3 = a + b + c
  end
end

module m24
  interface foo
    module procedure foo
    module procedure f4
  end interface
 contains
  function foo(a)
    foo = a
  end
  function f4(a,b,c,d)
    f4 = a + b + c +d
  end
end

subroutine s_21_22_a
  use m21
  use m22
  print *, foo(1.) ! Intel error
  print *, foo(1.,2.) ! Intel error
end

subroutine s_21_22_b
  use m21
  use m22
  !ERROR: 'foo' is not a derived type
  type(foo) x ! definite error: GNU and Intel catch
end

subroutine s_21_23
  use m21
  use m23
  type(foo) x ! Intel and NAG error
  print *, foo(1.) ! Intel error
  print *, foo(1.,2.,3.) ! Intel error
  call ext(foo) ! GNU and Intel error
end

subroutine s_22_23
  use m22
  use m23
  type(foo) x ! Intel and NAG error
  print *, foo(1.,2.) ! Intel error
  print *, foo(1.,2.,3.) ! Intel error
  call ext(foo) ! Intel error
end

subroutine s_23_24
  use m23
  use m24
  print *, foo(1.,2.,3.) ! NAG error
  print *, foo(1.,2.,3.,4.) ! XLF error
  !ERROR: 'foo' is not a specific procedure
  call ext(foo) ! definite error
end