diff options
Diffstat (limited to 'erts/emulator/test/timer_bif_SUITE.erl')
| -rw-r--r-- | erts/emulator/test/timer_bif_SUITE.erl | 558 |
1 files changed, 558 insertions, 0 deletions
diff --git a/erts/emulator/test/timer_bif_SUITE.erl b/erts/emulator/test/timer_bif_SUITE.erl new file mode 100644 index 0000000000..9ac5afcc45 --- /dev/null +++ b/erts/emulator/test/timer_bif_SUITE.erl @@ -0,0 +1,558 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(timer_bif_SUITE). + +-export([all/1,init_per_testcase/2,fin_per_testcase/2,end_per_suite/1]). +-export([start_timer_1/1, send_after_1/1, send_after_2/1, send_after_3/1, + cancel_timer_1/1, + start_timer_big/1, send_after_big/1, + start_timer_e/1, send_after_e/1, cancel_timer_e/1, + read_timer_trivial/1, read_timer/1, + cleanup/1, evil_timers/1, registered_process/1]). + +-include("test_server.hrl"). + +init_per_testcase(_Case, Config) -> + ?line Dog=test_server:timetrap(test_server:seconds(30)), + case catch erts_debug:get_internal_state(available_internal_state) of + true -> ok; + _ -> erts_debug:set_internal_state(available_internal_state, true) + end, + [{watchdog, Dog}|Config]. + +fin_per_testcase(_Case, Config) -> + Dog = ?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + ok. + +end_per_suite(_Config) -> + catch erts_debug:set_internal_state(available_internal_state, false). + +all(suite) -> + [start_timer_1, send_after_1, send_after_2, cancel_timer_1, + start_timer_e, send_after_e, cancel_timer_e, + start_timer_big, send_after_big, read_timer_trivial, read_timer, + cleanup, evil_timers, registered_process]. + +start_timer_1(doc) -> ["Basic start_timer/3 functionality"]; +start_timer_1(Config) when is_list(Config) -> + ?line Ref1 = erlang:start_timer(1000, self(), plopp), + ?line ok = get(1100, {timeout, Ref1, plopp}), + + ?line false = erlang:read_timer(Ref1), + ?line false = erlang:cancel_timer(Ref1), + ?line false = erlang:read_timer(Ref1), + + ?line Ref2 = erlang:start_timer(1000, self(), plapp), + ?line Left2 = erlang:cancel_timer(Ref2), + UpperLimit = case os:type() of + vxworks -> + %% The ticks of vxworks have a far lesser granularity + %% than what is expected in this testcase, in + %% fact the Left2 variable can get a little more than 1000... + 1100; + _ -> + 1000 + end, + ?line RetVal = case os:type() of + vxworks -> + {comment, "VxWorks behaves slightly unexpected, should be fixed,"}; + _ -> + ok + end, + ?line true = (Left2 > 900) and (Left2 =< UpperLimit), + ?line empty = get_msg(), + ?line false = erlang:cancel_timer(Ref2), + + ?line Ref3 = erlang:start_timer(1000, self(), plopp), + ?line no_message = get(900, {timeout, Ref3, plopp}), + + RetVal. + +send_after_1(doc) -> ["Basic send_after/3 functionality"]; +send_after_1(Config) when is_list(Config) -> + ?line Ref3 = erlang:send_after(1000, self(), plipp), + ?line ok = get(1500, plipp), + ?line false = erlang:read_timer(Ref3), + ok. + +start_timer_big(doc) -> ["Big timeouts for start_timer/3"]; +start_timer_big(Config) when is_list(Config) -> + ?line Big = 1 bsl 31, + ?line R = erlang:start_timer(Big, self(), hej), + ?line timer:sleep(200), + ?line Left = erlang:cancel_timer(R), + ?line case Big - Left of + Diff when Diff >= 200, Diff < 10000 -> + ok; + _Diff -> + test_server:fail({big, Big, Left}) + end, + ok. + +send_after_big(doc) -> ["Big timeouts for send_after/3"]; +send_after_big(Config) when is_list(Config) -> + ?line Big = 1 bsl 31, + ?line R = erlang:send_after(Big, self(), hej), + ?line timer:sleep(200), + ?line Left = erlang:cancel_timer(R), + ?line case Big - Left of + Diff when Diff >= 200, Diff < 10000 -> + ok; + _Diff -> + test_server:fail({big, Big, Left}) + end, + ok. + +send_after_2(doc) -> ["send_after/3: messages in the right order, kind version"]; +send_after_2(Config) when is_list(Config) -> + ?line _ = erlang:send_after(5000, self(), last), + ?line _ = erlang:send_after(0, self(), a0), + ?line _ = erlang:send_after(200, self(), a2), + ?line _ = erlang:send_after(100, self(), a1), + ?line _ = erlang:send_after(500, self(), a5), + ?line _ = erlang:send_after(300, self(), a3), + ?line _ = erlang:send_after(400, self(), a4), + ?line [a0,a1,a2,a3,a4,a5,last] = collect(last), + ok. + +send_after_3(doc) -> ["send_after/3: messages in the right order, worse than send_after_2"]; +send_after_3(Config) when is_list(Config) -> + case os:type() of + vxworks -> + {skipped, "VxWorks timer granularity and order is not working good, this is subject to change!"}; + _ -> + do_send_after_3() + end. + +do_send_after_3() -> + ?line _ = erlang:send_after(100, self(), b1), + ?line _ = erlang:send_after(101, self(), b2), + ?line _ = erlang:send_after(102, self(), b3), + ?line _ = erlang:send_after(103, self(), last), + ?line [b1, b2, b3, last] = collect(last), + +% This behaviour is not guaranteed: +% ?line _ = erlang:send_after(100, self(), c1), +% ?line _ = erlang:send_after(100, self(), c2), +% ?line _ = erlang:send_after(100, self(), c3), +% ?line _ = erlang:send_after(100, self(), last), +% ?line [c1, c2, c3, last] = collect(last), + + ok. + +cancel_timer_1(doc) -> ["Check trivial cancel_timer/1 behaviour"]; +cancel_timer_1(Config) when is_list(Config) -> + ?line false = erlang:cancel_timer(make_ref()), + + ok. + +start_timer_e(doc) -> ["Error cases for start_timer/3"]; +start_timer_e(Config) when is_list(Config) -> + ?line {'EXIT', _} = (catch erlang:start_timer(-4, self(), hej)), + ?line {'EXIT', _} = (catch erlang:start_timer(4728472847827482, + self(), hej)), + + ?line {'EXIT', _} = (catch erlang:start_timer(4.5, self(), hej)), + ?line {'EXIT', _} = (catch erlang:start_timer(a, self(), hej)), + + ?line Node = start_slave(), + ?line Pid = spawn(Node, timer, sleep, [10000]), + ?line {'EXIT', _} = (catch erlang:start_timer(1000, Pid, hej)), + ?line stop_slave(Node), + + + ok. + +send_after_e(doc) -> ["Error cases for send_after/3"]; +send_after_e(suite) -> []; +send_after_e(Config) when is_list(Config) -> + ?line {'EXIT', _} = (catch erlang:send_after(-4, self(), hej)), + ?line {'EXIT', _} = (catch erlang:send_after(4728472847827482, + self(), hej)), + + ?line {'EXIT', _} = (catch erlang:send_after(4.5, self(), hej)), + ?line {'EXIT', _} = (catch erlang:send_after(a, self(), hej)), + + ?line Node = start_slave(), + ?line Pid = spawn(Node, timer, sleep, [10000]), + ?line {'EXIT', _} = (catch erlang:send_after(1000, Pid, hej)), + ?line stop_slave(Node), + ok. + +cancel_timer_e(doc) -> ["Error cases for cancel_timer/1"]; +cancel_timer_e(suite) -> []; +cancel_timer_e(Config) when is_list(Config) -> + ?line {'EXIT', _} = (catch erlang:cancel_timer(1)), + ?line {'EXIT', _} = (catch erlang:cancel_timer(self())), + ?line {'EXIT', _} = (catch erlang:cancel_timer(a)), + ok. + +read_timer_trivial(doc) -> ["Trivial and error test cases for read_timer/1."]; +read_timer_trivial(suite) -> []; +read_timer_trivial(Config) when is_list(Config) -> + ?line false = erlang:read_timer(make_ref()), + ?line {'EXIT', _} = (catch erlang:read_timer(42)), + ?line {'EXIT', _} = (catch erlang:read_timer(423497834744444444457667444444)), + ?line {'EXIT', _} = (catch erlang:read_timer(self())), + ?line {'EXIT', _} = (catch erlang:read_timer(ab)), + ok. + +read_timer(doc) -> ["Test that read_timer/1 seems to return the correct values."]; +read_timer(suite) -> []; +read_timer(Config) when is_list(Config) -> + ?line Big = 1 bsl 31, + ?line R = erlang:send_after(Big, self(), hej_hopp), + + ?line receive after 200 -> ok end, % Delay and clear reductions. + ?line Left = erlang:read_timer(R), + ?line Left = erlang:cancel_timer(R), + ?line false = erlang:read_timer(R), + + ?line case Big - Left of + Diff when Diff >= 200, Diff < 10000 -> + ok; + _Diff -> + test_server:fail({big, Big, Left}) + end, + ok. + +cleanup(doc) -> []; +cleanup(suite) -> []; +cleanup(Config) when is_list(Config) -> + ?line Mem = mem(), + %% Timer on dead process + ?line P1 = spawn(fun () -> ok end), + ?line wait_until(fun () -> process_is_cleaned_up(P1) end), + ?line T1 = erlang:start_timer(10000, P1, "hej"), + ?line T2 = erlang:send_after(10000, P1, "hej"), + ?line Mem = mem(), + ?line false = erlang:read_timer(T1), + ?line false = erlang:read_timer(T2), + ?line Mem = mem(), + %% Process dies before timeout + ?line P2 = spawn(fun () -> receive after 500 -> ok end end), + ?line T3 = erlang:start_timer(10000, P2, "hej"), + ?line T4 = erlang:send_after(10000, P2, "hej"), + ?line true = Mem < mem(), + ?line true = is_integer(erlang:read_timer(T3)), + ?line true = is_integer(erlang:read_timer(T4)), + ?line wait_until(fun () -> process_is_cleaned_up(P2) end), + ?line false = erlang:read_timer(T3), + ?line false = erlang:read_timer(T4), + ?line Mem = mem(), + %% Cancel timer + ?line P3 = spawn(fun () -> receive after 20000 -> ok end end), + ?line T5 = erlang:start_timer(10000, P3, "hej"), + ?line T6 = erlang:send_after(10000, P3, "hej"), + ?line true = Mem < mem(), + ?line true = is_integer(erlang:cancel_timer(T5)), + ?line true = is_integer(erlang:cancel_timer(T6)), + ?line false = erlang:read_timer(T5), + ?line false = erlang:read_timer(T6), + ?line exit(P3, kill), + ?line Mem = mem(), + %% Timeout + ?line Ref = make_ref(), + ?line T7 = erlang:start_timer(500, self(), Ref), + ?line T8 = erlang:send_after(500, self(), Ref), + ?line true = Mem < mem(), + ?line true = is_integer(erlang:read_timer(T7)), + ?line true = is_integer(erlang:read_timer(T8)), + ?line receive {timeout, T7, Ref} -> ok end, + ?line receive Ref -> ok end, + ?line Mem = mem(), + ?line ok. + + +evil_timers(doc) -> []; +evil_timers(suite) -> []; +evil_timers(Config) when is_list(Config) -> + %% Create a composite term consisting of at least: + %% * externals (remote pids, ports, and refs) + %% * large (off heap) binaries + %% * small (heap) binaries + %% * funs + %% * bignums + %% * tuples + %% * lists + %% since data of these types have to be adjusted if moved + %% in memory + ?line Self = self(), + ?line R1 = make_ref(), + ?line Node = start_slave(), + ?line spawn_link(Node, + fun () -> + Self ! {R1, + [lists:sublist(erlang:ports(), 3), + [make_ref(), make_ref(), make_ref()], + lists:sublist(processes(), 3), + [fun () -> gurka end, + fun (A) -> A + 1 end, + fun (A, B) -> A + B end]]} + end), + ?line ExtList = receive {R1, L} -> L end, + ?line stop_slave(Node), + ?line BinList = [<<"bla">>, + <<"blipp">>, + <<"blupp">>, + list_to_binary(lists:duplicate(1000000,$a)), + list_to_binary(lists:duplicate(1000000,$b)), + list_to_binary(lists:duplicate(1000000,$c))], + ?line FunList = [fun () -> gurka end, + fun (A) -> A + 1 end, + fun (A, B) -> A + B end], + ?line PidList = lists:sublist(processes(), 3), + ?line PortList = lists:sublist(erlang:ports(), 3), + ?line RefList = [make_ref(), make_ref(), make_ref()], + ?line BigList = [111111111111, 22222222222222, 333333333333333333], + ?line Msg = {BinList,[FunList,{RefList,ExtList,PidList,PortList,BigList}]}, + %% ?line ?t:format("Msg=~p~n",[Msg]), + + ?line Prio = process_flag(priority, max), + %% + %% In the smp case there are four major cases we want to test: + %% + %% 1. A timer started with erlang:start_timer(Time, Receiver, Msg), + %% where Msg is a composite term, expires, and the receivers main + %% lock *can not* be acquired immediately (typically when the + %% receiver *is* running). + %% + %% The wrap tuple ({timeout, TRef, Msg}) will in this case + %% be allocated in the previously allocated message buffer along + %% with Msg, i.e. the previously allocated message buffer will be + %% reallocated and potentially moved. + ?line TimeOutMsgs0 = evil_setup_timers(200, Self, Msg), + ?line RecvTimeOutMsgs0 = evil_recv_timeouts(200), + %% 2. A timer started with erlang:start_timer(Time, Receiver, Msg), + %% where Msg is an immediate term, expires, and the receivers main + %% lock *can not* be acquired immediately (typically when the + %% receiver *is* running). + %% + %% The wrap tuple will in this case be allocated in a new + %% message buffer. + ?line TimeOutMsgs1 = evil_setup_timers(200, Self, immediate), + ?line RecvTimeOutMsgs1 = evil_recv_timeouts(200), + %% 3. A timer started with erlang:start_timer(Time, Receiver, Msg), + %% where Msg is a composite term, expires, and the receivers main + %% lock *can* be acquired immediately (typically when the receiver + %% *is not* running). + %% + %% The wrap tuple will in this case be allocated on the receivers + %% heap, and Msg is passed in the previously allocated message + %% buffer. + ?line R2 = make_ref(), + ?line spawn_link(fun () -> + Self ! {R2, evil_setup_timers(200, Self, Msg)} + end), + ?line receive after 1000 -> ok end, + ?line TimeOutMsgs2 = receive {R2, TOM2} -> TOM2 end, + ?line RecvTimeOutMsgs2 = evil_recv_timeouts(200), + %% 4. A timer started with erlang:start_timer(Time, Receiver, Msg), + %% where Msg is an immediate term, expires, and the Receivers main + %% lock *can* be acquired immediately (typically when the receiver + %% *is not* running). + %% + %% The wrap tuple will in this case be allocated on the receivers + %% heap. + ?line R3 = make_ref(), + ?line spawn_link(fun () -> + Self ! {R3, evil_setup_timers(200,Self,immediate)} + end), + ?line receive after 1000 -> ok end, + ?line TimeOutMsgs3 = receive {R3, TOM3} -> TOM3 end, + ?line RecvTimeOutMsgs3 = evil_recv_timeouts(200), + + %% Garge collection will hopefully crash the emulator if something + %% is wrong... + ?line garbage_collect(), + ?line garbage_collect(), + ?line garbage_collect(), + + %% Make sure we got the timeouts we expected + %% + %% Note timeouts are *not* guaranteed to be delivered in order + ?line ok = match(lists:sort(RecvTimeOutMsgs0), lists:sort(TimeOutMsgs0)), + ?line ok = match(lists:sort(RecvTimeOutMsgs1), lists:sort(TimeOutMsgs1)), + ?line ok = match(lists:sort(RecvTimeOutMsgs2), lists:sort(TimeOutMsgs2)), + ?line ok = match(lists:sort(RecvTimeOutMsgs3), lists:sort(TimeOutMsgs3)), + + ?line process_flag(priority, Prio), + ?line ok. + +evil_setup_timers(N, Receiver, Msg) -> + ?line evil_setup_timers(0, N, Receiver, Msg, []). + +evil_setup_timers(N, N, _Receiver, _Msg, TOs) -> + ?line TOs; +evil_setup_timers(N, Max, Receiver, Msg, TOs) -> + ?line TRef = erlang:start_timer(N, Receiver, Msg), + ?line evil_setup_timers(N+1, Max, Receiver, Msg, [{timeout,TRef,Msg}|TOs]). + + +evil_recv_timeouts(M) -> + ?line evil_recv_timeouts([], 0, M). + +evil_recv_timeouts(TOs, N, N) -> + ?line TOs; +evil_recv_timeouts(TOs, N, M) -> + ?line receive + {timeout, _, _} = TO -> + ?line evil_recv_timeouts([TO|TOs], N+1, M) + after 0 -> + ?line evil_recv_timeouts(TOs, N, M) + end. + +registered_process(doc) -> []; +registered_process(suite) -> []; +registered_process(Config) when is_list(Config) -> + ?line Mem = mem(), + %% Cancel + ?line T1 = erlang:start_timer(500, ?MODULE, "hej"), + ?line T2 = erlang:send_after(500, ?MODULE, "hej"), + ?line undefined = whereis(?MODULE), + ?line true = Mem < mem(), + ?line true = is_integer(erlang:cancel_timer(T1)), + ?line true = is_integer(erlang:cancel_timer(T2)), + ?line false = erlang:read_timer(T1), + ?line false = erlang:read_timer(T2), + ?line Mem = mem(), + %% Timeout register after start + ?line Ref1 = make_ref(), + ?line T3 = erlang:start_timer(500, ?MODULE, Ref1), + ?line T4 = erlang:send_after(500, ?MODULE, Ref1), + ?line undefined = whereis(?MODULE), + ?line true = Mem < mem(), + ?line true = is_integer(erlang:read_timer(T3)), + ?line true = is_integer(erlang:read_timer(T4)), + ?line true = register(?MODULE, self()), + ?line receive {timeout, T3, Ref1} -> ok end, + ?line receive Ref1 -> ok end, + ?line Mem = mem(), + %% Timeout register before start + ?line Ref2 = make_ref(), + ?line T5 = erlang:start_timer(500, ?MODULE, Ref2), + ?line T6 = erlang:send_after(500, ?MODULE, Ref2), + ?line true = Mem < mem(), + ?line true = is_integer(erlang:read_timer(T5)), + ?line true = is_integer(erlang:read_timer(T6)), + ?line receive {timeout, T5, Ref2} -> ok end, + ?line receive Ref2 -> ok end, + ?line Mem = mem(), + ?line true = unregister(?MODULE), + ?line ok. + +mem() -> + AA = erlang:system_info(allocated_areas), + {value,{bif_timer,Mem}} = lists:keysearch(bif_timer, 1, AA), + Mem. + +process_is_cleaned_up(P) when is_pid(P) -> + undefined == erts_debug:get_internal_state({process_status, P}). + +wait_until(Pred) when is_function(Pred) -> + case catch Pred() of + true -> ok; + _ -> receive after 50 -> ok end, wait_until(Pred) + end. + +get(Time, Msg) -> + receive + Msg -> + ok + after Time + -> + no_message + end. + +get_msg() -> + receive + Msg -> + {ok, Msg} + after 0 -> + empty + end. + +start_slave() -> + ?line {A, B, C} = now(), + ?line Pa = filename:dirname(code:which(?MODULE)), + ?line Name = atom_to_list(?MODULE) ++ "-" ++ integer_to_list(A+B+C), + {ok, Node} = ?t:start_node(Name, slave, [{args, "-pa " ++ Pa}]), + Node. + +stop_slave(Node) -> + test_server:stop_node(Node). + +collect(Last) -> + collect(Last, []). + +receive_one() -> + receive + Msg -> + Msg + end. + +collect(Last, Msgs0) -> + Msg = receive_one(), + Msgs = Msgs0 ++ [Msg], + case Msg of + Last -> + Msgs; + _ -> + collect(Last, Msgs) + end. + +match(X, X) -> + %erlang:display({match, X}), + ok; +match(X, Y) -> + %erlang:display({mismatch, X, Y}), + match_aux(X, Y). + +match_aux(X, X) -> + unexpected_error; +match_aux(X, Y) when is_list(X), is_list(Y), length(X) =/= length(Y) -> + %% erlang:display({mismatch, X, Y}), + {list_length_mismatch, length(X), length(Y)}; +match_aux([X|Xs], [X|Ys]) -> + match_aux(Xs, Ys); +match_aux([X|_], [Y|_]) -> + match_aux(X, Y); +match_aux(X, Y) when is_tuple(X), is_tuple(Y), size(X) =/= size(Y) -> + %% erlang:display({mismatch, X, Y}), + {tuple_size_mismatch, size(X), size(Y)}; +match_aux(X, Y) when is_tuple(X), is_tuple(Y) -> + match_aux(tuple_to_list(X), tuple_to_list(Y)); +match_aux(X, Y) -> + %% erlang:display({mismatch, X, Y}), + {mismatch, type(X), type(Y)}. + +type(X) when is_list(X) -> list; +type(X) when is_tuple(X) -> tuple; +type(X) when is_float(X) -> float; +type(X) when is_integer(X) -> integer; +type(X) when is_pid(X) -> {pid, node(X)}; +type(X) when is_reference(X) -> {reference, node(X)}; +type(X) when is_port(X) -> {port, node(X)}; +type(X) when is_binary(X) -> binary; +type(X) when is_atom(X) -> atom; +type(_) -> unknown. + + |