aboutsummaryrefslogtreecommitdiffstats
path: root/lib/test_server/src/test_server_io.erl
diff options
context:
space:
mode:
authorBjörn Gustavsson <[email protected]>2012-09-20 17:12:49 +0200
committerBjörn Gustavsson <[email protected]>2012-10-23 15:45:57 +0200
commit320d1332594e1211ccee8167589030b31bccc3aa (patch)
tree1343a7ba1f684a49901cba8d6ae951ff377dd978 /lib/test_server/src/test_server_io.erl
parentc1f2ce70f44edfb1603ec902fa75a2157cac0651 (diff)
downloadotp-320d1332594e1211ccee8167589030b31bccc3aa.tar.gz
otp-320d1332594e1211ccee8167589030b31bccc3aa.tar.bz2
otp-320d1332594e1211ccee8167589030b31bccc3aa.zip
Introduce test_server_io and test_server_gl
Diffstat (limited to 'lib/test_server/src/test_server_io.erl')
-rw-r--r--lib/test_server/src/test_server_io.erl315
1 files changed, 315 insertions, 0 deletions
diff --git a/lib/test_server/src/test_server_io.erl b/lib/test_server/src/test_server_io.erl
new file mode 100644
index 0000000000..abdfb71241
--- /dev/null
+++ b/lib/test_server/src/test_server_io.erl
@@ -0,0 +1,315 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2012. 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%
+%%
+%% This module implements a process with the registered name 'test_server_io',
+%% which has two main responsibilities:
+%%
+%% * Manage group leader processes (see the test_server_gl module)
+%% for test cases. A group_leader process is obtained by calling
+%% get_gl/1. Group leader processes will be kept alive as along as
+%% the 'test_server_io' process is alive.
+%%
+%% * Handle output to the common log files (stdout, major, html,
+%% unexpected_io).
+%%
+
+-module(test_server_io).
+-export([start_link/0,stop/0,get_gl/1,set_fd/2,
+ start_transaction/0,end_transaction/0,print_buffered/1,print/3,
+ set_footer/1,set_job_name/1,set_gl_props/1]).
+
+-export([init/1,handle_call/3,handle_info/2,terminate/2]).
+
+-record(st, {fds, %Singleton fds (gb_tree)
+ shared_gl :: pid(), %Shared group leader
+ gls, %Group leaders (gb_set)
+ io_buffering=false, %I/O buffering
+ buffered, %Buffered I/O requests
+ html_footer, %HTML footer
+ job_name, %Name of current job.
+ gl_props, %Properties for GL.
+ stopping
+ }).
+
+start_link() ->
+ case gen_server:start_link({local,?MODULE}, ?MODULE, [], []) of
+ {ok,Pid} ->
+ {ok,Pid};
+ Other ->
+ Other
+ end.
+
+stop() ->
+ OldGL = group_leader(),
+ group_leader(self(), self()),
+ req(stop),
+ group_leader(OldGL, self()),
+ ok.
+
+%% get_gl(Shared) -> Pid
+%% Shared = boolean()
+%% Pid = pid()
+%%
+%% Return a group leader (a process using the test_server_gl module).
+%% If Shared is true, the shared group leader is returned (suitable for
+%% running sequential test cases), otherwise a new group leader process
+%% is spawned. Group leader processes will live until they are garbaged
+%% collected by a call to gc/0.
+
+get_gl(Shared) when is_boolean(Shared) ->
+ req({get_gl,Shared}).
+
+%% set_fd(Tag, Fd) -> ok.
+%% Tag = major | html | unexpected_io
+%% Fd = a file descriptor (as returned by file:open/2)
+%%
+%% Associate a file descriptor with the given Tag. This
+%% Tag can later be used in when calling to print/3.
+
+set_fd(Tag, Fd) ->
+ req({set_fd,Tag,Fd}).
+
+%% start_transaction()
+%%
+%% Subsequent calls to print/3 from the process executing start_transaction/0
+%% will cause the messages to be buffered instead of printed directly.
+
+start_transaction() ->
+ req({start_transaction,self()}).
+
+%% end_transaction()
+%%
+%% End the transaction started by start_transaction/0. Subsequent calls to
+%% print/3 will cause the message to be printed directory.
+
+end_transaction() ->
+ req({end_transaction,self()}).
+
+%% print(From, Tag, Msg)
+%% From = pid()
+%% Tag = stdout, or any tag that has been registered using set_fd/2
+%% Msg = string or iolist
+%%
+%% Either print Msg to the file identified by Tag, or buffer the message
+%% start_transaction/0 has been called from the process From.
+%%
+%% NOTE: The tags have various special meanings. For example, 'html'
+%% is assumed to be a HTML file.
+
+print(From, Tag, Msg) ->
+ req({print,From,Tag,Msg}).
+
+%% print_buffered(Pid)
+%% Pid = pid()
+%%
+%% Print all messages buffered in the *first* transaction buffered for Pid.
+%% (If start_transaction/0 and end_transaction/0 has been called N times,
+%% print_buffered/1 must be called N times to print all transactions.)
+
+print_buffered(Pid) ->
+ req({print_buffered,Pid}).
+
+%% set_footer(IoData)
+%%
+%% Set a footer for the file associated with the 'html' tag.
+%% It will be used by print/3 to print a footer for the HTML file.
+
+set_footer(Footer) ->
+ req({set_footer,Footer}).
+
+%% set_job_name(Name)
+%% Set a name for the currently running job. The name will be used
+%% when printing to 'stdout'.
+%%
+set_job_name(Name) ->
+ req({set_job_name,Name}).
+
+%% set_gl_props(PropList)
+%% Set properties for group leader processes. When a group_leader process
+%% is created, test_server_gl:set_props(PropList) will be called.
+
+set_gl_props(PropList) ->
+ req({set_gl_props,PropList}).
+
+
+%%% Internal functions.
+
+init([]) ->
+ process_flag(trap_exit, true),
+ Empty = gb_trees:empty(),
+ {ok,Shared} = test_server_gl:start_link(),
+ {ok,#st{fds=Empty,shared_gl=Shared,gls=gb_sets:empty(),
+ io_buffering=gb_sets:empty(),
+ buffered=Empty,
+ html_footer="</body>\n</html>\n",
+ job_name="<name not set>",
+ gl_props=[]}}.
+
+req(Req) ->
+ gen_server:call(?MODULE, Req, infinity).
+
+handle_call({get_gl,false}, _From, #st{gls=Gls,gl_props=Props}=St) ->
+ {ok,Pid} = test_server_gl:start_link(),
+ test_server_gl:set_props(Pid, Props),
+ {reply,Pid,St#st{gls=gb_sets:insert(Pid, Gls)}};
+handle_call({get_gl,true}, _From, #st{shared_gl=Shared}=St) ->
+ {reply,Shared,St};
+handle_call({set_fd,Tag,Fd}, _From, #st{fds=Fds0}=St) ->
+ Fds = gb_trees:enter(Tag, Fd, Fds0),
+ {reply,ok,St#st{fds=Fds}};
+handle_call({start_transaction,Pid}, _From, #st{io_buffering=Buffer0,
+ buffered=Buf0}=St) ->
+ Buf = case gb_trees:is_defined(Pid, Buf0) of
+ false -> gb_trees:insert(Pid, queue:new(), Buf0);
+ true -> Buf0
+ end,
+ Buffer = gb_sets:add(Pid, Buffer0),
+ {reply,ok,St#st{io_buffering=Buffer,buffered=Buf}};
+handle_call({print,From,Tag,Str}, _From, St0) ->
+ St = output(From, Tag, Str, St0),
+ {reply,ok,St};
+handle_call({end_transaction,Pid}, _From, #st{io_buffering=Buffer0,
+ buffered=Buffered0}=St0) ->
+ Q0 = gb_trees:get(Pid, Buffered0),
+ Q = queue:in(eot, Q0),
+ Buffered = gb_trees:update(Pid, Q, Buffered0),
+ Buffer = gb_sets:delete_any(Pid, Buffer0),
+ St = St0#st{io_buffering=Buffer,buffered=Buffered},
+ {reply,ok,St};
+handle_call({print_buffered,Pid}, _From, #st{buffered=Buffered0}=St0) ->
+ Q0 = gb_trees:get(Pid, Buffered0),
+ Q = do_print_buffered(Q0, St0),
+ Buffered = gb_trees:update(Pid, Q, Buffered0),
+ St = St0#st{buffered=Buffered},
+ {reply,ok,St};
+handle_call({set_footer,Footer}, _From, St) ->
+ {reply,ok,St#st{html_footer=Footer}};
+handle_call({set_job_name,Name}, _From, St) ->
+ {reply,ok,St#st{job_name=Name}};
+handle_call({set_gl_props,Props}, _From, #st{shared_gl=Shared}=St) ->
+ test_server_gl:set_props(Shared, Props),
+ {reply,ok,St#st{gl_props=Props}};
+handle_call(stop, From, #st{shared_gl=SGL,gls=Gls0}=St0) ->
+ St = St0#st{gls=gb_sets:insert(SGL, Gls0),stopping=From},
+ gc(St),
+ %% Give the users of the surviving group leaders some
+ %% time to finish.
+ erlang:send_after(2000, self(), stop_group_leaders),
+ {noreply,St}.
+
+handle_info({'EXIT',Pid,normal}, #st{gls=Gls0,stopping=From}=St) ->
+ Gls = gb_sets:delete_any(Pid, Gls0),
+ case gb_sets:is_empty(Gls) andalso stopping =/= undefined of
+ true ->
+ %% No more group leaders left.
+ gen_server:reply(From, ok),
+ {stop,normal,St#st{gls=Gls,stopping=undefined}};
+ false ->
+ %% Wait for more group leaders to finish.
+ {noreply,St#st{gls=Gls}}
+ end;
+handle_info({'EXIT',_Pid,Reason}, _St) ->
+ exit(Reason);
+handle_info(stop_group_leaders, #st{gls=Gls}=St) ->
+ %% Stop the remaining group leaders.
+ [test_server_gl:stop(GL) || GL <- gb_sets:to_list(Gls)],
+ erlang:send_after(2000, self(), kill_group_leaders),
+ {noreply,St};
+handle_info(kill_group_leaders, #st{gls=Gls,stopping=From}=St) ->
+ [exit(GL, kill) || GL <- gb_sets:to_list(Gls)],
+ gen_server:reply(From, ok),
+ {stop,normal,St};
+handle_info(Other, St) ->
+ io:format("Ignoring: ~p\n", [Other]),
+ {noreply,St}.
+
+terminate(_, _) ->
+ ok.
+
+output(From, Tag, Str, #st{io_buffering=Buffered,buffered=Buf0}=St) ->
+ case gb_sets:is_member(From, Buffered) of
+ false ->
+ do_output(Tag, Str, St),
+ St;
+ true ->
+ Q0 = gb_trees:get(From, Buf0),
+ Q = queue:in({Tag,Str}, Q0),
+ Buf = gb_trees:update(From, Q, Buf0),
+ St#st{buffered=Buf}
+ end.
+
+do_output(stdout, Str0, #st{job_name=Name}) ->
+ Str = io_lib:format("Testing ~s: ~s\n", [Name,Str0]),
+ io:put_chars(Str);
+do_output(Tag, Str, #st{fds=Fds}=St) ->
+ case gb_trees:lookup(Tag, Fds) of
+ none ->
+ S = io_lib:format("\n*** ERROR: ~p, line ~p: No known '~p' log file\n",
+ [?MODULE,?LINE,Tag]),
+ do_output(stdout, [S,Str], St);
+ {value,Fd} ->
+ try
+ io:put_chars(Fd, Str),
+ case Tag of
+ html -> finalise_table(Fd, St);
+ _ -> ok
+ end
+ catch _:Error ->
+ S = io_lib:format("\n*** ERROR: ~p, line ~p: Error writing to "
+ "log file '~p': ~p\n",
+ [?MODULE,?LINE,Tag,Error]),
+ do_output(stdout, [S,Str], St)
+ end
+ end.
+
+finalise_table(Fd, #st{html_footer=Footer}) ->
+ case file:position(Fd, {cur,0}) of
+ {ok,Pos} ->
+ %% We are writing to a seekable file. Finalise so
+ %% we get complete valid (and viewable) HTML code.
+ %% Then rewind to overwrite the finalising code.
+ io:put_chars(Fd, ["\n</table>\n",Footer]),
+ file:position(Fd, Pos);
+ {error,epipe} ->
+ %% The file is not seekable. We cannot erase what
+ %% we've already written --- so the reader will
+ %% have to wait until we're done.
+ ok
+ end.
+
+do_print_buffered(Q0, St) ->
+ Item = queue:get(Q0),
+ Q = queue:drop(Q0),
+ case Item of
+ eot ->
+ Q;
+ {Tag,Str} ->
+ do_output(Tag, Str, St),
+ do_print_buffered(Q, St)
+ end.
+
+gc(#st{gls=Gls0}) ->
+ InUse0 = [begin
+ {group_leader,GL} = process_info(P, group_leader),
+ GL
+ end || P <- processes()],
+ InUse = ordsets:from_list(InUse0),
+ Gls = gb_sets:to_list(Gls0),
+ NotUsed = ordsets:subtract(Gls, InUse),
+ [test_server_gl:stop(Pid) || Pid <- NotUsed],
+ ok.