%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 1997-2011. 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_lib("test_server/include/test_server.hrl").
-define(heap_binary_size, 64).
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2, spawn_with_binaries/1,
t_exit_1/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, process_flag_heap_size/1,
spawn_opt_heap_size/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,
otp_7738_waiting/1, otp_7738_suspended/1,
otp_7738_resume/1]).
-export([prio_server/2, prio_client/2]).
-export([init_per_testcase/2, end_per_testcase/2]).
-export([hangaround/2, processes_bif_test/0, do_processes/1,
processes_term_proc_list_test/1]).
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
[spawn_with_binaries, t_exit_1, {group, 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, process_flag_heap_size,
spawn_opt_heap_size, otp_6237, {group, processes_bif},
{group, otp_7738}].
groups() ->
[{t_exit_2, [],
[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]},
{processes_bif, [],
[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]},
{otp_7738, [],
[otp_7738_waiting, otp_7738_suspended,
otp_7738_resume]}].
init_per_suite(Config) ->
Config.
end_per_suite(Config) ->
catch erts_debug:set_internal_state(available_internal_state, false),
Config.
init_per_group(_GroupName, Config) ->
Config.
end_per_group(_GroupName, Config) ->
Config.
init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
Dog=?t:timetrap(?t:minutes(10)),
[{watchdog, Dog},{testcase, Func}|Config].
end_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
Dog=?config(watchdog, Config),
?t:timetrap_cancel(Dog).
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.
%% 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 {min_heap_size, 233} = process_info(self(), min_heap_size),
?line {min_bin_vheap_size, 46368} = process_info(self(), min_bin_vheap_size),
?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 {min_heap_size, 233} = process_info(Pid, min_heap_size),
?line {min_bin_vheap_size, 46368} = process_info(Pid, min_bin_vheap_size),
?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(min_bin_vheap_size, gurka) end),
?line chk_badarg(fun () -> process_flag(min_bin_vheap_size, -1) 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().
-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.
process_flag_heap_size(doc) ->
[];
process_flag_heap_size(suite) ->
[];
process_flag_heap_size(Config) when is_list(Config) ->
HSize = 2584, % must be gc fib number
VHSize = 317811, % must be gc fib number
?line OldHmin = erlang:process_flag(min_heap_size, HSize),
?line {min_heap_size, HSize} = erlang:process_info(self(), min_heap_size),
?line OldVHmin = erlang:process_flag(min_bin_vheap_size, VHSize),
?line {min_bin_vheap_size, VHSize} = erlang:process_info(self(), min_bin_vheap_size),
?line HSize = erlang:process_flag(min_heap_size, OldHmin),
?line VHSize = erlang:process_flag(min_bin_vheap_size, OldVHmin),
?line ok.
spawn_opt_heap_size(doc) ->
[];
spawn_opt_heap_size(suite) ->
[];
spawn_opt_heap_size(Config) when is_list(Config) ->
HSize = 987, % must be gc fib number
VHSize = 46368, % must be gc fib number
?line Pid = spawn_opt(fun () -> receive stop -> ok end end,
[{min_heap_size, HSize},{ min_bin_vheap_size, VHSize}]),
?line {min_heap_size, HSize} = process_info(Pid, min_heap_size),
?line {min_bin_vheap_size, VHSize} = process_info(Pid, min_bin_vheap_size),
?line Pid ! stop,
?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_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.
