645 lines · plain
1! RUN: %python %S/test_modfile.py %s %flang_fc1 -flogical-abbreviations -fxor-operator2 3! Resolution of user-defined operators in expressions.4! Test by using generic function in a specification expression that needs5! to be written to a .mod file.6 7! Numeric operators8module m19 type :: t10 sequence11 logical :: x12 end type13 interface operator(+)14 pure integer(8) function add_ll(x, y)15 logical, intent(in) :: x, y16 end17 pure integer(8) function add_li(x, y)18 logical, intent(in) :: x19 integer, intent(in) :: y20 end21 pure integer(8) function add_tt(x, y)22 import :: t23 type(t), intent(in) :: x, y24 end25 end interface26 interface operator(/)27 pure integer(8) function div_tz(x, y)28 import :: t29 type(t), intent(in) :: x30 complex, intent(in) :: y31 end32 pure integer(8) function div_ct(x, y)33 import :: t34 character(10), intent(in) :: x35 type(t), intent(in) :: y36 end37 end interface38contains39 subroutine s1(x, y, z)40 logical :: x, y41 real :: z(x + y) ! resolves to add_ll42 end43 subroutine s2(x, y, z)44 logical :: x45 integer :: y46 real :: z(x + y) ! resolves to add_li47 end48 subroutine s3(x, y, z)49 type(t) :: x50 complex :: y51 real :: z(x / y) ! resolves to div_tz52 end53 subroutine s4(x, y, z)54 character(10) :: x55 type(t) :: y56 real :: z(x / y) ! resolves to div_ct57 end58end59 60!Expect: m1.mod61!module m162! type :: t63! sequence64! logical(4) :: x65! end type66! interface67! pure function add_ll(x, y)68! logical(4), intent(in) :: x69! logical(4), intent(in) :: y70! integer(8) :: add_ll71! end72! end interface73! interface74! pure function add_li(x, y)75! logical(4), intent(in) :: x76! integer(4), intent(in) :: y77! integer(8) :: add_li78! end79! end interface80! interface81! pure function add_tt(x, y)82! import :: t83! type(t), intent(in) :: x84! type(t), intent(in) :: y85! integer(8) :: add_tt86! end87! end interface88! interface89! pure function div_tz(x, y)90! import :: t91! type(t), intent(in) :: x92! complex(4), intent(in) :: y93! integer(8) :: div_tz94! end95! end interface96! interface97! pure function div_ct(x, y)98! import :: t99! character(10_4, 1), intent(in) :: x100! type(t), intent(in) :: y101! integer(8) :: div_ct102! end103! end interface104! interface operator(+)105! procedure :: add_ll106! procedure :: add_li107! procedure :: add_tt108! end interface109! interface operator(/)110! procedure :: div_tz111! procedure :: div_ct112! end interface113!contains114! subroutine s1(x, y, z)115! logical(4) :: x116! logical(4) :: y117! real(4) :: z(1_8:add_ll(x, y))118! end119! subroutine s2(x, y, z)120! logical(4) :: x121! integer(4) :: y122! real(4) :: z(1_8:add_li(x, y))123! end124! subroutine s3(x, y, z)125! type(t) :: x126! complex(4) :: y127! real(4) :: z(1_8:div_tz(x, y))128! end129! subroutine s4(x, y, z)130! character(10_4, 1) :: x131! type(t) :: y132! real(4) :: z(1_8:div_ct(x, y))133! end134!end135 136! Logical operators137module m2138 type :: t139 sequence140 logical :: x141 end type142 interface operator(.And.)143 pure integer(8) function and_ti(x, y)144 import :: t145 type(t), intent(in) :: x146 integer, intent(in) :: y147 end148 pure integer(8) function and_li(x, y)149 logical, intent(in) :: x150 integer, intent(in) :: y151 end152 end interface153 ! Alternative spelling of .AND.154 interface operator(.a.)155 pure integer(8) function and_tt(x, y)156 import :: t157 type(t), intent(in) :: x, y158 end159 end interface160 interface operator(.x.)161 pure integer(8) function neqv_tt(x, y)162 import :: t163 type(t), intent(in) :: x, y164 end165 end interface166 interface operator(.neqv.)167 pure integer(8) function neqv_rr(x, y)168 real, intent(in) :: x, y169 end170 end interface171contains172 subroutine s1(x, y, z)173 type(t) :: x174 integer :: y175 real :: z(x .and. y) ! resolves to and_ti176 end177 subroutine s2(x, y, z)178 logical :: x179 integer :: y180 real :: z(x .a. y) ! resolves to and_li181 end182 subroutine s3(x, y, z)183 type(t) :: x, y184 real :: z(x .and. y) ! resolves to and_tt185 end186 subroutine s4(x, y, z)187 type(t) :: x, y188 real :: z(x .neqv. y) ! resolves to neqv_tt189 end190 subroutine s5(x, y, z)191 real :: x, y192 real :: z(x .xor. y) ! resolves to neqv_rr193 end194end195 196!Expect: m2.mod197!module m2198! type :: t199! sequence200! logical(4) :: x201! end type202! interface203! pure function and_ti(x, y)204! import :: t205! type(t), intent(in) :: x206! integer(4), intent(in) :: y207! integer(8) :: and_ti208! end209! end interface210! interface211! pure function and_li(x, y)212! logical(4), intent(in) :: x213! integer(4), intent(in) :: y214! integer(8) :: and_li215! end216! end interface217! interface218! pure function and_tt(x, y)219! import :: t220! type(t), intent(in) :: x221! type(t), intent(in) :: y222! integer(8) :: and_tt223! end224! end interface225! interface226! pure function neqv_tt(x, y)227! import :: t228! type(t), intent(in) :: x229! type(t), intent(in) :: y230! integer(8) :: neqv_tt231! end232! end interface233! interface234! pure function neqv_rr(x, y)235! real(4), intent(in) :: x236! real(4), intent(in) :: y237! integer(8) :: neqv_rr238! end239! end interface240! interface operator( .and.)241! procedure :: and_ti242! procedure :: and_li243! procedure :: and_tt244! end interface245! interface operator(.x.)246! procedure :: neqv_tt247! procedure :: neqv_rr248! end interface249!contains250! subroutine s1(x, y, z)251! type(t) :: x252! integer(4) :: y253! real(4) :: z(1_8:and_ti(x, y))254! end255! subroutine s2(x, y, z)256! logical(4) :: x257! integer(4) :: y258! real(4) :: z(1_8:and_li(x, y))259! end260! subroutine s3(x, y, z)261! type(t) :: x262! type(t) :: y263! real(4) :: z(1_8:and_tt(x, y))264! end265! subroutine s4(x, y, z)266! type(t) :: x267! type(t) :: y268! real(4) :: z(1_8:neqv_tt(x, y))269! end270! subroutine s5(x, y, z)271! real(4) :: x272! real(4) :: y273! real(4) :: z(1_8:neqv_rr(x, y))274! end275!end276 277! Relational operators278module m3279 type :: t280 sequence281 logical :: x282 end type283 interface operator(<>)284 pure integer(8) function ne_it(x, y)285 import :: t286 integer, intent(in) :: x287 type(t), intent(in) :: y288 end289 end interface290 interface operator(/=)291 pure integer(8) function ne_tt(x, y)292 import :: t293 type(t), intent(in) :: x, y294 end295 end interface296 interface operator(.ne.)297 pure integer(8) function ne_ci(x, y)298 character(len=*), intent(in) :: x299 integer, intent(in) :: y300 end301 end interface302contains303 subroutine s1(x, y, z)304 integer :: x305 type(t) :: y306 real :: z(x /= y) ! resolves to ne_it307 end308 subroutine s2(x, y, z)309 type(t) :: x310 type(t) :: y311 real :: z(x .ne. y) ! resolves to ne_tt312 end313 subroutine s3(x, y, z)314 character(len=*) :: x315 integer :: y316 real :: z(x <> y) ! resolves to ne_ci317 end318end319 320!Expect: m3.mod321!module m3322! type :: t323! sequence324! logical(4) :: x325! end type326! interface327! pure function ne_it(x, y)328! import :: t329! integer(4), intent(in) :: x330! type(t), intent(in) :: y331! integer(8) :: ne_it332! end333! end interface334! interface335! pure function ne_tt(x, y)336! import :: t337! type(t), intent(in) :: x338! type(t), intent(in) :: y339! integer(8) :: ne_tt340! end341! end interface342! interface343! pure function ne_ci(x, y)344! character(*, 1), intent(in) :: x345! integer(4), intent(in) :: y346! integer(8) :: ne_ci347! end348! end interface349! interface operator(<>)350! procedure :: ne_it351! procedure :: ne_tt352! procedure :: ne_ci353! end interface354!contains355! subroutine s1(x, y, z)356! integer(4) :: x357! type(t) :: y358! real(4) :: z(1_8:ne_it(x, y))359! end360! subroutine s2(x, y, z)361! type(t) :: x362! type(t) :: y363! real(4) :: z(1_8:ne_tt(x, y))364! end365! subroutine s3(x, y, z)366! character(*, 1) :: x367! integer(4) :: y368! real(4) :: z(1_8:ne_ci(x, y))369! end370!end371 372! Concatenation373module m4374 type :: t375 sequence376 logical :: x377 end type378 interface operator(//)379 pure integer(8) function concat_12(x, y)380 character(len=*,kind=1), intent(in) :: x381 character(len=*,kind=2), intent(in) :: y382 end383 pure integer(8) function concat_int_real(x, y)384 integer, intent(in) :: x385 real, intent(in) :: y386 end387 end interface388contains389 subroutine s1(x, y, z)390 character(len=*,kind=1) :: x391 character(len=*,kind=2) :: y392 real :: z(x // y) ! resolves to concat_12393 end394 subroutine s2(x, y, z)395 integer :: x396 real :: y397 real :: z(x // y) ! resolves to concat_int_real398 end399end400!Expect: m4.mod401!module m4402! type :: t403! sequence404! logical(4) :: x405! end type406! interface407! pure function concat_12(x, y)408! character(*, 1), intent(in) :: x409! character(*, 2), intent(in) :: y410! integer(8) :: concat_12411! end412! end interface413! interface414! pure function concat_int_real(x, y)415! integer(4), intent(in) :: x416! real(4), intent(in) :: y417! integer(8) :: concat_int_real418! end419! end interface420! interface operator(//)421! procedure :: concat_12422! procedure :: concat_int_real423! end interface424!contains425! subroutine s1(x, y, z)426! character(*, 1) :: x427! character(*, 2) :: y428! real(4) :: z(1_8:concat_12(x, y))429! end430! subroutine s2(x, y, z)431! integer(4) :: x432! real(4) :: y433! real(4) :: z(1_8:concat_int_real(x, y))434! end435!end436 437! Unary operators438module m5439 type :: t440 end type441 interface operator(+)442 pure integer(8) function plus_l(x)443 logical, intent(in) :: x444 end445 end interface446 interface operator(-)447 pure integer(8) function minus_t(x)448 import :: t449 type(t), intent(in) :: x450 end451 end interface452 interface operator(.not.)453 pure integer(8) function not_t(x)454 import :: t455 type(t), intent(in) :: x456 end457 pure integer(8) function not_real(x)458 real, intent(in) :: x459 end460 end interface461contains462 subroutine s1(x, y)463 logical :: x464 real :: y(+x) ! resolves_to plus_l465 end466 subroutine s2(x, y)467 type(t) :: x468 real :: y(-x) ! resolves_to minus_t469 end470 subroutine s3(x, y)471 type(t) :: x472 real :: y(.not. x) ! resolves to not_t473 end474 subroutine s4(x, y)475 real :: y(.not. x) ! resolves to not_real476 end477end478 479!Expect: m5.mod480!module m5481! type :: t482! end type483! interface484! pure function plus_l(x)485! logical(4), intent(in) :: x486! integer(8) :: plus_l487! end488! end interface489! interface490! pure function minus_t(x)491! import :: t492! type(t), intent(in) :: x493! integer(8) :: minus_t494! end495! end interface496! interface497! pure function not_t(x)498! import :: t499! type(t), intent(in) :: x500! integer(8) :: not_t501! end502! end interface503! interface504! pure function not_real(x)505! real(4), intent(in) :: x506! integer(8) :: not_real507! end508! end interface509! interface operator(+)510! procedure :: plus_l511! end interface512! interface operator(-)513! procedure :: minus_t514! end interface515! interface operator( .not.)516! procedure :: not_t517! procedure :: not_real518! end interface519!contains520! subroutine s1(x, y)521! logical(4) :: x522! real(4) :: y(1_8:plus_l(x))523! end524! subroutine s2(x, y)525! type(t) :: x526! real(4) :: y(1_8:minus_t(x))527! end528! subroutine s3(x, y)529! type(t) :: x530! real(4) :: y(1_8:not_t(x))531! end532! subroutine s4(x, y)533! real(4) :: x534! real(4) :: y(1_8:not_real(x))535! end536!end537 538! Resolved based on shape539module m6540 interface operator(+)541 pure integer(8) function add(x, y)542 real, intent(in) :: x(:, :)543 real, intent(in) :: y(:, :, :)544 end545 end interface546contains547 subroutine s1(n, x, y, z, a, b)548 integer(8) :: n549 real :: x550 real :: y(4, n)551 real :: z(2, 2, 2)552 real :: a(size(x+y)) ! intrinsic +553 real :: b(y+z) ! resolves to add554 end555end556 557!Expect: m6.mod558!module m6559! interface560! pure function add(x, y)561! real(4), intent(in) :: x(:, :)562! real(4), intent(in) :: y(:, :, :)563! integer(8) :: add564! end565! end interface566! interface operator(+)567! procedure :: add568! end interface569!contains570! subroutine s1(n, x, y, z, a, b)571! integer(8) :: n572! real(4) :: x573! real(4) :: y(1_8:4_8, 1_8:n)574! real(4) :: z(1_8:2_8, 1_8:2_8, 1_8:2_8)575! real(4) :: a(1_8:int(int(4_8*size(y,dim=2,kind=8),kind=4),kind=8))576! real(4) :: b(1_8:add(y, z))577! end578!end579 580! Parameterized derived type581module m7582 type :: t(k)583 integer, kind :: k584 real(k) :: a585 end type586 interface operator(+)587 pure integer(8) function f1(x, y)588 import :: t589 type(t(4)), intent(in) :: x, y590 end591 pure integer(8) function f2(x, y)592 import :: t593 type(t(8)), intent(in) :: x, y594 end595 end interface596contains597 subroutine s1(x, y, z)598 type(t(4)) :: x, y599 real :: z(x + y) ! resolves to f1600 end601 subroutine s2(x, y, z)602 type(t(8)) :: x, y603 real :: z(x + y) ! resolves to f2604 end605end606 607!Expect: m7.mod608!module m7609! type :: t(k)610! integer(4), kind :: k611! real(int(int(k,kind=4),kind=8))::a612! end type613! interface614! pure function f1(x, y)615! import :: t616! type(t(k=4_4)), intent(in) :: x617! type(t(k=4_4)), intent(in) :: y618! integer(8) :: f1619! end620! end interface621! interface622! pure function f2(x, y)623! import :: t624! type(t(k=8_4)), intent(in) :: x625! type(t(k=8_4)), intent(in) :: y626! integer(8) :: f2627! end628! end interface629! interface operator(+)630! procedure :: f1631! procedure :: f2632! end interface633!contains634! subroutine s1(x, y, z)635! type(t(k=4_4)) :: x636! type(t(k=4_4)) :: y637! real(4) :: z(1_8:f1(x, y))638! end639! subroutine s2(x, y, z)640! type(t(k=8_4)) :: x641! type(t(k=8_4)) :: y642! real(4) :: z(1_8:f2(x, y))643! end644!end645