Generic type-bound interfaces for user-defined operators need to be formatted as "OPERATOR(.op.)", not just ".op." PRIVATE generics need to be marked as such. Declaration ordering: when a generic interface shadows a derived type of the same name, it needs to be emitted to the module file at the point of definition of the derived type; otherwise, the derived type's definition may appear after its first use. The module symbol for a module read from a module file needs to be marked as coming from a module file before semantic processing is performed on the contents of the module so that any special handling for declarations in module files can be properly activated. IMPORT statements were sometimes missing for use-associated symbols in surrounding scopes; fine-tune NeedImport(). Differential Revision: https://reviews.llvm.org/D94636
252 lines
5.3 KiB
Fortran
252 lines
5.3 KiB
Fortran
! RUN: %S/test_modfile.sh %s %t %f18
|
|
module m1
|
|
type :: t1
|
|
contains
|
|
procedure, pass(x) :: p1 => f
|
|
procedure, non_overridable :: p2 => f
|
|
procedure, nopass :: p3 => f
|
|
generic :: operator(+) => p1
|
|
generic :: operator(-) => p2
|
|
generic :: operator(<) => p1
|
|
generic :: operator(.and.) => p2
|
|
end type
|
|
contains
|
|
integer(8) pure function f(x, y)
|
|
class(t1), intent(in) :: x
|
|
integer, intent(in) :: y
|
|
end
|
|
! Operators resolve to type-bound operators in t1
|
|
subroutine test1(x, y, a, b)
|
|
class(t1) :: x
|
|
integer :: y
|
|
real :: a(x + y)
|
|
real :: b(x .lt. y)
|
|
end
|
|
! Operators resolve to type-bound operators in t1, compile-time resolvable
|
|
subroutine test2(x, y, a, b)
|
|
class(t1) :: x
|
|
integer :: y
|
|
real :: a(x - y)
|
|
real :: b(x .and. y)
|
|
end
|
|
! Operators resolve to type-bound operators in t1, compile-time resolvable
|
|
subroutine test3(x, y, a)
|
|
type(t1) :: x
|
|
integer :: y
|
|
real :: a(x + y)
|
|
end
|
|
end
|
|
!Expect: m1.mod
|
|
!module m1
|
|
! type :: t1
|
|
! contains
|
|
! procedure, pass(x) :: p1 => f
|
|
! procedure, non_overridable :: p2 => f
|
|
! procedure, nopass :: p3 => f
|
|
! generic :: operator(+) => p1
|
|
! generic :: operator(-) => p2
|
|
! generic :: operator(<) => p1
|
|
! generic :: operator(.and.) => p2
|
|
! end type
|
|
!contains
|
|
! pure function f(x, y)
|
|
! class(t1), intent(in) :: x
|
|
! integer(4), intent(in) :: y
|
|
! integer(8) :: f
|
|
! end
|
|
! subroutine test1(x, y, a, b)
|
|
! class(t1) :: x
|
|
! integer(4) :: y
|
|
! real(4) :: a(1_8:x%p1(y))
|
|
! real(4) :: b(1_8:x%p1(y))
|
|
! end
|
|
! subroutine test2(x, y, a, b)
|
|
! class(t1) :: x
|
|
! integer(4) :: y
|
|
! real(4) :: a(1_8:f(x, y))
|
|
! real(4) :: b(1_8:f(x, y))
|
|
! end
|
|
! subroutine test3(x,y,a)
|
|
! type(t1) :: x
|
|
! integer(4) :: y
|
|
! real(4) :: a(1_8:f(x,y))
|
|
! end
|
|
!end
|
|
|
|
module m2
|
|
type :: t1
|
|
contains
|
|
procedure, pass(x) :: p1 => f1
|
|
generic :: operator(+) => p1
|
|
end type
|
|
type, extends(t1) :: t2
|
|
contains
|
|
procedure, pass(y) :: p2 => f2
|
|
generic :: operator(+) => p2
|
|
end type
|
|
contains
|
|
integer(8) pure function f1(x, y)
|
|
class(t1), intent(in) :: x
|
|
integer, intent(in) :: y
|
|
end
|
|
integer(8) pure function f2(x, y)
|
|
class(t1), intent(in) :: x
|
|
class(t2), intent(in) :: y
|
|
end
|
|
subroutine test1(x, y, a)
|
|
class(t1) :: x
|
|
integer :: y
|
|
real :: a(x + y)
|
|
end
|
|
! Resolve to operator in parent class
|
|
subroutine test2(x, y, a)
|
|
class(t2) :: x
|
|
integer :: y
|
|
real :: a(x + y)
|
|
end
|
|
! 2nd arg is passed object
|
|
subroutine test3(x, y, a)
|
|
class(t1) :: x
|
|
class(t2) :: y
|
|
real :: a(x + y)
|
|
end
|
|
end
|
|
!Expect: m2.mod
|
|
!module m2
|
|
! type :: t1
|
|
! contains
|
|
! procedure, pass(x) :: p1 => f1
|
|
! generic :: operator(+) => p1
|
|
! end type
|
|
! type, extends(t1) :: t2
|
|
! contains
|
|
! procedure, pass(y) :: p2 => f2
|
|
! generic :: operator(+) => p2
|
|
! end type
|
|
!contains
|
|
! pure function f1(x, y)
|
|
! class(t1), intent(in) :: x
|
|
! integer(4), intent(in) :: y
|
|
! integer(8) :: f1
|
|
! end
|
|
! pure function f2(x, y)
|
|
! class(t1), intent(in) :: x
|
|
! class(t2), intent(in) :: y
|
|
! integer(8) :: f2
|
|
! end
|
|
! subroutine test1(x, y, a)
|
|
! class(t1) :: x
|
|
! integer(4) :: y
|
|
! real(4) :: a(1_8:x%p1(y))
|
|
! end
|
|
! subroutine test2(x, y, a)
|
|
! class(t2) :: x
|
|
! integer(4) :: y
|
|
! real(4) :: a(1_8:x%p1(y))
|
|
! end
|
|
! subroutine test3(x, y, a)
|
|
! class(t1) :: x
|
|
! class(t2) :: y
|
|
! real(4) :: a(1_8:y%p2(x))
|
|
! end
|
|
!end
|
|
|
|
module m3
|
|
type :: t1
|
|
contains
|
|
procedure, pass(x) :: p1 => f1
|
|
procedure :: p3 => f3
|
|
generic :: operator(.binary.) => p1
|
|
generic :: operator(.unary.) => p3
|
|
end type
|
|
type, extends(t1) :: t2
|
|
contains
|
|
procedure, pass(y) :: p2 => f2
|
|
generic :: operator(.binary.) => p2
|
|
end type
|
|
contains
|
|
integer(8) pure function f1(x, y)
|
|
class(t1), intent(in) :: x
|
|
integer, intent(in) :: y
|
|
end
|
|
integer(8) pure function f2(x, y)
|
|
class(t1), intent(in) :: x
|
|
class(t2), intent(in) :: y
|
|
end
|
|
integer(8) pure function f3(x)
|
|
class(t1), intent(in) :: x
|
|
end
|
|
subroutine test1(x, y, a)
|
|
class(t1) :: x
|
|
integer :: y
|
|
real :: a(x .binary. y)
|
|
end
|
|
! Resolve to operator in parent class
|
|
subroutine test2(x, y, a)
|
|
class(t2) :: x
|
|
integer :: y
|
|
real :: a(x .binary. y)
|
|
end
|
|
! 2nd arg is passed object
|
|
subroutine test3(x, y, a)
|
|
class(t1) :: x
|
|
class(t2) :: y
|
|
real :: a(x .binary. y)
|
|
end
|
|
subroutine test4(x, y, a)
|
|
class(t1) :: x
|
|
class(t2) :: y
|
|
real :: a(.unary. x + .unary. y)
|
|
end
|
|
end
|
|
!Expect: m3.mod
|
|
!module m3
|
|
! type::t1
|
|
! contains
|
|
! procedure,pass(x)::p1=>f1
|
|
! procedure::p3=>f3
|
|
! generic::operator(.binary.)=>p1
|
|
! generic::operator(.unary.)=>p3
|
|
! end type
|
|
! type,extends(t1)::t2
|
|
! contains
|
|
! procedure,pass(y)::p2=>f2
|
|
! generic::operator(.binary.)=>p2
|
|
! end type
|
|
!contains
|
|
! pure function f1(x,y)
|
|
! class(t1),intent(in)::x
|
|
! integer(4),intent(in)::y
|
|
! integer(8)::f1
|
|
! end
|
|
! pure function f2(x,y)
|
|
! class(t1),intent(in)::x
|
|
! class(t2),intent(in)::y
|
|
! integer(8)::f2
|
|
! end
|
|
! pure function f3(x)
|
|
! class(t1),intent(in)::x
|
|
! integer(8)::f3
|
|
! end
|
|
! subroutine test1(x,y,a)
|
|
! class(t1)::x
|
|
! integer(4)::y
|
|
! real(4)::a(1_8:x%p1(y))
|
|
! end
|
|
! subroutine test2(x,y,a)
|
|
! class(t2)::x
|
|
! integer(4)::y
|
|
! real(4)::a(1_8:x%p1(y))
|
|
! end
|
|
! subroutine test3(x,y,a)
|
|
! class(t1)::x
|
|
! class(t2)::y
|
|
! real(4)::a(1_8:y%p2(x))
|
|
! end
|
|
! subroutine test4(x,y,a)
|
|
! class(t1)::x
|
|
! class(t2)::y
|
|
! real(4)::a(1_8:x%p3()+y%p3())
|
|
! end
|
|
!end
|