| ! RUN: %python %S/test_modfile.py %s %flang_fc1 -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*size(y,dim=2),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 |