aboutsummaryrefslogtreecommitdiffstats
path: root/lib/eunit/src/eunit_proc.erl
diff options
context:
space:
mode:
authorErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
committerErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
commit84adefa331c4159d432d22840663c38f155cd4c1 (patch)
treebff9a9c66adda4df2106dfd0e5c053ab182a12bd /lib/eunit/src/eunit_proc.erl
downloadotp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz
otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2
otp-84adefa331c4159d432d22840663c38f155cd4c1.zip
The R13B03 release.OTP_R13B03
Diffstat (limited to 'lib/eunit/src/eunit_proc.erl')
-rw-r--r--lib/eunit/src/eunit_proc.erl661
1 files changed, 661 insertions, 0 deletions
diff --git a/lib/eunit/src/eunit_proc.erl b/lib/eunit/src/eunit_proc.erl
new file mode 100644
index 0000000000..e2d51d8bd5
--- /dev/null
+++ b/lib/eunit/src/eunit_proc.erl
@@ -0,0 +1,661 @@
+%% 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
+%%
+%% $Id$
+%%
+%% @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, buffer_to_binary(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).
+
+buffer_to_binary([B]) when is_binary(B) -> B; % avoid unnecessary copying
+buffer_to_binary(Buf) -> list_to_binary(lists:reverse(Buf)).
+
+%% 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(), buffer_to_binary(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, {error, enotsup}, Buf};
+io_request({get_geometry,columns}, Buf) ->
+ {error, {error, enotsup}, Buf};
+io_request({get_geometry,rows}, Buf) ->
+ {error, {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.