forked from OSchip/llvm-project
645 lines
13 KiB
Fortran
645 lines
13 KiB
Fortran
! RUN: %S/test_modfile.sh %s %t %f18 -flogical-abbreviations -fxor-operator
|
|
|
|
! Resolution of user-defined operators in expressions.
|
|
! Test by using generic function in a specification expression that needs
|
|
! to be written to a .mod file.
|
|
|
|
! Numeric operators
|
|
module m1
|
|
type :: t
|
|
sequence
|
|
logical :: x
|
|
end type
|
|
interface operator(+)
|
|
pure integer(8) function add_ll(x, y)
|
|
logical, intent(in) :: x, y
|
|
end
|
|
pure integer(8) function add_li(x, y)
|
|
logical, intent(in) :: x
|
|
integer, intent(in) :: y
|
|
end
|
|
pure integer(8) function add_tt(x, y)
|
|
import :: t
|
|
type(t), intent(in) :: x, y
|
|
end
|
|
end interface
|
|
interface operator(/)
|
|
pure integer(8) function div_tz(x, y)
|
|
import :: t
|
|
type(t), intent(in) :: x
|
|
complex, intent(in) :: y
|
|
end
|
|
pure integer(8) function div_ct(x, y)
|
|
import :: t
|
|
character(10), intent(in) :: x
|
|
type(t), intent(in) :: y
|
|
end
|
|
end interface
|
|
contains
|
|
subroutine s1(x, y, z)
|
|
logical :: x, y
|
|
real :: z(x + y) ! resolves to add_ll
|
|
end
|
|
subroutine s2(x, y, z)
|
|
logical :: x
|
|
integer :: y
|
|
real :: z(x + y) ! resolves to add_li
|
|
end
|
|
subroutine s3(x, y, z)
|
|
type(t) :: x
|
|
complex :: y
|
|
real :: z(x / y) ! resolves to div_tz
|
|
end
|
|
subroutine s4(x, y, z)
|
|
character(10) :: x
|
|
type(t) :: y
|
|
real :: z(x / y) ! resolves to div_ct
|
|
end
|
|
end
|
|
|
|
!Expect: m1.mod
|
|
!module m1
|
|
! type :: t
|
|
! sequence
|
|
! logical(4) :: x
|
|
! end type
|
|
! interface operator(+)
|
|
! procedure :: add_ll
|
|
! procedure :: add_li
|
|
! procedure :: add_tt
|
|
! end interface
|
|
! interface
|
|
! pure function add_ll(x, y)
|
|
! logical(4), intent(in) :: x
|
|
! logical(4), intent(in) :: y
|
|
! integer(8) :: add_ll
|
|
! end
|
|
! end interface
|
|
! interface
|
|
! pure function add_li(x, y)
|
|
! logical(4), intent(in) :: x
|
|
! integer(4), intent(in) :: y
|
|
! integer(8) :: add_li
|
|
! end
|
|
! end interface
|
|
! interface
|
|
! pure function add_tt(x, y)
|
|
! import :: t
|
|
! type(t), intent(in) :: x
|
|
! type(t), intent(in) :: y
|
|
! integer(8) :: add_tt
|
|
! end
|
|
! end interface
|
|
! interface operator(/)
|
|
! procedure :: div_tz
|
|
! procedure :: div_ct
|
|
! end interface
|
|
! interface
|
|
! pure function div_tz(x, y)
|
|
! import :: t
|
|
! type(t), intent(in) :: x
|
|
! complex(4), intent(in) :: y
|
|
! integer(8) :: div_tz
|
|
! end
|
|
! end interface
|
|
! interface
|
|
! pure function div_ct(x, y)
|
|
! import :: t
|
|
! character(10_4, 1), intent(in) :: x
|
|
! type(t), intent(in) :: y
|
|
! integer(8) :: div_ct
|
|
! end
|
|
! end interface
|
|
!contains
|
|
! subroutine s1(x, y, z)
|
|
! logical(4) :: x
|
|
! logical(4) :: y
|
|
! real(4) :: z(1_8:add_ll(x, y))
|
|
! end
|
|
! subroutine s2(x, y, z)
|
|
! logical(4) :: x
|
|
! integer(4) :: y
|
|
! real(4) :: z(1_8:add_li(x, y))
|
|
! end
|
|
! subroutine s3(x, y, z)
|
|
! type(t) :: x
|
|
! complex(4) :: y
|
|
! real(4) :: z(1_8:div_tz(x, y))
|
|
! end
|
|
! subroutine s4(x, y, z)
|
|
! character(10_4, 1) :: x
|
|
! type(t) :: y
|
|
! real(4) :: z(1_8:div_ct(x, y))
|
|
! end
|
|
!end
|
|
|
|
! Logical operators
|
|
module m2
|
|
type :: t
|
|
sequence
|
|
logical :: x
|
|
end type
|
|
interface operator(.And.)
|
|
pure integer(8) function and_ti(x, y)
|
|
import :: t
|
|
type(t), intent(in) :: x
|
|
integer, intent(in) :: y
|
|
end
|
|
pure integer(8) function and_li(x, y)
|
|
logical, intent(in) :: x
|
|
integer, intent(in) :: y
|
|
end
|
|
end interface
|
|
! Alternative spelling of .AND.
|
|
interface operator(.a.)
|
|
pure integer(8) function and_tt(x, y)
|
|
import :: t
|
|
type(t), intent(in) :: x, y
|
|
end
|
|
end interface
|
|
interface operator(.x.)
|
|
pure integer(8) function neqv_tt(x, y)
|
|
import :: t
|
|
type(t), intent(in) :: x, y
|
|
end
|
|
end interface
|
|
interface operator(.neqv.)
|
|
pure integer(8) function neqv_rr(x, y)
|
|
real, intent(in) :: x, y
|
|
end
|
|
end interface
|
|
contains
|
|
subroutine s1(x, y, z)
|
|
type(t) :: x
|
|
integer :: y
|
|
real :: z(x .and. y) ! resolves to and_ti
|
|
end
|
|
subroutine s2(x, y, z)
|
|
logical :: x
|
|
integer :: y
|
|
real :: z(x .a. y) ! resolves to and_li
|
|
end
|
|
subroutine s3(x, y, z)
|
|
type(t) :: x, y
|
|
real :: z(x .and. y) ! resolves to and_tt
|
|
end
|
|
subroutine s4(x, y, z)
|
|
type(t) :: x, y
|
|
real :: z(x .neqv. y) ! resolves to neqv_tt
|
|
end
|
|
subroutine s5(x, y, z)
|
|
real :: x, y
|
|
real :: z(x .xor. y) ! resolves to neqv_rr
|
|
end
|
|
end
|
|
|
|
!Expect: m2.mod
|
|
!module m2
|
|
! type :: t
|
|
! sequence
|
|
! logical(4) :: x
|
|
! end type
|
|
! interface operator( .and.)
|
|
! procedure :: and_ti
|
|
! procedure :: and_li
|
|
! procedure :: and_tt
|
|
! end interface
|
|
! interface
|
|
! pure function and_ti(x, y)
|
|
! import :: t
|
|
! type(t), intent(in) :: x
|
|
! integer(4), intent(in) :: y
|
|
! integer(8) :: and_ti
|
|
! end
|
|
! end interface
|
|
! interface
|
|
! pure function and_li(x, y)
|
|
! logical(4), intent(in) :: x
|
|
! integer(4), intent(in) :: y
|
|
! integer(8) :: and_li
|
|
! end
|
|
! end interface
|
|
! interface
|
|
! pure function and_tt(x, y)
|
|
! import :: t
|
|
! type(t), intent(in) :: x
|
|
! type(t), intent(in) :: y
|
|
! integer(8) :: and_tt
|
|
! end
|
|
! end interface
|
|
! interface operator(.x.)
|
|
! procedure :: neqv_tt
|
|
! procedure :: neqv_rr
|
|
! end interface
|
|
! interface
|
|
! pure function neqv_tt(x, y)
|
|
! import :: t
|
|
! type(t), intent(in) :: x
|
|
! type(t), intent(in) :: y
|
|
! integer(8) :: neqv_tt
|
|
! end
|
|
! end interface
|
|
! interface
|
|
! pure function neqv_rr(x, y)
|
|
! real(4), intent(in) :: x
|
|
! real(4), intent(in) :: y
|
|
! integer(8) :: neqv_rr
|
|
! end
|
|
! end interface
|
|
!contains
|
|
! subroutine s1(x, y, z)
|
|
! type(t) :: x
|
|
! integer(4) :: y
|
|
! real(4) :: z(1_8:and_ti(x, y))
|
|
! end
|
|
! subroutine s2(x, y, z)
|
|
! logical(4) :: x
|
|
! integer(4) :: y
|
|
! real(4) :: z(1_8:and_li(x, y))
|
|
! end
|
|
! subroutine s3(x, y, z)
|
|
! type(t) :: x
|
|
! type(t) :: y
|
|
! real(4) :: z(1_8:and_tt(x, y))
|
|
! end
|
|
! subroutine s4(x, y, z)
|
|
! type(t) :: x
|
|
! type(t) :: y
|
|
! real(4) :: z(1_8:neqv_tt(x, y))
|
|
! end
|
|
! subroutine s5(x, y, z)
|
|
! real(4) :: x
|
|
! real(4) :: y
|
|
! real(4) :: z(1_8:neqv_rr(x, y))
|
|
! end
|
|
!end
|
|
|
|
! Relational operators
|
|
module m3
|
|
type :: t
|
|
sequence
|
|
logical :: x
|
|
end type
|
|
interface operator(<>)
|
|
pure integer(8) function ne_it(x, y)
|
|
import :: t
|
|
integer, intent(in) :: x
|
|
type(t), intent(in) :: y
|
|
end
|
|
end interface
|
|
interface operator(/=)
|
|
pure integer(8) function ne_tt(x, y)
|
|
import :: t
|
|
type(t), intent(in) :: x, y
|
|
end
|
|
end interface
|
|
interface operator(.ne.)
|
|
pure integer(8) function ne_ci(x, y)
|
|
character(len=*), intent(in) :: x
|
|
integer, intent(in) :: y
|
|
end
|
|
end interface
|
|
contains
|
|
subroutine s1(x, y, z)
|
|
integer :: x
|
|
type(t) :: y
|
|
real :: z(x /= y) ! resolves to ne_it
|
|
end
|
|
subroutine s2(x, y, z)
|
|
type(t) :: x
|
|
type(t) :: y
|
|
real :: z(x .ne. y) ! resolves to ne_tt
|
|
end
|
|
subroutine s3(x, y, z)
|
|
character(len=*) :: x
|
|
integer :: y
|
|
real :: z(x <> y) ! resolves to ne_ci
|
|
end
|
|
end
|
|
|
|
!Expect: m3.mod
|
|
!module m3
|
|
! type :: t
|
|
! sequence
|
|
! logical(4) :: x
|
|
! end type
|
|
! interface operator(<>)
|
|
! procedure :: ne_it
|
|
! procedure :: ne_tt
|
|
! procedure :: ne_ci
|
|
! end interface
|
|
! interface
|
|
! pure function ne_it(x, y)
|
|
! import :: t
|
|
! integer(4), intent(in) :: x
|
|
! type(t), intent(in) :: y
|
|
! integer(8) :: ne_it
|
|
! end
|
|
! end interface
|
|
! interface
|
|
! pure function ne_tt(x, y)
|
|
! import :: t
|
|
! type(t), intent(in) :: x
|
|
! type(t), intent(in) :: y
|
|
! integer(8) :: ne_tt
|
|
! end
|
|
! end interface
|
|
! interface
|
|
! pure function ne_ci(x, y)
|
|
! character(*, 1), intent(in) :: x
|
|
! integer(4), intent(in) :: y
|
|
! integer(8) :: ne_ci
|
|
! end
|
|
! end interface
|
|
!contains
|
|
! subroutine s1(x, y, z)
|
|
! integer(4) :: x
|
|
! type(t) :: y
|
|
! real(4) :: z(1_8:ne_it(x, y))
|
|
! end
|
|
! subroutine s2(x, y, z)
|
|
! type(t) :: x
|
|
! type(t) :: y
|
|
! real(4) :: z(1_8:ne_tt(x, y))
|
|
! end
|
|
! subroutine s3(x, y, z)
|
|
! character(*, 1) :: x
|
|
! integer(4) :: y
|
|
! real(4) :: z(1_8:ne_ci(x, y))
|
|
! end
|
|
!end
|
|
|
|
! Concatenation
|
|
module m4
|
|
type :: t
|
|
sequence
|
|
logical :: x
|
|
end type
|
|
interface operator(//)
|
|
pure integer(8) function concat_12(x, y)
|
|
character(len=*,kind=1), intent(in) :: x
|
|
character(len=*,kind=2), intent(in) :: y
|
|
end
|
|
pure integer(8) function concat_int_real(x, y)
|
|
integer, intent(in) :: x
|
|
real, intent(in) :: y
|
|
end
|
|
end interface
|
|
contains
|
|
subroutine s1(x, y, z)
|
|
character(len=*,kind=1) :: x
|
|
character(len=*,kind=2) :: y
|
|
real :: z(x // y) ! resolves to concat_12
|
|
end
|
|
subroutine s2(x, y, z)
|
|
integer :: x
|
|
real :: y
|
|
real :: z(x // y) ! resolves to concat_int_real
|
|
end
|
|
end
|
|
!Expect: m4.mod
|
|
!module m4
|
|
! type :: t
|
|
! sequence
|
|
! logical(4) :: x
|
|
! end type
|
|
! interface operator(//)
|
|
! procedure :: concat_12
|
|
! procedure :: concat_int_real
|
|
! end interface
|
|
! interface
|
|
! pure function concat_12(x, y)
|
|
! character(*, 1), intent(in) :: x
|
|
! character(*, 2), intent(in) :: y
|
|
! integer(8) :: concat_12
|
|
! end
|
|
! end interface
|
|
! interface
|
|
! pure function concat_int_real(x, y)
|
|
! integer(4), intent(in) :: x
|
|
! real(4), intent(in) :: y
|
|
! integer(8) :: concat_int_real
|
|
! end
|
|
! end interface
|
|
!contains
|
|
! subroutine s1(x, y, z)
|
|
! character(*, 1) :: x
|
|
! character(*, 2) :: y
|
|
! real(4) :: z(1_8:concat_12(x, y))
|
|
! end
|
|
! subroutine s2(x, y, z)
|
|
! integer(4) :: x
|
|
! real(4) :: y
|
|
! real(4) :: z(1_8:concat_int_real(x, y))
|
|
! end
|
|
!end
|
|
|
|
! Unary operators
|
|
module m5
|
|
type :: t
|
|
end type
|
|
interface operator(+)
|
|
pure integer(8) function plus_l(x)
|
|
logical, intent(in) :: x
|
|
end
|
|
end interface
|
|
interface operator(-)
|
|
pure integer(8) function minus_t(x)
|
|
import :: t
|
|
type(t), intent(in) :: x
|
|
end
|
|
end interface
|
|
interface operator(.not.)
|
|
pure integer(8) function not_t(x)
|
|
import :: t
|
|
type(t), intent(in) :: x
|
|
end
|
|
pure integer(8) function not_real(x)
|
|
real, intent(in) :: x
|
|
end
|
|
end interface
|
|
contains
|
|
subroutine s1(x, y)
|
|
logical :: x
|
|
real :: y(+x) ! resolves_to plus_l
|
|
end
|
|
subroutine s2(x, y)
|
|
type(t) :: x
|
|
real :: y(-x) ! resolves_to minus_t
|
|
end
|
|
subroutine s3(x, y)
|
|
type(t) :: x
|
|
real :: y(.not. x) ! resolves to not_t
|
|
end
|
|
subroutine s4(x, y)
|
|
real :: y(.not. x) ! resolves to not_real
|
|
end
|
|
end
|
|
|
|
!Expect: m5.mod
|
|
!module m5
|
|
! type :: t
|
|
! end type
|
|
! interface operator(+)
|
|
! procedure :: plus_l
|
|
! end interface
|
|
! interface
|
|
! pure function plus_l(x)
|
|
! logical(4), intent(in) :: x
|
|
! integer(8) :: plus_l
|
|
! end
|
|
! end interface
|
|
! interface operator(-)
|
|
! procedure :: minus_t
|
|
! end interface
|
|
! interface
|
|
! pure function minus_t(x)
|
|
! import :: t
|
|
! type(t), intent(in) :: x
|
|
! integer(8) :: minus_t
|
|
! end
|
|
! end interface
|
|
! interface operator( .not.)
|
|
! procedure :: not_t
|
|
! procedure :: not_real
|
|
! end interface
|
|
! interface
|
|
! pure function not_t(x)
|
|
! import :: t
|
|
! type(t), intent(in) :: x
|
|
! integer(8) :: not_t
|
|
! end
|
|
! end interface
|
|
! interface
|
|
! pure function not_real(x)
|
|
! real(4), intent(in) :: x
|
|
! integer(8) :: not_real
|
|
! end
|
|
! end interface
|
|
!contains
|
|
! subroutine s1(x, y)
|
|
! logical(4) :: x
|
|
! real(4) :: y(1_8:plus_l(x))
|
|
! end
|
|
! subroutine s2(x, y)
|
|
! type(t) :: x
|
|
! real(4) :: y(1_8:minus_t(x))
|
|
! end
|
|
! subroutine s3(x, y)
|
|
! type(t) :: x
|
|
! real(4) :: y(1_8:not_t(x))
|
|
! end
|
|
! subroutine s4(x, y)
|
|
! real(4) :: x
|
|
! real(4) :: y(1_8:not_real(x))
|
|
! end
|
|
!end
|
|
|
|
! Resolved based on shape
|
|
module m6
|
|
interface operator(+)
|
|
pure integer(8) function add(x, y)
|
|
real, intent(in) :: x(:, :)
|
|
real, intent(in) :: y(:, :, :)
|
|
end
|
|
end interface
|
|
contains
|
|
subroutine s1(n, x, y, z, a, b)
|
|
integer(8) :: n
|
|
real :: x
|
|
real :: y(4, n)
|
|
real :: z(2, 2, 2)
|
|
real :: a(size(x+y)) ! intrinsic +
|
|
real :: b(y+z) ! resolves to add
|
|
end
|
|
end
|
|
|
|
!Expect: m6.mod
|
|
!module m6
|
|
! interface operator(+)
|
|
! procedure :: add
|
|
! end interface
|
|
! interface
|
|
! pure function add(x, y)
|
|
! real(4), intent(in) :: x(:, :)
|
|
! real(4), intent(in) :: y(:, :, :)
|
|
! integer(8) :: add
|
|
! end
|
|
! end interface
|
|
!contains
|
|
! subroutine s1(n, x, y, z, a, b)
|
|
! integer(8) :: n
|
|
! real(4) :: x
|
|
! real(4) :: y(1_8:4_8, 1_8:n)
|
|
! real(4) :: z(1_8:2_8, 1_8:2_8, 1_8:2_8)
|
|
! real(4) :: a(1_8:int(int(4_8*(n-1_8+1_8),kind=4),kind=8))
|
|
! real(4) :: b(1_8:add(y, z))
|
|
! end
|
|
!end
|
|
|
|
! Parameterized derived type
|
|
module m7
|
|
type :: t(k)
|
|
integer, kind :: k
|
|
real(k) :: a
|
|
end type
|
|
interface operator(+)
|
|
pure integer(8) function f1(x, y)
|
|
import :: t
|
|
type(t(4)), intent(in) :: x, y
|
|
end
|
|
pure integer(8) function f2(x, y)
|
|
import :: t
|
|
type(t(8)), intent(in) :: x, y
|
|
end
|
|
end interface
|
|
contains
|
|
subroutine s1(x, y, z)
|
|
type(t(4)) :: x, y
|
|
real :: z(x + y) ! resolves to f1
|
|
end
|
|
subroutine s2(x, y, z)
|
|
type(t(8)) :: x, y
|
|
real :: z(x + y) ! resolves to f2
|
|
end
|
|
end
|
|
|
|
!Expect: m7.mod
|
|
!module m7
|
|
! type :: t(k)
|
|
! integer(4), kind :: k
|
|
! real(int(int(k,kind=4),kind=8))::a
|
|
! end type
|
|
! interface operator(+)
|
|
! procedure :: f1
|
|
! procedure :: f2
|
|
! end interface
|
|
! interface
|
|
! pure function f1(x, y)
|
|
! import :: t
|
|
! type(t(k=4_4)), intent(in) :: x
|
|
! type(t(k=4_4)), intent(in) :: y
|
|
! integer(8) :: f1
|
|
! end
|
|
! end interface
|
|
! interface
|
|
! pure function f2(x, y)
|
|
! import :: t
|
|
! type(t(k=8_4)), intent(in) :: x
|
|
! type(t(k=8_4)), intent(in) :: y
|
|
! integer(8) :: f2
|
|
! end
|
|
! end interface
|
|
!contains
|
|
! subroutine s1(x, y, z)
|
|
! type(t(k=4_4)) :: x
|
|
! type(t(k=4_4)) :: y
|
|
! real(4) :: z(1_8:f1(x, y))
|
|
! end
|
|
! subroutine s2(x, y, z)
|
|
! type(t(k=8_4)) :: x
|
|
! type(t(k=8_4)) :: y
|
|
! real(4) :: z(1_8:f2(x, y))
|
|
! end
|
|
!end
|