diff options
Diffstat (limited to 'erts/emulator/test/process_SUITE.erl')
| -rw-r--r-- | erts/emulator/test/process_SUITE.erl | 2067 |
1 files changed, 2067 insertions, 0 deletions
diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl new file mode 100644 index 0000000000..fdedf30e78 --- /dev/null +++ b/erts/emulator/test/process_SUITE.erl @@ -0,0 +1,2067 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-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(process_SUITE). + +%% Tests processes, trapping exit messages and the BIFs: +%% exit/1 +%% exit/2 +%% process_info/1,2 +%% register/2 (partially) + +-include("test_server.hrl"). + +-define(heap_binary_size, 64). + +-export([all/1, spawn_with_binaries/1, + t_exit_1/1, t_exit_2/1, t_exit_2_other/1, t_exit_2_other_normal/1, + self_exit/1, normal_suicide_exit/1, abnormal_suicide_exit/1, + t_exit_2_catch/1, trap_exit_badarg/1, trap_exit_badarg_in_bif/1, + exit_and_timeout/1, exit_twice/1, + t_process_info/1, process_info_other_msg/1, + process_info_other_dist_msg/1, + process_info_2_list/1, process_info_lock_reschedule/1, + process_info_lock_reschedule2/1, + bump_reductions/1, low_prio/1, binary_owner/1, yield/1, yield2/1, + process_status_exiting/1, + otp_4725/1, bad_register/1, garbage_collect/1, otp_6237/1, + process_info_messages/1, process_flag_badarg/1, + processes_large_tab/1, processes_default_tab/1, processes_small_tab/1, + processes_this_tab/1, processes_apply_trap/1, + processes_last_call_trap/1, processes_gc_trap/1, + processes_term_proc_list/1, processes_bif/1, + otp_7738/1, otp_7738_waiting/1, otp_7738_suspended/1, + otp_7738_resume/1]). +-export([prio_server/2, prio_client/2]). + +-export([init_per_testcase/2, fin_per_testcase/2, end_per_suite/1]). + +-export([hangaround/2, processes_bif_test/0, do_processes/1, + processes_term_proc_list_test/1]). + +all(suite) -> + [spawn_with_binaries, t_exit_1, t_exit_2, + trap_exit_badarg, trap_exit_badarg_in_bif, + t_process_info, process_info_other_msg, process_info_other_dist_msg, + process_info_2_list, + process_info_lock_reschedule, process_info_lock_reschedule2, + process_status_exiting, + bump_reductions, low_prio, yield, yield2, otp_4725, bad_register, + garbage_collect, process_info_messages, process_flag_badarg, otp_6237, + processes_bif, + otp_7738]. + +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + Dog=?t:timetrap(?t:minutes(10)), + [{watchdog, Dog},{testcase, Func}|Config]. + +fin_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + Dog=?config(watchdog, Config), + ?t:timetrap_cancel(Dog). + +end_per_suite(Config) -> + catch erts_debug:set_internal_state(available_internal_state, false), + Config. + +fun_spawn(Fun) -> + spawn_link(erlang, apply, [Fun, []]). + +%% Tests that binaries as arguments to spawn/3 doesn't leak +%% (unclear if this test case will actually prove anything on +%% a modern computer with lots of memory). +spawn_with_binaries(Config) when is_list(Config) -> + ?line L = lists:duplicate(2048, 42), + ?line TwoMeg = lists:duplicate(1024, L), + ?line Fun = fun() -> spawn(?MODULE, binary_owner, [list_to_binary(TwoMeg)]), + receive after 1 -> ok end end, + ?line Iter = case test_server:purify_is_running() of + true -> 10; + false -> 150 + end, + ?line test_server:do_times(Iter, Fun), + ok. + +binary_owner(Bin) when is_binary(Bin) -> + ok. + +%% Tests exit/1 with a big message. +t_exit_1(Config) when is_list(Config) -> + ?line start_spawner(), + ?line Dog = test_server:timetrap(test_server:seconds(20)), + ?line process_flag(trap_exit, true), + ?line test_server:do_times(10, fun t_exit_1/0), + ?line test_server:timetrap_cancel(Dog), + ?line stop_spawner(), + ok. + +t_exit_1() -> + ?line Pid = fun_spawn(fun() -> exit(kb_128()) end), + ?line Garbage = kb_128(), + ?line receive + {'EXIT', Pid, Garbage} -> ok + end. + +t_exit_2(suite) -> [t_exit_2_other, t_exit_2_other_normal, + self_exit, normal_suicide_exit, + abnormal_suicide_exit, t_exit_2_catch, + exit_and_timeout, exit_twice]. + +%% Tests exit/2 with a lot of data in the exit message. +t_exit_2_other(Config) when is_list(Config) -> + ?line start_spawner(), + ?line Dog = test_server:timetrap(test_server:seconds(20)), + ?line process_flag(trap_exit, true), + ?line test_server:do_times(10, fun t_exit_2_other/0), + ?line test_server:timetrap_cancel(Dog), + ?line stop_spawner(), + ok. + +t_exit_2_other() -> + ?line Pid = fun_spawn(fun() -> receive x -> ok end end), + ?line Garbage = kb_128(), + ?line exit(Pid, Garbage), + ?line receive + {'EXIT', Pid, Garbage} -> ok + end. + +%% Tests that exit(Pid, normal) does not kill another process.; +t_exit_2_other_normal(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(20)), + ?line process_flag(trap_exit, true), + ?line Pid = fun_spawn(fun() -> receive x -> ok end end), + ?line exit(Pid, normal), + ?line receive + {'EXIT', Pid, Reason} -> + ?line test_server:fail({process_died, Reason}) + after 1000 -> + ok + end, + ?line case process_info(Pid) of + undefined -> + test_server:fail(process_died_on_normal); + List when is_list(List) -> + ok + end, + exit(Pid, kill), + ?line test_server:timetrap_cancel(Dog), + ok. + +%% Tests that we can trap an exit message sent with exit/2 from +%% the same process. +self_exit(Config) when is_list(Config) -> + ?line start_spawner(), + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line process_flag(trap_exit, true), + ?line test_server:do_times(200, fun self_exit/0), + ?line test_server:timetrap_cancel(Dog), + ?line stop_spawner(), + ok. + +self_exit() -> + ?line Garbage = eight_kb(), + ?line P = self(), + ?line true = exit(P, Garbage), + ?line receive + {'EXIT', P, Garbage} -> ok + end. + +%% Tests exit(self(), normal) is equivalent to exit(normal) for a process +%% that doesn't trap exits. +normal_suicide_exit(Config) when is_list(Config) -> + ?line process_flag(trap_exit, true), + ?line Pid = fun_spawn(fun() -> exit(self(), normal) end), + ?line receive + {'EXIT', Pid, normal} -> ok; + Other -> test_server:fail({bad_message, Other}) + end. + +%% Tests exit(self(), Term) is equivalent to exit(Term) for a process +%% that doesn't trap exits."; +abnormal_suicide_exit(Config) when is_list(Config) -> + ?line Garbage = eight_kb(), + ?line process_flag(trap_exit, true), + ?line Pid = fun_spawn(fun() -> exit(self(), Garbage) end), + ?line receive + {'EXIT', Pid, Garbage} -> ok; + Other -> test_server:fail({bad_message, Other}) + end. + +%% Tests that exit(self(), die) cannot be catched. +t_exit_2_catch(Config) when is_list(Config) -> + ?line process_flag(trap_exit, true), + ?line Pid = fun_spawn(fun() -> catch exit(self(), die) end), + ?line receive + {'EXIT', Pid, normal} -> + test_server:fail(catch_worked); + {'EXIT', Pid, die} -> + ok; + Other -> + test_server:fail({bad_message, Other}) + end. + +%% Tests trapping of an 'EXIT' message generated by a bad argument to +%% the abs/1 bif. The 'EXIT' message will intentionally be very big. +trap_exit_badarg(Config) when is_list(Config) -> + ?line start_spawner(), + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line process_flag(trap_exit, true), + ?line test_server:do_times(10, fun trap_exit_badarg/0), + ?line test_server:timetrap_cancel(Dog), + ?line stop_spawner(), + ok. + +trap_exit_badarg() -> + ?line Pid = fun_spawn(fun() -> bad_guy(kb_128()) end), + ?line Garbage = kb_128(), + ?line receive + {'EXIT', Pid, {badarg,[{erlang,abs,[Garbage]},{?MODULE,bad_guy,1}|_]}} -> + ok; + Other -> + ?line ok = io:format("Bad EXIT message: ~P", [Other, 30]), + ?line test_server:fail(bad_exit_message) + end. + +bad_guy(Arg) -> + ?line abs(Arg). + + +kb_128() -> + Eight = eight_kb(), + {big_binary(), + Eight, Eight, Eight, Eight, Eight, Eight, Eight, Eight, + big_binary(), + Eight, Eight, Eight, Eight, Eight, Eight, Eight, Eight, + big_binary()}. + +eight_kb() -> + %%% This is really much more than eight kb, so vxworks platforms + %%% gets away with 1/8 of the other platforms (due to limited + %%% memory resources). + B64 = case os:type() of + vxworks -> + ?line lists:seq(1, 8); + _ -> + ?line lists:seq(1, 64) + end, + ?line B512 = {<<1>>,B64,<<2,3>>,B64,make_unaligned_sub_binary(<<4,5,6,7,8,9>>), + B64,make_sub_binary([1,2,3,4,5,6]), + B64,make_sub_binary(lists:seq(1, ?heap_binary_size+1)), + B64,B64,B64,B64,big_binary()}, + ?line lists:duplicate(8, {B512,B512}). + +big_binary() -> + big_binary(10, [42]). +big_binary(0, Acc) -> + list_to_binary(Acc); +big_binary(N, Acc) -> + big_binary(N-1, [Acc|Acc]). + +%% Test receiving an EXIT message when spawning a BIF with bad arguments. +trap_exit_badarg_in_bif(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line process_flag(trap_exit, true), + ?line test_server:do_times(10, fun trap_exit_badarg_bif/0), + ?line test_server:timetrap_cancel(Dog), + ok. + +trap_exit_badarg_bif() -> + ?line Pid = spawn_link(erlang, node, [1]), + ?line receive + {'EXIT', Pid, {badarg, _}} -> + ok; + Other -> + ?line test_server:fail({unexpected, Other}) + end. + +%% The following sequences of events have crasched Beam. +%% +%% 1) An exit is sent to a process which is currently not running. +%% The exit reason will (on purpose) overwrite the message queue +%% pointer. +%% 2) Before the process is scheduled in, it receives a timeout (from +%% a 'receive after'). +%% 3) The process will crash the next time it executes 'receive'. + +exit_and_timeout(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(20)), + + ?line process_flag(trap_exit, true), + ?line Parent = self(), + ?line Low = fun_spawn(fun() -> eat_low(Parent) end), + ?line High = fun_spawn(fun() -> eat_high(Low) end), + ?line eat_wait_for(Low, High), + + ?line test_server:timetrap_cancel(Dog), + ok. + + +eat_wait_for(Low, High) -> + ?line receive + {'EXIT', Low, {you, are, dead}} -> + ok; + {'EXIT', High, normal} -> + eat_wait_for(Low, High); + Other -> + test_server:fail({bad_message, Other}) + end. + +eat_low(_Parent) -> + receive + after 2500 -> + ok + end, + receive + Any -> + io:format("Received: ~p\n", [Any]) + after 1000 -> + ok + end. + +eat_high(Low) -> + process_flag(priority, high), + receive after 1000 -> ok end, + exit(Low, {you, are, dead}), + {_, Sec, _} = now(), + loop(Sec, Sec). + +%% Busy loop for 5 seconds. + +loop(OrigSec, CurrentSec) when CurrentSec < OrigSec+5 -> + {_, NewSec, _} = now(), + loop(OrigSec, NewSec); +loop(_, _) -> + ok. + + +%% Tries to send two different exit messages to a process. +%% (The second one should be ignored.) +exit_twice(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(20)), + + ?line process_flag(trap_exit, true), + ?line Low = fun_spawn(fun etwice_low/0), + ?line High = fun_spawn(fun() -> etwice_high(Low) end), + ?line etwice_wait_for(Low, High), + + ?line test_server:timetrap_cancel(Dog), + ok. + +etwice_wait_for(Low, High) -> + ?line receive + {'EXIT', Low, first} -> + ok; + {'EXIT', Low, Other} -> + test_server:fail({wrong_exit_reason, Other}); + {'EXIT', High, normal} -> + etwice_wait_for(Low, High); + Other -> + test_server:fail({bad_message, Other}) + end. + +etwice_low() -> + etwice_low(). + +etwice_high(Low) -> + process_flag(priority, high), + exit(Low, first), + exit(Low, second). + +%% Tests the process_info/1 BIF. +t_process_info(Config) when is_list(Config) -> + ?line [] = process_info(self(), registered_name), + ?line register(my_name, self()), + ?line {registered_name, my_name} = process_info(self(), registered_name), + ?line {status, running} = process_info(self(), status), + ?line {current_function, {?MODULE, t_process_info, 1}} = + process_info(self(), current_function), + ?line Gleader = group_leader(), + ?line {group_leader, Gleader} = process_info(self(), group_leader), + ?line {'EXIT',{badarg,_Info}} = (catch process_info('not_a_pid')), + ok. + +%% Tests the process_info/1 BIF on another process with messages. +process_info_other_msg(Config) when is_list(Config) -> + Self = self(), + ?line Pid = spawn_link(fun() -> other_process(Self) end), + receive + {go_ahead,Pid} -> ok + end, + + ?line Own = {my,own,message}, + + ?line {messages,[Own]} = process_info(Pid, messages), + + ?line Garbage = kb_128(), + ?line MsgA = {a,Garbage}, + ?line MsgB = {b,Garbage}, + ?line MsgC = {c,Garbage}, + ?line MsgD = {d,Garbage}, + ?line MsgE = {e,Garbage}, + + ?line Pid ! MsgA, + ?line {messages,[Own,MsgA]} = process_info(Pid, messages), + ?line Pid ! MsgB, + ?line {messages,[Own,MsgA,MsgB]} = process_info(Pid, messages), + ?line Pid ! MsgC, + ?line {messages,[Own,MsgA,MsgB,MsgC]} = process_info(Pid, messages), + ?line Pid ! MsgD, + ?line {messages,[Own,MsgA,MsgB,MsgC,MsgD]} = process_info(Pid, messages), + ?line Pid ! MsgE, + ?line {messages,[Own,MsgA,MsgB,MsgC,MsgD,MsgE]=All} = process_info(Pid, messages), + ?line {memory,BytesOther} = process_info(Pid, memory), + ?line {memory,BytesSelf} = process_info(self(), memory), + + io:format("Memory ~p: ~p\n", [Pid,BytesOther]), + io:format("Memory ~p (self): ~p\n", [self(),BytesSelf]), + + [Own,MsgA,MsgB,MsgC,MsgD,MsgE] = All, + + ?line Pid ! {self(),empty}, + ?line receive + empty -> ok + end, + ?line {messages,[]} = process_info(Pid, messages), + ?line Pid ! stop, + ok. + +process_info_other_dist_msg(Config) when is_list(Config) -> + %% + %% Check that process_info can handle messages that have not been + %% decoded yet. + %% + ?line {ok, Node} = start_node(Config), + ?line Self = self(), + ?line Pid = spawn_link(fun() -> other_process(Self) end), + ?line receive {go_ahead,Pid} -> ok end, + + ?line Own = {my,own,message}, + + ?line {messages,[Own]} = process_info(Pid, messages), + ?line Garbage = kb_128(), + ?line MsgA = {a,self(),Garbage}, + ?line MsgB = {b,self(),Garbage}, + ?line MsgC = {c,self(),Garbage}, + ?line MsgD = {d,self(),Garbage}, + ?line MsgE = {e,self(),Garbage}, + + %% We don't want the other process to decode messages itself + %% therefore we suspend it. + ?line true = erlang:suspend_process(Pid), + ?line spawn_link(Node, fun () -> + Pid ! MsgA, + Pid ! MsgB, + Pid ! MsgC, + Self ! check_abc + end), + ?line receive check_abc -> ok end, + ?line [{status,suspended}, + {messages,[Own,MsgA,MsgB,MsgC]}, + {status,suspended}]= process_info(Pid, [status,messages,status]), + ?line spawn_link(Node, fun () -> + Pid ! MsgD, + Pid ! MsgE, + Self ! check_de + end), + ?line receive check_de -> ok end, + ?line {messages,[Own,MsgA,MsgB,MsgC,MsgD,MsgE]=All} + = process_info(Pid, messages), + ?line true = erlang:resume_process(Pid), + ?line Pid ! {self(), get_all_messages}, + ?line receive + {all_messages, AllMsgs} -> + ?line All = AllMsgs + end, + ?line {messages,[]} = process_info(Pid, messages), + ?line Pid ! stop, + ?line stop_node(Node), + ?line ok. + + +other_process(Parent) -> + self() ! {my,own,message}, + Parent ! {go_ahead,self()}, + other_process_1(). + +other_process_1() -> + receive + {Parent,get_all_messages} -> + Parent ! {all_messages, get_all_messages()}, + other_process_1(); + {Parent,empty} -> + receive_all(), + Parent ! empty, + other_process_1(); + stop -> ok + end. + +get_all_messages() -> + get_all_messages([]). + +get_all_messages(Msgs) -> + receive + Msg -> + get_all_messages([Msg|Msgs]) + after 0 -> + lists:reverse(Msgs) + end. + +receive_all() -> + receive + _ -> receive_all() + after 0 -> ok + end. + +chk_pi_order([],[]) -> + ok; +chk_pi_order([{Arg, _}| Values], [Arg|Args]) -> + chk_pi_order(Values, Args). + +process_info_2_list(doc) -> + []; +process_info_2_list(suite) -> + []; +process_info_2_list(Config) when is_list(Config) -> + ?line Proc = spawn(fun () -> + receive after infinity -> ok end end), + register(process_SUITE_process_info_2_list1, self()), + register(process_SUITE_process_info_2_list2, Proc), + ?line erts_debug:set_internal_state(available_internal_state,true), + ?line AllArgs = erts_debug:get_internal_state(process_info_args), + ?line A1 = lists:sort(AllArgs) ++ [status] ++ lists:reverse(AllArgs), + + %% Verify that argument is accepted as single atom + ?line lists:foreach(fun (A) -> + ?line {A, _} = process_info(Proc, A), + ?line {A, _} = process_info(self(), A) + end, + A1), + + %% Verify that order is preserved + ?line ok = chk_pi_order(process_info(self(), A1), A1), + ?line ok = chk_pi_order(process_info(Proc, A1), A1), + + %% Small arg list + ?line A2 = [status, stack_size, trap_exit, priority], + ?line [{status, _}, {stack_size, _}, {trap_exit, _}, {priority, _}] + = process_info(Proc, A2), + ?line [{status, _}, {stack_size, _}, {trap_exit, _}, {priority, _}] + = process_info(self(), A2), + + %% Huge arg list (note values are shared) + ?line A3 = lists:duplicate(5000,backtrace), + ?line V3 = process_info(Proc, A3), + ?line 5000 = length(V3), + ?line lists:foreach(fun ({backtrace, _}) -> ok end, V3), + ?line ok. + +process_info_lock_reschedule(doc) -> + []; +process_info_lock_reschedule(suite) -> + []; +process_info_lock_reschedule(Config) when is_list(Config) -> + %% We need a process that is running and an item that requires + %% process_info to take the main process lock. + ?line Target1 = spawn_link(fun tok_loop/0), + ?line Name1 = process_info_lock_reschedule_running, + ?line register(Name1, Target1), + ?line Target2 = spawn_link(fun () -> receive after infinity -> ok end end), + ?line Name2 = process_info_lock_reschedule_waiting, + ?line register(Name2, Target2), + ?line PI = fun(_) -> + ?line erlang:yield(), + ?line [{registered_name, Name1}] + = process_info(Target1, [registered_name]), + ?line [{registered_name, Name2}] + = process_info(Target2, [registered_name]), + ?line erlang:yield(), + ?line {registered_name, Name1} + = process_info(Target1, registered_name), + ?line {registered_name, Name2} + = process_info(Target2, registered_name), + ?line erlang:yield(), + ?line [{registered_name, Name1}| _] + = process_info(Target1), + ?line [{registered_name, Name2}| _] + = process_info(Target2) + end, + ?line lists:foreach(PI, lists:seq(1,1000)), + %% Make sure Target1 still is willing to "tok loop" + ?line case process_info(Target1, status) of + {status, OkStatus} when OkStatus == runnable; + OkStatus == running; + OkStatus == garbage_collecting -> + ?line unlink(Target1), + ?line unlink(Target2), + ?line exit(Target1, bang), + ?line exit(Target2, bang), + ?line OkStatus; + {status, BadStatus} -> + ?line ?t:fail(BadStatus) + end. + +pi_loop(_Name, _Pid, 0) -> + ok; +pi_loop(Name, Pid, N) -> + {registered_name, Name} = process_info(Pid, registered_name), + pi_loop(Name, Pid, N-1). + +process_info_lock_reschedule2(doc) -> + []; +process_info_lock_reschedule2(suite) -> + []; +process_info_lock_reschedule2(Config) when is_list(Config) -> + ?line Parent = self(), + ?line Fun = fun () -> + receive {go, Name, Pid} -> ok end, + pi_loop(Name, Pid, 10000), + Parent ! {done, self()}, + receive after infinity -> ok end + end, + ?line P1 = spawn_link(Fun), + ?line N1 = process_info_lock_reschedule2_1, + ?line true = register(N1, P1), + ?line P2 = spawn_link(Fun), + ?line N2 = process_info_lock_reschedule2_2, + ?line true = register(N2, P2), + ?line P3 = spawn_link(Fun), + ?line N3 = process_info_lock_reschedule2_3, + ?line true = register(N3, P3), + ?line P4 = spawn_link(Fun), + ?line N4 = process_info_lock_reschedule2_4, + ?line true = register(N4, P4), + ?line P5 = spawn_link(Fun), + ?line N5 = process_info_lock_reschedule2_5, + ?line true = register(N5, P5), + ?line P6 = spawn_link(Fun), + ?line N6 = process_info_lock_reschedule2_6, + ?line true = register(N6, P6), + ?line P1 ! {go, N2, P2}, + ?line P2 ! {go, N1, P1}, + ?line P3 ! {go, N1, P1}, + ?line P4 ! {go, N1, P1}, + ?line P5 ! {go, N6, P6}, + ?line P6 ! {go, N5, P5}, + ?line receive {done, P1} -> ok end, + ?line receive {done, P2} -> ok end, + ?line receive {done, P3} -> ok end, + ?line receive {done, P4} -> ok end, + ?line receive {done, P5} -> ok end, + ?line receive {done, P6} -> ok end, + ?line unlink(P1), exit(P1, bang), + ?line unlink(P2), exit(P2, bang), + ?line unlink(P3), exit(P3, bang), + ?line unlink(P4), exit(P4, bang), + ?line unlink(P5), exit(P5, bang), + ?line unlink(P6), exit(P6, bang), + ?line ok. + +process_status_exiting(Config) when is_list(Config) -> + %% Make sure that erts_debug:get_internal_state({process_status,P}) + %% returns exiting if it is in status P_EXITING. + ?line erts_debug:set_internal_state(available_internal_state,true), + ?line Prio = process_flag(priority, max), + ?line P = spawn_opt(fun () -> receive after infinity -> ok end end, + [{priority, normal}]), + ?line erlang:yield(), + %% The tok_loop processes are here to make it hard for the exiting + %% process to be scheduled in for exit... + ?line TokLoops = lists:map(fun (_) -> + spawn_opt(fun tok_loop/0, + [link,{priority, high}]) + end, + lists:seq(1, erlang:system_info(schedulers_online))), + ?line exit(P, boom), + ?line wait_until( + fun () -> + exiting =:= erts_debug:get_internal_state({process_status,P}) + end), + ?line lists:foreach(fun (Tok) -> unlink(Tok), exit(Tok,bang) end, TokLoops), + ?line process_flag(priority, Prio), + ?line ok. + +otp_4725(Config) when is_list(Config) -> + ?line Tester = self(), + ?line Ref1 = make_ref(), + ?line Pid1 = spawn_opt(fun () -> + Tester ! {Ref1, process_info(self())}, + receive + Ref1 -> bye + end + end, + [link, + {priority, max}, + {fullsweep_after, 600}]), + ?line receive + {Ref1, ProcInfo1A} -> + ?line ProcInfo1B = process_info(Pid1), + ?line Pid1 ! Ref1, + ?line check_proc_infos(ProcInfo1A, ProcInfo1B) + end, + ?line Ref2 = make_ref(), + ?line Pid2 = spawn_opt(fun () -> + Tester ! {Ref2, process_info(self())}, + receive + Ref2 -> bye + end + end, + []), + ?line receive + {Ref2, ProcInfo2A} -> + ?line ProcInfo2B = process_info(Pid2), + ?line Pid2 ! Ref2, + ?line check_proc_infos(ProcInfo2A, ProcInfo2B) + end, + ?line ok. + +check_proc_infos(A, B) -> + ?line IC = lists:keysearch(initial_call, 1, A), + ?line IC = lists:keysearch(initial_call, 1, B), + + ?line L = lists:keysearch(links, 1, A), + ?line L = lists:keysearch(links, 1, B), + + ?line D = lists:keysearch(dictionary, 1, A), + ?line D = lists:keysearch(dictionary, 1, B), + + ?line TE = lists:keysearch(trap_exit, 1, A), + ?line TE = lists:keysearch(trap_exit, 1, B), + + ?line EH = lists:keysearch(error_handler, 1, A), + ?line EH = lists:keysearch(error_handler, 1, B), + + ?line P = lists:keysearch(priority, 1, A), + ?line P = lists:keysearch(priority, 1, B), + + ?line GL = lists:keysearch(group_leader, 1, A), + ?line GL = lists:keysearch(group_leader, 1, B), + + ?line GC = lists:keysearch(garbage_collection, 1, A), + ?line GC = lists:keysearch(garbage_collection, 1, B), + + ?line ok. + + +%% Dummies. + +start_spawner() -> + ok. + +stop_spawner() -> + ok. + +%% Tests erlang:bump_reductions/1. +bump_reductions(Config) when is_list(Config) -> + ?line erlang:garbage_collect(), + ?line receive after 1 -> ok end, % Clear reductions. + ?line {reductions,R1} = process_info(self(), reductions), + ?line true = erlang:bump_reductions(100), + ?line {reductions,R2} = process_info(self(), reductions), + ?line case R2-R1 of + Diff when Diff < 100 -> + ?line ok = io:format("R1 = ~w, R2 = ~w", [R1, R2]), + ?line test_server:fail({small_diff, Diff}); + Diff when Diff > 110 -> + ?line ok = io:format("R1 = ~w, R2 = ~w", [R1, R2]), + ?line test_server:fail({big_diff, Diff}); + Diff -> + io:format("~p\n", [Diff]), + ok + end, + + %% Make sure that a bignum reduction doesn't crash the emulator (32-bit CPU). + bump_big(R2, 16#08000000). + +bump_big(Prev, Limit) -> + ?line true = erlang:bump_reductions(100000), %Limited to CONTEXT_REDUCTIONS. + ?line case process_info(self(), reductions) of + {reductions,Big} when is_integer(Big), Big > Limit -> + ?line erlang:garbage_collect(), + ?line io:format("~p\n", [Big]); + {reductions,R} when is_integer(R), R > Prev -> + bump_big(R, Limit) + end, + ok. + +%% Priority 'low' should be mixed with 'normal' using a factor of +%% about 8. (OTP-2644) +low_prio(Config) when is_list(Config) -> + case erlang:system_info(schedulers_online) of + 1 -> + ?line ok = low_prio_test(Config); + _ -> + ?line erlang:system_flag(multi_scheduling, block), + ?line ok = low_prio_test(Config), + ?line erlang:system_flag(multi_scheduling, unblock), + ?line {comment, + "Test not written for SMP runtime system. " + "Multi scheduling blocked during test."} + end. + +low_prio_test(Config) when is_list(Config) -> + ?line process_flag(trap_exit, true), + ?line S = spawn_link(?MODULE, prio_server, [0, 0]), + ?line PCs = spawn_prio_clients(S, erlang:system_info(schedulers_online)), + ?line timer:sleep(2000), + ?line lists:foreach(fun (P) -> exit(P, kill) end, PCs), + ?line S ! exit, + ?line receive {'EXIT', S, {A, B}} -> check_prio(A, B) end, + ok. + +check_prio(A, B) -> + ?line Prop = A/B, + ?line ok = io:format("Low=~p, High=~p, Prop=~p\n", [A, B, Prop]), + + %% It isn't 1/8, it's more like 0.3, but let's check that + %% the low-prio processes get some little chance to run at all. + ?line true = (Prop < 1.0), + ?line true = (Prop > 1/32). + +prio_server(A, B) -> + receive + low -> + prio_server(A+1, B); + normal -> + prio_server(A, B+1); + exit -> + exit({A, B}) + end. + +spawn_prio_clients(_, 0) -> + []; +spawn_prio_clients(S, N) -> + [spawn_opt(?MODULE, prio_client, [S, normal], [link, {priority,normal}]), + spawn_opt(?MODULE, prio_client, [S, low], [link, {priority,low}]) + | spawn_prio_clients(S, N-1)]. + +prio_client(S, Prio) -> + S ! Prio, + prio_client(S, Prio). + +make_sub_binary(Bin) when is_binary(Bin) -> + {_,B} = split_binary(list_to_binary([0,1,3,Bin]), 3), + B; +make_sub_binary(List) -> + make_sub_binary(list_to_binary(List)). + +make_unaligned_sub_binary(Bin0) -> + Bin1 = <<0:3,Bin0/binary,31:5>>, + Sz = size(Bin0), + <<0:3,Bin:Sz/binary,31:5>> = id(Bin1), + Bin. + +yield(doc) -> + "Tests erlang:yield/1."; +yield(Config) when is_list(Config) -> + case catch erlang:system_info(modified_timing_level) of + Level when is_integer(Level) -> + {skipped, + "Modified timing (level " ++ integer_to_list(Level) + ++ ") is enabled. Testcase gets messed up by modfied " + "timing."}; + _ -> + MS = erlang:system_flag(multi_scheduling, block), + yield_test(), + erlang:system_flag(multi_scheduling, unblock), + case MS of + blocked -> + {comment, + "Multi-scheduling blocked during test. This test-case " + "was not written to work with multiple schedulers (the " + "yield2 test-case tests almost the same thing)."}; + _ -> + ok + end + end. + +yield_test() -> + ?line erlang:garbage_collect(), + ?line receive after 1 -> ok end, % Clear reductions. + ?line SC = schedcnt(start), + ?line {reductions, R1} = process_info(self(), reductions), + ?line {ok, true} = call_yield(middle), + ?line true = call_yield(final), + ?line true = call_yield(), + ?line true = apply(erlang, yield, []), + ?line {reductions, R2} = process_info(self(), reductions), + ?line Schedcnt = schedcnt(stop, SC), + ?line case {R2-R1, Schedcnt} of + {Diff, 4} when Diff < 30 -> + ?line ok = io:format("R1 = ~w, R2 = ~w, Schedcnt = ~w", + [R1, R2, Schedcnt]); + {Diff, _} -> + ?line ok = io:format("R1 = ~w, R2 = ~w, Schedcnt = ~w", + [R1, R2, Schedcnt]), + ?line test_server:fail({measurement_error, Diff, Schedcnt}) + end. + +call_yield() -> + erlang:yield(). + +call_yield(middle) -> + {ok, erlang:yield()}; +call_yield(final) -> + case self() of + Self when is_pid(Self) -> + ok + end, + erlang:yield(). + +schedcnt(start) -> + Ref = make_ref(), + Fun = + fun (F, Cnt) -> + receive + {Ref, Parent} -> + Parent ! {Ref, Cnt} + after 0 -> + erlang:yield(), + F(F, Cnt+1) + end + end, + Pid = spawn_link(fun () -> Fun(Fun, 0) end), + {Ref, Pid}. + +schedcnt(stop, {Ref, Pid}) when is_reference(Ref), is_pid(Pid) -> + Pid ! {Ref, self()}, + receive + {Ref, Cnt} -> + Cnt + end. + +yield2(doc) -> []; +yield2(suite) -> []; +yield2(Config) when is_list(Config) -> + ?line Me = self(), + ?line Go = make_ref(), + ?line RedDiff = make_ref(), + ?line Done = make_ref(), + ?line P = spawn(fun () -> + receive Go -> ok end, + {reductions, R1} = process_info(self(), reductions), + {ok, true} = call_yield(middle), + true = call_yield(final), + true = call_yield(), + true = apply(erlang, yield, []), + {reductions, R2} = process_info(self(), reductions), + Me ! {RedDiff, R2 - R1}, + exit(Done) + end), + ?line erlang:yield(), + + ?line 1 = erlang:trace(P, true, [running, procs, {tracer, self()}]), + + ?line P ! Go, + + %% receive Go -> ok end, + ?line {trace, P, in, _} = next_tmsg(P), + + %% {ok, true} = call_yield(middle), + ?line {trace, P, out, _} = next_tmsg(P), + ?line {trace, P, in, _} = next_tmsg(P), + + %% true = call_yield(final), + ?line {trace, P, out, _} = next_tmsg(P), + ?line {trace, P, in, _} = next_tmsg(P), + + %% true = call_yield(), + ?line {trace, P, out, _} = next_tmsg(P), + ?line {trace, P, in, _} = next_tmsg(P), + + %% true = apply(erlang, yield, []), + ?line {trace, P, out, _} = next_tmsg(P), + ?line {trace, P, in, _} = next_tmsg(P), + + %% exit(Done) + ?line {trace, P, exit, Done} = next_tmsg(P), + + + ?line receive + {RedDiff, Reductions} when Reductions < 30, Reductions > 0 -> + io:format("Reductions = ~p~n", [Reductions]), + ?line ok; + {RedDiff, Reductions} -> + ?line ?t:fail({unexpected_reduction_count, Reductions}) + end, + + ?line none = next_tmsg(P), + + ?line ok. + +next_tmsg(Pid) -> + receive + TMsg when is_tuple(TMsg), + element(1, TMsg) == trace, + element(2, TMsg) == Pid -> + TMsg + after 100 -> + none + end. + +%% Test that bad arguments to register/2 cause an exception. +bad_register(Config) when is_list(Config) -> + Name = a_long_and_unused_name, + + ?line {'EXIT',{badarg,_}} = (catch register({bad,name}, self())), + ?line fail_register(undefined, self()), + ?line fail_register([bad,name], self()), + + ?line {Dead,Mref} = spawn_monitor(fun() -> true end), + receive + {'DOWN',Mref,process,Dead,_} -> ok + end, + ?line fail_register(Name, Dead), + ?line fail_register(Name, make_ref()), + ?line fail_register(Name, []), + ?line fail_register(Name, {bad,process}), + ?line fail_register(Name, <<>>), + ok. + +fail_register(Name, Process) -> + {'EXIT',{badarg,_}} = (catch register(Name, Process)), + {'EXIT',{badarg,_}} = (catch Name ! anything_goes), + ok. + +garbage_collect(doc) -> []; +garbage_collect(suite) -> []; +garbage_collect(Config) when is_list(Config) -> + ?line Prio = process_flag(priority, high), + ?line true = erlang:garbage_collect(), + ?line TokLoopers = lists:map(fun (_) -> + spawn_opt(fun tok_loop/0, + [{priority, low}, link]) + end, + lists:seq(1, 10)), + ?line lists:foreach(fun (Pid) -> + ?line Mon = erlang:monitor(process, Pid), + ?line DownBefore = receive + {'DOWN', Mon, _, _, _} -> + ?line true + after 0 -> + ?line false + end, + ?line GC = erlang:garbage_collect(Pid), + ?line DownAfter = receive + {'DOWN', Mon, _, _, _} -> + ?line true + after 0 -> + ?line false + end, + ?line true = erlang:demonitor(Mon), + ?line case {DownBefore, DownAfter} of + {true, _} -> ?line false = GC; + {false, false} -> ?line true = GC; + _ -> ?line GC + end + end, + processes()), + ?line lists:foreach(fun (Pid) -> + unlink(Pid), + exit(Pid, bang) + end, TokLoopers), + ?line process_flag(priority, Prio), + ?line ok. + +process_info_messages(doc) -> + ["This used to cause the nofrag emulator to dump core"]; +process_info_messages(suite) -> + []; +process_info_messages(Config) when is_list(Config) -> + ?line process_info_messages_test(), + ?line ok. + +process_info_messages_loop(0) -> ok; +process_info_messages_loop(N) -> process_info_messages_loop(N-1). + +process_info_messages_send_my_msgs_to(Rcvr) -> + receive + Msg -> + Rcvr ! Msg, + process_info_messages_send_my_msgs_to(Rcvr) + after 0 -> + ok + end. + +process_info_messages_test() -> + ?line Go = make_ref(), + ?line Done = make_ref(), + ?line Rcvr = self(), + ?line Rcvr2 = spawn_link(fun () -> + receive {Go, Rcvr} -> ok end, + garbage_collect(), + Rcvr ! {Done, self()} + end), + ?line Sndrs = lists:map( + fun (_) -> + spawn_link(fun () -> + Rcvr ! {Go, self()}, + receive {Go, Rcvr} -> ok end, + BigData = lists:seq(1, 1000), + Rcvr ! BigData, + Rcvr ! BigData, + Rcvr ! BigData, + Rcvr ! {Done, self()} + end) + end, + lists:seq(1, 10)), + ?line lists:foreach(fun (Sndr) -> receive {Go, Sndr} -> ok end end, + Sndrs), + ?line garbage_collect(), + ?line erlang:yield(), + ?line lists:foreach(fun (Sndr) -> Sndr ! {Go, self()} end, Sndrs), + ?line process_info_messages_loop(100000000), + ?line Msgs = process_info(self(), messages), + ?line lists:foreach(fun (Sndr) -> receive {Done, Sndr} -> ok end end, + Sndrs), + ?line garbage_collect(), + ?line Rcvr2 ! Msgs, + ?line process_info_messages_send_my_msgs_to(Rcvr2), + ?line Rcvr2 ! {Go, self()}, + ?line garbage_collect(), + ?line receive {Done, Rcvr2} -> ok end, + ?line Msgs. + +chk_badarg(Fun) -> + try Fun(), exit(no_badarg) catch error:badarg -> ok end. + +process_flag_badarg(doc) -> + []; +process_flag_badarg(suite) -> + []; +process_flag_badarg(Config) when is_list(Config) -> + ?line chk_badarg(fun () -> process_flag(gurka, banan) end), + ?line chk_badarg(fun () -> process_flag(trap_exit, gurka) end), + ?line chk_badarg(fun () -> process_flag(error_handler, 1) end), + ?line chk_badarg(fun () -> process_flag(min_heap_size, gurka) end), + ?line chk_badarg(fun () -> process_flag(priority, 4711) end), + ?line chk_badarg(fun () -> process_flag(save_calls, hmmm) end), + ?line P= spawn_link(fun () -> receive die -> ok end end), + ?line chk_badarg(fun () -> process_flag(P, save_calls, hmmm) end), + ?line chk_badarg(fun () -> process_flag(gurka, save_calls, hmmm) end), + ?line P ! die, + ?line ok. + +-include_lib("stdlib/include/ms_transform.hrl"). + +otp_6237(doc) -> []; +otp_6237(suite) -> []; +otp_6237(Config) when is_list(Config) -> + ?line Slctrs = lists:map(fun (_) -> + spawn_link(fun () -> + otp_6237_select_loop() + end) + end, + lists:seq(1,5)), + ?line lists:foreach(fun (_) -> otp_6237_test() end, lists:seq(1, 100)), + ?line lists:foreach(fun (S) -> unlink(S),exit(S, kill) end, Slctrs), + ?line ok. + +otp_6237_test() -> + ?line Parent = self(), + ?line Inited = make_ref(), + ?line Die = make_ref(), + ?line Pid = spawn_link(fun () -> + register(otp_6237,self()), + otp_6237 = ets:new(otp_6237, + [named_table, + ordered_set]), + ets:insert(otp_6237, + [{I,I} + || I <- lists:seq(1, 100)]), + %% Inserting a lot of bif timers + %% increase the possibility that + %% the test will fail when the + %% original cleanup order is used + lists:foreach( + fun (_) -> + erlang:send_after(1000000, + self(), + {a,b,c}) + end, + lists:seq(1,1000)), + Parent ! Inited, + receive Die -> bye end + end), + ?line receive + Inited -> ?line ok + end, + ?line Pid ! Die, + otp_6237_whereis_loop(). + +otp_6237_whereis_loop() -> + ?line case whereis(otp_6237) of + undefined -> + ?line otp_6237 = ets:new(otp_6237, + [named_table,ordered_set]), + ?line ets:delete(otp_6237), + ?line ok; + _ -> + ?line otp_6237_whereis_loop() + end. + +otp_6237_select_loop() -> + catch ets:select(otp_6237, ets:fun2ms(fun({K, does_not_exist}) -> K end)), + otp_6237_select_loop(). + + +processes_bif(doc) -> + []; +processes_bif(suite) -> + [processes_large_tab, + processes_default_tab, + processes_small_tab, + processes_this_tab, + processes_last_call_trap, + processes_apply_trap, + processes_gc_trap, + processes_term_proc_list]. + +-define(NoTestProcs, 10000). +-record(processes_bif_info, {min_start_reds, + tab_chunks, + tab_chunks_size, + tab_indices_per_red, + free_term_proc_reds, + term_procs_per_red, + term_procs_max_reds, + conses_per_red, + debug_level}). + +processes_large_tab(doc) -> + []; +processes_large_tab(suite) -> + []; +processes_large_tab(Config) when is_list(Config) -> + ?line enable_internal_state(), + ?line MaxDbgLvl = 20, + ?line MinProcTabSize = 2*(1 bsl 15), + ?line ProcTabSize0 = 1000000, + ?line ProcTabSize1 = case {erlang:system_info(schedulers_online), + erlang:system_info(logical_processors)} of + {Schdlrs, Cpus} when is_integer(Cpus), + Schdlrs =< Cpus -> + ProcTabSize0; + _ -> + ProcTabSize0 div 4 + end, + ?line ProcTabSize2 = case erlang:system_info(debug_compiled) of + true -> ProcTabSize1 - 500000; + false -> ProcTabSize1 + end, + %% With high debug levels this test takes so long time that + %% the connection times out; therefore, shrink the test on + %% high debug levels. + ?line DbgLvl = case erts_debug:get_internal_state(processes_bif_info) of + #processes_bif_info{debug_level = Lvl} when Lvl > MaxDbgLvl -> + 20; + #processes_bif_info{debug_level = Lvl} when Lvl < 0 -> + ?line ?t:fail({debug_level, Lvl}); + #processes_bif_info{debug_level = Lvl} -> + Lvl + end, + ?line ProcTabSize3 = ProcTabSize2 - (1300000 * DbgLvl div MaxDbgLvl), + ?line ProcTabSize = case ProcTabSize3 < MinProcTabSize of + true -> MinProcTabSize; + false -> ProcTabSize3 + end, + ?line {ok, LargeNode} = start_node(Config, + "+P " ++ integer_to_list(ProcTabSize)), + ?line Res = rpc:call(LargeNode, ?MODULE, processes_bif_test, []), + ?line case rpc:call(LargeNode, + erts_debug, + get_internal_state, + [processes_bif_info]) of + #processes_bif_info{tab_chunks = Chunks} when is_integer(Chunks), + Chunks > 1 -> ok; + PBInfo -> ?t:fail(PBInfo) + end, + ?line stop_node(LargeNode), + ?line chk_processes_bif_test_res(Res). + +processes_default_tab(doc) -> + []; +processes_default_tab(suite) -> + []; +processes_default_tab(Config) when is_list(Config) -> + ?line {ok, DefaultNode} = start_node(Config, ""), + ?line Res = rpc:call(DefaultNode, ?MODULE, processes_bif_test, []), + ?line stop_node(DefaultNode), + ?line chk_processes_bif_test_res(Res). + +processes_small_tab(doc) -> + []; +processes_small_tab(suite) -> + []; +processes_small_tab(Config) when is_list(Config) -> + ?line {ok, SmallNode} = start_node(Config, "+P 500"), + ?line Res = rpc:call(SmallNode, ?MODULE, processes_bif_test, []), + ?line PBInfo = rpc:call(SmallNode, + erts_debug, + get_internal_state, + [processes_bif_info]), + ?line stop_node(SmallNode), + ?line 1 = PBInfo#processes_bif_info.tab_chunks, + ?line chk_processes_bif_test_res(Res). + +processes_this_tab(doc) -> + []; +processes_this_tab(suite) -> + []; +processes_this_tab(Config) when is_list(Config) -> + ?line chk_processes_bif_test_res(processes_bif_test()). + +chk_processes_bif_test_res(ok) -> ok; +chk_processes_bif_test_res({comment, _} = Comment) -> Comment; +chk_processes_bif_test_res(Failure) -> ?t:fail(Failure). + +print_processes_bif_info(#processes_bif_info{min_start_reds = MinStartReds, + tab_chunks = TabChunks, + tab_chunks_size = TabChunksSize, + tab_indices_per_red = TabIndPerRed, + free_term_proc_reds = FreeTPReds, + term_procs_per_red = TPPerRed, + term_procs_max_reds = TPMaxReds, + conses_per_red = ConsesPerRed, + debug_level = DbgLvl}) -> + ?t:format("processes/0 bif info on node ~p:~n" + "Min start reductions = ~p~n" + "Process table chunks = ~p~n" + "Process table chunks size = ~p~n" + "Process table indices per reduction = ~p~n" + "Reduction cost for free() on terminated process struct = ~p~n" + "Inspect terminated processes per reduction = ~p~n" + "Max reductions during inspection of terminated processes = ~p~n" + "Create cons-cells per reduction = ~p~n" + "Debug level = ~p~n", + [node(), + MinStartReds, + TabChunks, + TabChunksSize, + TabIndPerRed, + FreeTPReds, + TPPerRed, + TPMaxReds, + ConsesPerRed, + DbgLvl]). + +processes_bif_cleaner() -> + receive {'EXIT', _, _} -> ok end, + processes_bif_cleaner(). + +spawn_initial_hangarounds(Cleaner) -> + TabSz = erlang:system_info(process_limit), + spawn_initial_hangarounds(Cleaner, + TabSz, + TabSz*2, + 0, + []). + +processes_unexpected_result(CorrectProcs, Procs) -> + ProcInfo = [registered_name, + initial_call, + current_function, + status, + priority], + MissingProcs = CorrectProcs -- Procs, + ?t:format("Missing processes: ~p", + [lists:map(fun (Pid) -> + [{pid, Pid} + | case process_info(Pid, ProcInfo) of + undefined -> []; + Res -> Res + end] + end, + MissingProcs)]), + SuperfluousProcs = Procs -- CorrectProcs, + ?t:format("Superfluous processes: ~p", + [lists:map(fun (Pid) -> + [{pid, Pid} + | case process_info(Pid, ProcInfo) of + undefined -> []; + Res -> Res + end] + end, + SuperfluousProcs)]), + ?t:fail(unexpected_result). + +hangaround(Cleaner, Type) -> + %% Type is only used to distinguish different processes from + %% when doing process_info + try link(Cleaner) catch error:Reason -> exit(Reason) end, + receive after infinity -> ok end, + exit(Type). + +spawn_initial_hangarounds(_Cleaner, NP, Max, Len, HAs) when NP > Max -> + {Len, HAs}; +spawn_initial_hangarounds(Cleaner, NP, Max, Len, HAs) -> + erts_debug:set_internal_state(next_pid,NP), + HA1 = spawn_opt(?MODULE, hangaround, [Cleaner, initial_hangaround], + [{priority, low}]), + HA2 = spawn_opt(?MODULE, hangaround, [Cleaner, initial_hangaround], + [{priority, normal}]), + HA3 = spawn_opt(?MODULE, hangaround, [Cleaner, initial_hangaround], + [{priority, high}]), + spawn_initial_hangarounds(Cleaner, NP+30, Max, Len+3, [HA1,HA2,HA3|HAs]). + +do_processes(WantReds) -> + erts_debug:set_internal_state(reds_left, WantReds), + processes(). + +processes_bif_test() -> + ?line Tester = self(), + ?line enable_internal_state(), + ?line PBInfo = erts_debug:get_internal_state(processes_bif_info), + ?line print_processes_bif_info(PBInfo), + ?line WantReds = PBInfo#processes_bif_info.min_start_reds + 10, + ?line WillTrap = case PBInfo of + #processes_bif_info{tab_chunks = 1} -> + false; + #processes_bif_info{tab_chunks = Chunks, + tab_chunks_size = ChunksSize, + tab_indices_per_red = IndiciesPerRed + } -> + Chunks*ChunksSize >= IndiciesPerRed*WantReds + end, + ?line Processes = fun () -> + erts_debug:set_internal_state(reds_left,WantReds), + processes() + end, + + ?line ok = do_processes_bif_test(WantReds, WillTrap, Processes), + + case WillTrap of + false -> + ok; + true -> + %% Do it again with a process suspended while + %% in the processes/0 bif. + ?line erlang:system_flag(multi_scheduling, block), + ?line Suspendee = spawn_link(fun () -> + Tester ! {suspend_me, self()}, + Tester ! {self(), + done, + hd(Processes())}, + receive + after infinity -> + ok + end + end), + ?line receive {suspend_me, Suspendee} -> ok end, + ?line erlang:suspend_process(Suspendee), + ?line erlang:system_flag(multi_scheduling, unblock), + + ?line [{status,suspended}, + {current_function,{erlang,processes_trap,2}}] + = process_info(Suspendee, [status, current_function]), + + ?line ok = do_processes_bif_test(WantReds, WillTrap, Processes), + + ?line erlang:resume_process(Suspendee), + ?line receive {Suspendee, done, _} -> ok end, + ?line unlink(Suspendee), + ?line exit(Suspendee, bang) + end, + case get(processes_bif_testcase_comment) of + undefined -> ?line ok; + Comment -> ?line {comment, Comment} + end. + +do_processes_bif_test(WantReds, DieTest, Processes) -> + ?line Tester = self(), + ?line SpawnProcesses = fun (Prio) -> + spawn_opt(?MODULE, + do_processes, + [WantReds], + [link, {priority, Prio}]) + end, + ?line Cleaner = spawn_link(fun () -> + process_flag(trap_exit, true), + Tester ! {cleaner_alive, self()}, + processes_bif_cleaner() + end), + ?line receive {cleaner_alive, Cleaner} -> ok end, + try + ?line DoIt = make_ref(), + ?line GetGoing = make_ref(), + ?line {NoTestProcs, TestProcs} = spawn_initial_hangarounds(Cleaner), + ?line ?t:format("Testing with ~p processes~n", [NoTestProcs]), + ?line SpawnHangAround = fun () -> + spawn(?MODULE, + hangaround, + [Cleaner, new_hangaround]) + end, + ?line Killer = spawn_opt(fun () -> + Splt = NoTestProcs div 10, + {TP1, TP23} = lists:split(Splt, + TestProcs), + {TP2, TP3} = lists:split(Splt, TP23), + erlang:system_flag(multi_scheduling, + block), + Tester ! DoIt, + receive GetGoing -> ok end, + erlang:system_flag(multi_scheduling, + unblock), + SpawnProcesses(high), + lists:foreach( + fun (P) -> + SpawnHangAround(), + exit(P, bang) + end, + TP1), + SpawnProcesses(high), + erlang:yield(), + lists:foreach( + fun (P) -> + SpawnHangAround(), + exit(P, bang) + end, + TP2), + SpawnProcesses(high), + lists:foreach( + fun (P) -> + SpawnHangAround(), + exit(P, bang) + end, + TP3) + end, + [{priority, high}, link]), + ?line receive DoIt -> ok end, + ?line process_flag(priority, low), + ?line SpawnProcesses(low), + ?line erlang:yield(), + ?line process_flag(priority, normal), + ?line CorrectProcs0 = erts_debug:get_internal_state(processes), + ?line Killer ! GetGoing, + ?line erts_debug:set_internal_state(reds_left, WantReds), + ?line Procs0 = processes(), + ?line Procs = lists:sort(Procs0), + ?line CorrectProcs = lists:sort(CorrectProcs0), + ?line LengthCorrectProcs = length(CorrectProcs), + ?line ?t:format("~p = length(CorrectProcs)~n", [LengthCorrectProcs]), + ?line true = LengthCorrectProcs > NoTestProcs, + ?line case CorrectProcs =:= Procs of + true -> + ?line ok; + false -> + ?line processes_unexpected_result(CorrectProcs, Procs) + end, + ?line unlink(Killer), + ?line exit(Killer, bang) + after + unlink(Cleaner), + exit(Cleaner, kill), + %% Wait for the system to recover to a normal state... + wait_until_system_recover() + end, + ?line do_processes_bif_die_test(DieTest, Processes), + ?line ok. + + +do_processes_bif_die_test(false, _Processes) -> + ?line ?t:format("Skipping test killing process executing processes/0~n",[]), + ?line ok; +do_processes_bif_die_test(true, Processes) -> + ?line do_processes_bif_die_test(5, Processes); +do_processes_bif_die_test(N, Processes) -> + ?line ?t:format("Doing test killing process executing processes/0~n",[]), + try + ?line Tester = self(), + ?line Oooh_Nooooooo = make_ref(), + ?line {_, DieWhileDoingMon} = erlang:spawn_monitor( + fun () -> + Victim = self(), + spawn_opt( + fun () -> + exit(Victim, got_him) + end, + [link, + {priority, max}]), + Tester ! {Oooh_Nooooooo, + hd(Processes())}, + exit(ohhhh_nooooo) + end), + ?line receive + {'DOWN', DieWhileDoingMon, _, _, Reason} -> + case Reason of + got_him -> ok; + _ -> throw({kill_in_trap, Reason}) + end + end, + ?line receive + {Oooh_Nooooooo, _} -> + ?line throw({kill_in_trap, 'Oooh_Nooooooo'}) + after 0 -> + ?line ok + end, + ?line PrcsCllrsSeqLen = 2*erlang:system_info(schedulers_online), + ?line PrcsCllrsSeq = lists:seq(1, PrcsCllrsSeqLen), + ?line ProcsCallers = lists:map( + fun (_) -> + spawn_link( + fun () -> + Tester ! hd(Processes()) + end) + end, + PrcsCllrsSeq), + ?line erlang:yield(), + {ProcsCallers1, ProcsCallers2} = lists:split(PrcsCllrsSeqLen div 2, + ProcsCallers), + ?line process_flag(priority, high), + ?line lists:foreach( + fun (P) -> + unlink(P), + exit(P, bang) + end, + lists:reverse(ProcsCallers2) ++ ProcsCallers1), + ?line process_flag(priority, normal), + ?line ok + catch + throw:{kill_in_trap, R} when N > 0 -> + ?t:format("Failed to kill in trap: ~p~n", [R]), + ?t:format("Trying again~p~n", []), + do_processes_bif_die_test(N-1, Processes) + end. + + +wait_until_system_recover() -> + %% If system hasn't recovered after 10 seconds we give up + Tmr = erlang:start_timer(10000, self(), no_more_wait), + wait_until_system_recover(Tmr). + +wait_until_system_recover(Tmr) -> + try + lists:foreach(fun (P) when P == self() -> + ok; + (P) -> + case process_info(P, initial_call) of + {initial_call,{?MODULE, _, _}} -> + throw(wait); + {initial_call,{_, _, _}} -> + ok; + undefined -> + ok + end + end, + processes()) + catch + throw:wait -> + receive + {timeout, Tmr, _} -> + Comment = "WARNING: Test processes still hanging around!", + ?t:format("~s~n", [Comment]), + put(processes_bif_testcase_comment, Comment), + lists:foreach( + fun (P) when P == self() -> + ok; + (P) -> + case process_info(P, initial_call) of + {initial_call,{?MODULE, _, _} = MFA} -> + ?t:format("~p ~p~n", [P, MFA]); + {initial_call,{_, _, _}} -> + ok; + undefined -> + ok + end + end, + processes()) + after 100 -> + wait_until_system_recover(Tmr) + end + end, + erlang:cancel_timer(Tmr), + receive {timeout, Tmr, _} -> ok after 0 -> ok end, + ok. + +processes_last_call_trap(doc) -> + []; +processes_last_call_trap(suite) -> + []; +processes_last_call_trap(Config) when is_list(Config) -> + ?line enable_internal_state(), + ?line Processes = fun () -> processes() end, + ?line PBInfo = erts_debug:get_internal_state(processes_bif_info), + ?line print_processes_bif_info(PBInfo), + ?line WantReds = case PBInfo#processes_bif_info.min_start_reds of + R when R > 10 -> R - 1; + _R -> 9 + end, + ?line lists:foreach(fun (_) -> + ?line erts_debug:set_internal_state(reds_left, + WantReds), + Processes(), + ?line erts_debug:set_internal_state(reds_left, + WantReds), + my_processes() + end, + lists:seq(1,100)). + +my_processes() -> + processes(). + +processes_apply_trap(doc) -> + []; +processes_apply_trap(suite) -> + []; +processes_apply_trap(Config) when is_list(Config) -> + ?line enable_internal_state(), + ?line PBInfo = erts_debug:get_internal_state(processes_bif_info), + ?line print_processes_bif_info(PBInfo), + ?line WantReds = case PBInfo#processes_bif_info.min_start_reds of + R when R > 10 -> R - 1; + _R -> 9 + end, + ?line lists:foreach(fun (_) -> + ?line erts_debug:set_internal_state(reds_left, + WantReds), + ?line apply(erlang, processes, []) + end, + lists:seq(1,100)). + +processes_gc_trap(doc) -> + []; +processes_gc_trap(suite) -> + []; +processes_gc_trap(Config) when is_list(Config) -> + ?line Tester = self(), + ?line enable_internal_state(), + ?line PBInfo = erts_debug:get_internal_state(processes_bif_info), + ?line print_processes_bif_info(PBInfo), + ?line WantReds = PBInfo#processes_bif_info.min_start_reds + 10, + ?line Processes = fun () -> + erts_debug:set_internal_state(reds_left,WantReds), + processes() + end, + + ?line erlang:system_flag(multi_scheduling, block), + ?line Suspendee = spawn_link(fun () -> + Tester ! {suspend_me, self()}, + Tester ! {self(), + done, + hd(Processes())}, + receive after infinity -> ok end + end), + ?line receive {suspend_me, Suspendee} -> ok end, + ?line erlang:suspend_process(Suspendee), + ?line erlang:system_flag(multi_scheduling, unblock), + + ?line [{status,suspended}, {current_function,{erlang,processes_trap,2}}] + = process_info(Suspendee, [status, current_function]), + + ?line erlang:garbage_collect(Suspendee), + ?line erlang:garbage_collect(Suspendee), + + ?line erlang:resume_process(Suspendee), + ?line receive {Suspendee, done, _} -> ok end, + ?line erlang:garbage_collect(Suspendee), + ?line erlang:garbage_collect(Suspendee), + + ?line unlink(Suspendee), + ?line exit(Suspendee, bang), + ?line ok. + + +processes_term_proc_list(doc) -> + []; +processes_term_proc_list(suite) -> + []; +processes_term_proc_list(Config) when is_list(Config) -> + ?line Tester = self(), + ?line as_expected = processes_term_proc_list_test(false), + ?line {ok, Node} = start_node(Config, "+Mis true"), + ?line RT = spawn_link(Node, + fun () -> + receive after 1000 -> ok end, + processes_term_proc_list_test(false), + Tester ! {it_worked, self()} + end), + ?line receive {it_worked, RT} -> ok end, + ?line stop_node(Node), + ?line ok. + +-define(CHK_TERM_PROC_LIST(MC, XB), + chk_term_proc_list(?LINE, MC, XB)). + +chk_term_proc_list(Line, MustChk, ExpectBlks) -> + case {MustChk, instrument:memory_status(types)} of + {false, false} -> + not_enabled; + {_, MS} -> + {value, + {processes_term_proc_el, + DL}} = lists:keysearch(processes_term_proc_el, 1, MS), + case lists:keysearch(blocks, 1, DL) of + {value, {blocks, ExpectBlks, _, _}} -> + ok; + {value, {blocks, Blks, _, _}} -> + exit({line, Line, + mismatch, expected, ExpectBlks, actual, Blks}); + Unexpected -> + exit(Unexpected) + end + end, + ok. + +processes_term_proc_list_test(MustChk) -> + ?line Tester = self(), + ?line enable_internal_state(), + ?line PBInfo = erts_debug:get_internal_state(processes_bif_info), + ?line print_processes_bif_info(PBInfo), + ?line WantReds = PBInfo#processes_bif_info.min_start_reds + 10, + ?line #processes_bif_info{tab_chunks = Chunks, + tab_chunks_size = ChunksSize, + tab_indices_per_red = IndiciesPerRed + } = PBInfo, + ?line true = Chunks > 1, + ?line true = Chunks*ChunksSize >= IndiciesPerRed*WantReds, + ?line Processes = fun () -> + erts_debug:set_internal_state(reds_left, + WantReds), + processes() + end, + ?line Exit = fun (P) -> + unlink(P), + exit(P, bang), + wait_until( + fun () -> + not lists:member( + P, + erts_debug:get_internal_state( + processes)) + end) + end, + ?line SpawnSuspendProcessesProc + = fun () -> + erlang:system_flag(multi_scheduling, block), + P = spawn_link(fun () -> + Tester ! {suspend_me, self()}, + Tester ! {self(), + done, + hd(Processes())}, + receive after infinity -> ok end + end), + receive {suspend_me, P} -> ok end, + erlang:suspend_process(P), + erlang:system_flag(multi_scheduling, unblock), + [{status,suspended}, + {current_function,{erlang,processes_trap,2}}] + = process_info(P, [status, current_function]), + P + end, + ?line ResumeProcessesProc = fun (P) -> + erlang:resume_process(P), + receive {P, done, _} -> ok end + end, + ?line ?CHK_TERM_PROC_LIST(MustChk, 0), + ?line HangAround = fun () -> receive after infinity -> ok end end, + ?line HA1 = spawn_link(HangAround), + ?line HA2 = spawn_link(HangAround), + ?line HA3 = spawn_link(HangAround), + ?line S1 = SpawnSuspendProcessesProc(), + ?line ?CHK_TERM_PROC_LIST(MustChk, 1), + ?line Exit(HA1), + ?line ?CHK_TERM_PROC_LIST(MustChk, 2), + ?line S2 = SpawnSuspendProcessesProc(), + ?line ?CHK_TERM_PROC_LIST(MustChk, 3), + ?line S3 = SpawnSuspendProcessesProc(), + ?line ?CHK_TERM_PROC_LIST(MustChk, 4), + ?line Exit(HA2), + ?line ?CHK_TERM_PROC_LIST(MustChk, 5), + ?line S4 = SpawnSuspendProcessesProc(), + ?line ?CHK_TERM_PROC_LIST(MustChk, 6), + ?line Exit(HA3), + ?line ?CHK_TERM_PROC_LIST(MustChk, 7), + ?line ResumeProcessesProc(S1), + ?line ?CHK_TERM_PROC_LIST(MustChk, 5), + ?line ResumeProcessesProc(S3), + ?line ?CHK_TERM_PROC_LIST(MustChk, 4), + ?line ResumeProcessesProc(S4), + ?line ?CHK_TERM_PROC_LIST(MustChk, 3), + ?line ResumeProcessesProc(S2), + ?line ?CHK_TERM_PROC_LIST(MustChk, 0), + ?line Exit(S1), + ?line Exit(S2), + ?line Exit(S3), + ?line Exit(S4), + + + ?line HA4 = spawn_link(HangAround), + ?line HA5 = spawn_link(HangAround), + ?line HA6 = spawn_link(HangAround), + ?line S5 = SpawnSuspendProcessesProc(), + ?line ?CHK_TERM_PROC_LIST(MustChk, 1), + ?line Exit(HA4), + ?line ?CHK_TERM_PROC_LIST(MustChk, 2), + ?line S6 = SpawnSuspendProcessesProc(), + ?line ?CHK_TERM_PROC_LIST(MustChk, 3), + ?line Exit(HA5), + ?line ?CHK_TERM_PROC_LIST(MustChk, 4), + ?line S7 = SpawnSuspendProcessesProc(), + ?line ?CHK_TERM_PROC_LIST(MustChk, 5), + ?line Exit(HA6), + ?line ?CHK_TERM_PROC_LIST(MustChk, 6), + ?line S8 = SpawnSuspendProcessesProc(), + ?line ?CHK_TERM_PROC_LIST(MustChk, 7), + + ?line erlang:system_flag(multi_scheduling, block), + ?line Exit(S8), + ?line ?CHK_TERM_PROC_LIST(MustChk, 7), + ?line Exit(S5), + ?line ?CHK_TERM_PROC_LIST(MustChk, 6), + ?line Exit(S7), + ?line ?CHK_TERM_PROC_LIST(MustChk, 6), + ?line Exit(S6), + ?line ?CHK_TERM_PROC_LIST(MustChk, 0), + ?line erlang:system_flag(multi_scheduling, unblock), + ?line as_expected. + +otp_7738(doc) -> + []; +otp_7738(suite) -> + [otp_7738_waiting, otp_7738_suspended, otp_7738_resume]. + +otp_7738_waiting(doc) -> + []; +otp_7738_waiting(suite) -> + []; +otp_7738_waiting(Config) when is_list(Config) -> + ?line otp_7738_test(waiting). + +otp_7738_suspended(doc) -> + []; +otp_7738_suspended(suite) -> + []; +otp_7738_suspended(Config) when is_list(Config) -> + ?line otp_7738_test(suspended). + +otp_7738_resume(doc) -> + []; +otp_7738_resume(suite) -> + []; +otp_7738_resume(Config) when is_list(Config) -> + ?line otp_7738_test(resume). + +otp_7738_test(Type) -> + ?line T = self(), + ?line S = spawn_link(fun () -> + receive + {suspend, Suspendee} -> + erlang:suspend_process(Suspendee), + T ! {suspended, Suspendee}, + receive + after 10 -> + erlang:resume_process(Suspendee), + Suspendee ! wake_up + end; + {send, To, Msg} -> + receive after 10 -> ok end, + To ! Msg + end + end), + ?line R = spawn_link(fun () -> + X = lists:seq(1, 20000000), + T ! {initialized, self()}, + ?line case Type of + _ when Type == suspended; + Type == waiting -> + receive _ -> ok end; + _ when Type == resume -> + Receive = fun (F) -> + receive + _ -> + ok + after 0 -> + F(F) + end + end, + Receive(Receive) + end, + T ! {woke_up, self()}, + id(X) + end), + ?line receive {initialized, R} -> ok end, + ?line receive after 10 -> ok end, + ?line case Type of + suspended -> + ?line erlang:suspend_process(R), + ?line S ! {send, R, wake_up}; + waiting -> + ?line S ! {send, R, wake_up}; + resume -> + ?line S ! {suspend, R}, + ?line receive {suspended, R} -> ok end + end, + ?line erlang:garbage_collect(R), + ?line case Type of + suspended -> + ?line erlang:resume_process(R); + _ -> + ?line ok + end, + ?line receive + {woke_up, R} -> + ?line ok + after 2000 -> + ?line I = process_info(R, [status, message_queue_len]), + ?line ?t:format("~p~n", [I]), + ?line ?t:fail(no_progress) + end, + ?line ok. + +%% Internal functions + +wait_until(Fun) -> + case Fun() of + true -> true; + false -> receive after 10 -> wait_until(Fun) end + end. + +tok_loop() -> + tok_loop(hej). + +tok_loop(hej) -> + tok_loop(hopp); +tok_loop(hopp) -> + tok_loop(hej). + +id(I) -> I. + +start_node(Config) -> + start_node(Config, ""). + +start_node(Config, Args) when is_list(Config) -> + ?line Pa = filename:dirname(code:which(?MODULE)), + ?line {A, B, C} = now(), + ?line Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(?config(testcase, Config)) + ++ "-" + ++ integer_to_list(A) + ++ "-" + ++ integer_to_list(B) + ++ "-" + ++ integer_to_list(C)), + ?line ?t:start_node(Name, slave, [{args, "-pa "++Pa++" "++Args}]). + +stop_node(Node) -> + ?t:stop_node(Node). + +enable_internal_state() -> + case catch erts_debug:get_internal_state(available_internal_state) of + true -> true; + _ -> erts_debug:set_internal_state(available_internal_state, true) + end. |