%% This library is free software; you can redistribute it and/or modify
%% it under the terms of the GNU Lesser General Public License as
%% published by the Free Software Foundation; either version 2 of the
%% License, or (at your option) any later version.
%%
%% This library is distributed in the hope that it will be useful, but
%% WITHOUT ANY WARRANTY; without even the implied warranty of
%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
%% Lesser General Public License for more details.
%%
%% You should have received a copy of the GNU Lesser General Public
%% License along with this library; if not, write to the Free Software
%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
%% USA
%%
%% @author Richard Carlsson <[email protected]>
%% @copyright 2006 Richard Carlsson
%% @private
%% @see eunit
%% @doc Test runner process tree functions
-module(eunit_proc).
-include("eunit.hrl").
-include("eunit_internal.hrl").
-export([start/4]).
%% This must be exported; see new_group_leader/1 for details.
-export([group_leader_process/1]).
-record(procstate, {ref, id, super, insulator, parent, order}).
%% Spawns test process and returns the process Pid; sends {done,
%% Reference, Pid} to caller when finished. See the function
%% wait_for_task/2 for details about the need for the reference.
%%
%% The `Super' process receives a stream of status messages; see
%% message_super/3 for details.
start(Tests, Order, Super, Reference)
when is_pid(Super), is_reference(Reference) ->
St = #procstate{ref = Reference,
id = [],
super = Super,
order = Order},
spawn_group(local, #group{tests = Tests}, St).
%% Status messages sent to the supervisor process. (A supervisor does
%% not have to act on these messages - it can e.g. just log them, or
%% even discard them.) Each status message has the following form:
%%
%% {status, Id, Info}
%%
%% where Id identifies the item that the message pertains to, and the
%% Info part can be one of:
%%
%% {progress, 'begin', {test | group, Data}}
%% indicates that the item has been entered, and what type it is;
%% Data is [{desc,binary()}, {source,Source}, {line,integer()}] for
%% a test, and [{desc,binary()}, {spawn,SpawnType},
%% {order,OrderType}] for a group.
%%
%% {progress, 'end', {Status, Data}}
%% Status = 'ok' | {error, Exception} | {skipped, Cause} | integer()
%% Data = [{time,integer()}, {output,binary()}]
%%
%% where Time is measured in milliseconds and Output is the data
%% written to the standard output stream during the test; if
%% Status is {skipped, Cause}, then Cause is a term thrown from
%% eunit_test:run_testfun/1. For a group item, the Status field is
%% the number of immediate subitems of the group; this helps the
%% collation of results. Failure for groups is always signalled
%% through a cancel message, not through the Status field.
%%
%% {cancel, Descriptor}
%% where Descriptor can be:
%% timeout a timeout occurred
%% {blame, Id} forced to terminate because of item `Id'
%% {abort, Cause} the test or group failed to execute
%% {exit, Reason} the test process terminated unexpectedly
%% {startup, Reason} failed to start a remote test process
%%
%% where Cause is a term thrown from eunit_data:enter_context/4 or
%% from eunit_data:iter_next/2, and Reason is an exit term from a
%% crashed process
%%
%% Note that due to concurrent (and possibly distributed) execution,
%% there are *no* strict ordering guarantees on the status messages,
%% with one exception: a 'begin' message will always arrive before its
%% corresponding 'end' message.
message_super(Id, Info, St) ->
St#procstate.super ! {status, Id, Info}.
%% @TODO implement synchronized mode for insulator/child execution
%% Ideas for synchronized mode:
%%
%% * At each "program point", i.e., before entering a test, entering a
%% group, or leaving a group, the child will synchronize with the
%% insulator to make sure it is ok to proceed.
%%
%% * The insulator can receive controlling messages from higher up in
%% the hierarchy, telling it to pause, resume, single-step, repeat, etc.
%%
%% * Synchronization on entering/leaving groups is necessary in order to
%% get control over things such as subprocess creation/termination and
%% setup/cleanup, making it possible to, e.g., repeat all the tests
%% within a particular subprocess without terminating and restarting it,
%% or repeating tests without repeating the setup/cleanup.
%%
%% * Some tests that depend on state will not be possible to repeat, but
%% require a fresh context setup. There is nothing that can be done
%% about this, and the many tests that are repeatable should not be
%% punished because of it. The user must decide which level to restart.
%%
%% * Question: How propagate control messages down the hierarchy
%% (preferably only to the correct insulator process)? An insulator does
%% not currenctly know whether its child process has spawned subtasks.
%% (The "supervisor" process does not know the Pids of the controlling
%% insulator processes in the tree, and it probably should not be
%% responsible for this anyway.)
%% ---------------------------------------------------------------------
%% Process tree primitives
%% A "task" consists of an insulator process and a child process which
%% handles the actual work. When the child terminates, the insulator
%% process sends {done, Reference, self()} to the process which started
%% the task (the "parent"). The child process is given a State record
%% which contains the process id:s of the parent, the insulator, and the
%% supervisor.
%% @spec (Type, (#procstate{}) -> () -> term(), #procstate{}) -> pid()
%% Type = local | {remote, Node::atom()}
start_task(Type, Fun, St0) ->
St = St0#procstate{parent = self()},
%% (note: the link here is mainly to propagate signals *downwards*,
%% so that the insulator can detect if the process that started the
%% task dies before the task is done)
F = fun () -> insulator_process(Type, Fun, St) end,
case Type of
local ->
%% we assume (at least for now) that local spawns can never
%% fail in such a way that the process does not start, so a
%% new local insulator does not need to synchronize here
spawn_link(F);
{remote, Node} ->
Pid = spawn_link(Node, F),
%% See below for the need for the {ok, Reference, Pid}
%% message.
Reference = St#procstate.ref,
Monitor = erlang:monitor(process, Pid),
%% (the DOWN message is guaranteed to arrive after any
%% messages sent by the process itself)
receive
{ok, Reference, Pid} ->
Pid;
{'DOWN', Monitor, process, Pid, Reason} ->
%% send messages as if the insulator process was
%% started, but terminated on its own accord
Msg = {startup, Reason},
message_super(St#procstate.id, {cancel, Msg}, St),
self() ! {done, Reference, Pid}
end,
erlang:demonitor(Monitor, [flush]),
Pid
end.
%% Relatively simple, and hopefully failure-proof insulator process
%% (This is cleaner than temporarily setting up the caller to trap
%% signals, and does not affect the caller's mailbox or other state.)
%%
%% We assume that nobody does a 'kill' on an insulator process - if that
%% should happen, the test framework will hang since the insulator will
%% never send a reply; see below for more.
%%
%% Note that even if the insulator process itself never fails, it is
%% still possible that it does not start properly, if it is spawned
%% remotely (e.g., if the remote node is down). Therefore, remote
%% insulators must always immediately send an {ok, Reference, self()}
%% message to the parent as soon as it is spawned.
%% @spec (Type, Fun::() -> term(), St::#procstate{}) -> ok
%% Type = local | {remote, Node::atom()}
insulator_process(Type, Fun, St0) ->
process_flag(trap_exit, true),
Parent = St0#procstate.parent,
if Type =:= local -> ok;
true -> Parent ! {ok, St0#procstate.ref, self()}
end,
St = St0#procstate{insulator = self()},
Child = spawn_link(fun () -> child_process(Fun(St), St) end),
insulator_wait(Child, Parent, [], St).
%% Normally, child processes exit with the reason 'normal' even if the
%% executed tests failed (by throwing exceptions), since the tests are
%% executed within a try-block. Child processes can terminate abnormally
%% by the following reasons:
%% 1) an error in the processing of the test descriptors (a malformed
%% descriptor, failure in a setup, cleanup or initialization, a
%% missing module or function, or a failing generator function);
%% 2) an internal error in the test running framework itself;
%% 3) receiving a non-trapped error signal as a consequence of running
%% test code.
%% Those under point 1 are "expected errors", handled specially in the
%% protocol, while the other two are unexpected errors. (Since alt. 3
%% implies that the test neither reported success nor failure, it can
%% never be considered "proper" behaviour of a test.) Abnormal
%% termination is reported to the supervisor process but otherwise does
%% not affect the insulator compared to normal termination. Child
%% processes can also be killed abruptly by their insulators, in case of
%% a timeout or if a parent process dies.
%%
%% The insulator is the group leader for the child process, and gets all
%% of its standard I/O. The output is buffered and associated with the
%% currently active test or group, and is sent along with the 'end'
%% progress message when the test or group has finished.
insulator_wait(Child, Parent, Buf, St) ->
receive
{child, Child, Id, {'begin', Type, Data}} ->
message_super(Id, {progress, 'begin', {Type, Data}}, St),
insulator_wait(Child, Parent, [[] | Buf], St);
{child, Child, Id, {'end', Status, Time}} ->
Data = [{time, Time}, {output, lists:reverse(hd(Buf))}],
message_super(Id, {progress, 'end', {Status, Data}}, St),
insulator_wait(Child, Parent, tl(Buf), St);
{child, Child, Id, {skipped, Reason}} ->
%% this happens when a subgroup fails to enter the context
message_super(Id, {cancel, {abort, Reason}}, St),
insulator_wait(Child, Parent, Buf, St);
{child, Child, Id, {abort, Cause}} ->
%% this happens when the child code threw an internal
%% eunit_abort; the child process has already exited
exit_messages(Id, {abort, Cause}, St),
%% no need to wait for the {'EXIT',Child,_} message
terminate_insulator(St);
{io_request, Child, ReplyAs, Req} ->
%% we only collect output from the child process itself, not
%% from secondary processes, otherwise we get race problems;
%% however, each test runs its personal group leader that
%% funnels all output - see the run_test() function
Buf1 = io_request(Child, ReplyAs, Req, hd(Buf)),
insulator_wait(Child, Parent, [Buf1 | tl(Buf)], St);
{io_request, From, ReplyAs, Req} when is_pid(From) ->
%% (this shouldn't happen anymore, but we keep it safe)
%% just ensure the sender gets a reply; ignore the data
io_request(From, ReplyAs, Req, []),
insulator_wait(Child, Parent, Buf, St);
{timeout, Child, Id} ->
exit_messages(Id, timeout, St),
kill_task(Child, St);
{'EXIT', Child, normal} ->
terminate_insulator(St);
{'EXIT', Child, Reason} ->
exit_messages(St#procstate.id, {exit, Reason}, St),
terminate_insulator(St);
{'EXIT', Parent, _} ->
%% make sure child processes are cleaned up recursively
kill_task(Child, St)
end.
kill_task(Child, St) ->
exit(Child, kill),
terminate_insulator(St).
%% Unlinking before exit avoids polluting the parent process with exit
%% signals from the insulator. The child process is already dead here.
terminate_insulator(St) ->
%% messaging/unlinking is ok even if the parent is already dead
Parent = St#procstate.parent,
Parent ! {done, St#procstate.ref, self()},
unlink(Parent),
exit(normal).
%% send cancel messages for the Id of the "causing" item, and also for
%% the Id of the insulator itself, if they are different
exit_messages(Id, Cause, St) ->
%% the message for the most specific Id is always sent first
message_super(Id, {cancel, Cause}, St),
case St#procstate.id of
Id -> ok;
Id1 -> message_super(Id1, {cancel, {blame, Id}}, St)
end.
%% Child processes send all messages via the insulator to ensure proper
%% sequencing with timeouts and exit signals.
message_insulator(Data, St) ->
St#procstate.insulator ! {child, self(), St#procstate.id, Data}.
%% Timeout handling
set_timeout(Time, St) ->
erlang:send_after(Time, St#procstate.insulator,
{timeout, self(), St#procstate.id}).
clear_timeout(Ref) ->
erlang:cancel_timer(Ref).
with_timeout(undefined, Default, F, St) ->
with_timeout(Default, F, St);
with_timeout(Time, _Default, F, St) ->
with_timeout(Time, F, St).
with_timeout(infinity, F, _St) ->
%% don't start timers unnecessarily
{T0, _} = statistics(wall_clock),
Value = F(),
{T1, _} = statistics(wall_clock),
{Value, T1 - T0};
with_timeout(Time, F, St) when is_integer(Time), Time > 16#FFFFffff ->
with_timeout(16#FFFFffff, F, St);
with_timeout(Time, F, St) when is_integer(Time), Time < 0 ->
with_timeout(0, F, St);
with_timeout(Time, F, St) when is_integer(Time) ->
Ref = set_timeout(Time, St),
{T0, _} = statistics(wall_clock),
try F() of
Value ->
%% we could also read the timer, but this is simpler
{T1, _} = statistics(wall_clock),
{Value, T1 - T0}
after
clear_timeout(Ref)
end.
%% The normal behaviour of a child process is not to trap exit
%% signals. The testing framework is not dependent on this, however, so
%% the test code is allowed to enable signal trapping as it pleases.
%% Note that I/O is redirected to the insulator process.
%% @spec (() -> term(), #procstate{}) -> ok
child_process(Fun, St) ->
group_leader(St#procstate.insulator, self()),
try Fun() of
_ -> ok
catch
%% the only "normal" way for a child process to bail out (e.g,
%% when not being able to parse the test descriptor) is to throw
%% an {eunit_abort, Reason} exception; any other exception will
%% be reported as an unexpected termination of the test
{eunit_abort, Cause} ->
message_insulator({abort, Cause}, St),
exit(aborted)
end.
-ifdef(TEST).
child_test_() ->
[{"test processes do not trap exit signals",
?_assertMatch(false, process_flag(trap_exit, false))}].
-endif.
%% @throws abortException()
%% @type abortException() = {eunit_abort, Cause::term()}
abort_task(Cause) ->
throw({eunit_abort, Cause}).
%% Typically, the process that executes this code is not trapping
%% signals, but it might be - it is outside of our control, since test
%% code can enable or disable trapping at will. That we cannot rely on
%% process links here, is why the insulator process of a task must be
%% guaranteed to always send a reply before it terminates.
%%
%% The unique reference guarantees that we don't extract any message
%% from the mailbox unless it belongs to the test framework (and not to
%% the running tests) - it is not possible to use selective receive to
%% match only messages that are tagged with some pid out of a
%% dynamically varying set of pids. When the wait-loop terminates, no
%% such message should remain in the mailbox.
wait_for_task(Pid, St) ->
wait_for_tasks(sets:from_list([Pid]), St).
wait_for_tasks(PidSet, St) ->
case sets:size(PidSet) of
0 ->
ok;
_ ->
%% (note that when we receive this message for some task, we
%% are guaranteed that the insulator process of the task has
%% already informed the supervisor about any anomalies)
Reference = St#procstate.ref,
receive
{done, Reference, Pid} ->
%% (if Pid is not in the set, del_element has no
%% effect, so this is always safe)
Rest = sets:del_element(Pid, PidSet),
wait_for_tasks(Rest, St)
end
end.
%% ---------------------------------------------------------------------
%% Separate testing process
%% TODO: Ability to stop after N failures.
%% TODO: Flow control, starting new job as soon as slot is available
tests(T, St) ->
I = eunit_data:iter_init(T, St#procstate.id),
case St#procstate.order of
inorder -> tests_inorder(I, St);
inparallel -> tests_inparallel(I, 0, St);
{inparallel, N} when is_integer(N), N >= 0 ->
tests_inparallel(I, N, St)
end.
set_id(I, St) ->
St#procstate{id = eunit_data:iter_id(I)}.
tests_inorder(I, St) ->
tests_inorder(I, 0, St).
tests_inorder(I, N, St) ->
case get_next_item(I) of
{T, I1} ->
handle_item(T, set_id(I1, St)),
tests_inorder(I1, N+1, St);
none ->
N % the return status of a group is the subtest count
end.
tests_inparallel(I, K0, St) ->
tests_inparallel(I, 0, St, K0, K0, sets:new()).
tests_inparallel(I, N, St, K, K0, Children) when K =< 0, K0 > 0 ->
wait_for_tasks(Children, St),
tests_inparallel(I, N, St, K0, K0, sets:new());
tests_inparallel(I, N, St, K, K0, Children) ->
case get_next_item(I) of
{T, I1} ->
Child = spawn_item(T, set_id(I1, St)),
tests_inparallel(I1, N+1, St, K - 1, K0,
sets:add_element(Child, Children));
none ->
wait_for_tasks(Children, St),
N % the return status of a group is the subtest count
end.
%% this starts a new separate task for an inparallel-item (which might
%% be a group and in that case might cause yet another spawn in the
%% handle_group() function, but it might also be just a single test)
spawn_item(T, St0) ->
Fun = fun (St) ->
fun () -> handle_item(T, St) end
end,
%% inparallel-items are always spawned locally
start_task(local, Fun, St0).
get_next_item(I) ->
try eunit_data:iter_next(I)
catch
Term -> abort_task(Term)
end.
handle_item(T, St) ->
case T of
#test{} -> handle_test(T, St);
#group{} -> handle_group(T, St)
end.
handle_test(T, St) ->
Data = [{desc, T#test.desc}, {source, T#test.location},
{line, T#test.line}],
message_insulator({'begin', test, Data}, St),
%% each test case runs under a fresh group leader process
G0 = group_leader(),
Runner = self(),
G1 = new_group_leader(Runner),
group_leader(G1, self()),
%% run the actual test, handling timeouts and getting the total run
%% time of the test code (and nothing else)
{Status, Time} = with_timeout(T#test.timeout, ?DEFAULT_TEST_TIMEOUT,
fun () -> run_test(T) end, St),
%% restore group leader, get the collected output, and re-emit it so
%% that it all seems to come from this process, and always comes
%% before the 'end' message for this test
group_leader(G0, self()),
Output = group_leader_sync(G1),
io:put_chars(Output),
message_insulator({'end', Status, Time}, St),
ok.
%% @spec (#test{}) -> ok | {error, eunit_lib:exception()}
%% | {skipped, eunit_test:wrapperError()}
run_test(#test{f = F}) ->
try eunit_test:run_testfun(F) of
{ok, _Value} ->
%% just discard the return value
ok;
{error, Exception} ->
{error, Exception}
catch
throw:WrapperError -> {skipped, WrapperError}
end.
set_group_order(#group{order = undefined}, St) ->
St;
set_group_order(#group{order = Order}, St) ->
St#procstate{order = Order}.
handle_group(T, St0) ->
St = set_group_order(T, St0),
case T#group.spawn of
undefined ->
run_group(T, St);
Type ->
Child = spawn_group(Type, T, St),
wait_for_task(Child, St)
end.
spawn_group(Type, T, St0) ->
Fun = fun (St) ->
fun () -> run_group(T, St) end
end,
start_task(Type, Fun, St0).
run_group(T, St) ->
%% note that the setup/cleanup is outside the group timeout; if the
%% setup fails, we do not start any timers
Timeout = T#group.timeout,
Data = [{desc, T#group.desc}, {spawn, T#group.spawn},
{order, T#group.order}],
message_insulator({'begin', group, Data}, St),
F = fun (G) -> enter_group(G, Timeout, St) end,
try with_context(T, F) of
{Status, Time} ->
message_insulator({'end', Status, Time}, St)
catch
%% a throw here can come from eunit_data:enter_context/4 or from
%% get_next_item/1; for context errors, report group as aborted,
%% but continue processing tests
{context_error, Why, Trace} ->
message_insulator({skipped, {Why, Trace}}, St)
end,
ok.
enter_group(T, Timeout, St) ->
with_timeout(Timeout, ?DEFAULT_GROUP_TIMEOUT,
fun () -> tests(T, St) end, St).
with_context(#group{context = undefined, tests = T}, F) ->
F(T);
with_context(#group{context = #context{} = C, tests = I}, F) ->
eunit_data:enter_context(C, I, F).
%% Group leader process for test cases - collects I/O output requests.
new_group_leader(Runner) ->
%% We must use spawn/3 here (with explicit module and function
%% name), because the 'current function' status of the group leader
%% is used by the UNDER_EUNIT macro (in eunit.hrl). If we spawn
%% using a fun, the current function will be 'erlang:apply/2' during
%% early process startup, which will fool the macro.
spawn_link(?MODULE, group_leader_process, [Runner]).
group_leader_process(Runner) ->
group_leader_loop(Runner, infinity, []).
group_leader_loop(Runner, Wait, Buf) ->
receive
{io_request, From, ReplyAs, Req} ->
P = process_flag(priority, normal),
%% run this part under normal priority always
Buf1 = io_request(From, ReplyAs, Req, Buf),
process_flag(priority, P),
group_leader_loop(Runner, Wait, Buf1);
stop ->
%% quitting time: make a minimal pause, go low on priority,
%% set receive-timeout to zero and schedule out again
receive after 2 -> ok end,
process_flag(priority, low),
group_leader_loop(Runner, 0, Buf);
_ ->
%% discard any other messages
group_leader_loop(Runner, Wait, Buf)
after Wait ->
%% no more messages and nothing to wait for; we ought to
%% have collected all immediately pending output now
process_flag(priority, normal),
Runner ! {self(), lists:reverse(Buf)}
end.
group_leader_sync(G) ->
G ! stop,
receive
{G, Buf} -> Buf
end.
%% Implementation of buffering I/O for group leader processes. (Note that
%% each batch of characters is just pushed on the buffer, so it needs to
%% be reversed when it is flushed.)
io_request(From, ReplyAs, Req, Buf) ->
{Reply, Buf1} = io_request(Req, Buf),
io_reply(From, ReplyAs, Reply),
Buf1.
io_reply(From, ReplyAs, Reply) ->
From ! {io_reply, ReplyAs, Reply}.
io_request({put_chars, Chars}, Buf) ->
{ok, [Chars | Buf]};
io_request({put_chars, M, F, As}, Buf) ->
try apply(M, F, As) of
Chars -> {ok, [Chars | Buf]}
catch
C:T -> {{error, {C,T,erlang:get_stacktrace()}}, Buf}
end;
io_request({put_chars, _Enc, Chars}, Buf) ->
io_request({put_chars, Chars}, Buf);
io_request({put_chars, _Enc, Mod, Func, Args}, Buf) ->
io_request({put_chars, Mod, Func, Args}, Buf);
io_request({get_chars, _Enc, _Prompt, _N}, Buf) ->
{eof, Buf};
io_request({get_chars, _Prompt, _N}, Buf) ->
{eof, Buf};
io_request({get_line, _Prompt}, Buf) ->
{eof, Buf};
io_request({get_line, _Enc, _Prompt}, Buf) ->
{eof, Buf};
io_request({get_until, _Prompt, _M, _F, _As}, Buf) ->
{eof, Buf};
io_request({setopts, _Opts}, Buf) ->
{ok, Buf};
io_request(getopts, Buf) ->
{{error, enotsup}, Buf};
io_request({get_geometry,columns}, Buf) ->
{{error, enotsup}, Buf};
io_request({get_geometry,rows}, Buf) ->
{{error, enotsup}, Buf};
io_request({requests, Reqs}, Buf) ->
io_requests(Reqs, {ok, Buf});
io_request(_, Buf) ->
{{error, request}, Buf}.
io_requests([R | Rs], {ok, Buf}) ->
io_requests(Rs, io_request(R, Buf));
io_requests(_, Result) ->
Result.
-ifdef(TEST).
io_error_test_() ->
[?_assertMatch({error, enotsup}, io:getopts()),
?_assertMatch({error, enotsup}, io:columns()),
?_assertMatch({error, enotsup}, io:rows())].
-endif.
