%% 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: eunit_server.erl 267 2008-10-19 18:48:03Z rcarlsson $
%%
%% @author Richard Carlsson <[email protected]>
%% @copyright 2006 Richard Carlsson
%% @private
%% @see eunit
%% @doc EUnit server process
-module(eunit_server).
-export([start/1, stop/1, start_test/4, watch/3, watch_path/3,
watch_regexp/3]).
-export([main/1]). % private
-include("eunit.hrl").
-include("eunit_internal.hrl").
-define(AUTO_TIMEOUT, 60000). %% auto test time limit
%% TODO: pass options to server, such as default timeout?
start(Server) when is_atom(Server) ->
ensure_started(Server).
stop(Server) ->
command(Server, stop).
-record(job, {super, test, options}).
%% The `Super' process will receive a stream of status messages; see
%% eunit_proc:status_message/3 for details.
start_test(Server, Super, T, Options) ->
command(Server, {start, #job{super = Super,
test = T,
options = Options}}).
watch(Server, Module, Opts) when is_atom(Module) ->
command(Server, {watch, {module, Module}, Opts}).
watch_path(Server, Path, Opts) ->
command(Server, {watch, {path, filename:flatten(Path)}, Opts}).
%% note that the user must use $ at the end to match whole paths only
watch_regexp(Server, Regex, Opts) ->
case re:compile(Regex,[anchored]) of
{ok, R} ->
command(Server, {watch, {regexp, R}, Opts});
{error, _}=Error ->
Error
end.
%% This makes sure the server is started before sending the command, and
%% returns {ok, Result} if the server accepted the command or {error,
%% server_down} if the server process crashes. If the server does not
%% reply, this function will wait until the server is killed.
command(Server, Cmd) ->
if is_atom(Server), Cmd /= stop -> ensure_started(Server);
true -> ok
end,
if is_pid(Server) -> command_1(Server, Cmd);
true ->
case whereis(Server) of
undefined -> {error, server_down};
Pid -> command_1(Pid, Cmd)
end
end.
command_1(Pid, Cmd) when is_pid(Pid) ->
Pid ! {command, self(), Cmd},
command_wait(Pid, 1000, undefined).
command_wait(Pid, Timeout, Monitor) ->
receive
{Pid, Result} -> Result;
{'DOWN', Monitor, process, Pid, _R} -> {error, server_down}
after Timeout ->
%% avoid creating a monitor unless some time has passed
command_wait(Pid, infinity, erlang:monitor(process, Pid))
end.
%% Starting the server
ensure_started(Name) ->
ensure_started(Name, 5).
ensure_started(Name, N) when N > 0 ->
case whereis(Name) of
undefined ->
Parent = self(),
Pid = spawn(fun () -> server_start(Name, Parent) end),
receive
{Pid, ok} ->
Pid;
{Pid, error} ->
receive after 200 -> ensure_started(Name, N - 1) end
end;
Pid ->
Pid
end;
ensure_started(_, _) ->
throw(no_server).
server_start(undefined = Name, Parent) ->
%% anonymous server
server_start_1(Name, Parent);
server_start(Name, Parent) ->
try register(Name, self()) of
true -> server_start_1(Name, Parent)
catch
_:_ ->
Parent ! {self(), error},
exit(error)
end.
server_start_1(Name, Parent) ->
Parent ! {self(), ok},
server_init(Name).
-record(state, {name,
stopped,
jobs,
queue,
auto_test,
modules,
paths,
regexps}).
server_init(Name) ->
server(#state{name = Name,
stopped = false,
jobs = dict:new(),
queue = queue:new(),
auto_test = queue:new(),
modules = sets:new(),
paths = sets:new(),
regexps = sets:new()}).
server(St) ->
server_check_exit(St),
?MODULE:main(St).
%% @private
main(St) ->
receive
{done, auto_test, _Pid} ->
server(auto_test_done(St));
{done, Reference, _Pid} ->
server(handle_done(Reference, St));
{command, From, _Cmd} when St#state.stopped ->
From ! {self(), stopped};
{command, From, Cmd} ->
server_command(From, Cmd, St);
{code_monitor, {loaded, M, _Time}} ->
case is_watched(M, St) of
true ->
server(new_auto_test(self(), M, St));
false ->
server(St)
end
end.
server_check_exit(St) ->
case dict:size(St#state.jobs) of
0 when St#state.stopped -> exit(normal);
_ -> ok
end.
server_command(From, {start, Job}, St) ->
Reference = make_ref(),
St1 = case proplists:get_bool(enqueue, Job#job.options) of
true ->
enqueue(Job, From, Reference, St);
false ->
start_job(Job, From, Reference, St)
end,
server_command_reply(From, {ok, Reference}),
server(St1);
server_command(From, stop, St) ->
%% unregister the server name and let remaining jobs finish
server_command_reply(From, {error, stopped}),
catch unregister(St#state.name),
server(St#state{stopped = true});
server_command(From, {watch, Target, _Opts}, St) ->
%% the code watcher is only started on demand
%% FIXME: this is disabled for now in the OTP distribution
%%code_monitor:monitor(self()),
%% TODO: propagate options to testing stage
St1 = add_watch(Target, St),
server_command_reply(From, ok),
server(St1);
server_command(From, {forget, Target}, St) ->
St1 = delete_watch(Target, St),
server_command_reply(From, ok),
server(St1);
server_command(From, Cmd, St) ->
server_command_reply(From, {error, {unknown_command, Cmd}}),
server(St).
server_command_reply(From, Result) ->
From ! {self(), Result}.
enqueue(Job, From, Reference, St) ->
case dict:size(St#state.jobs) of
0 ->
start_job(Job, From, Reference, St);
_ ->
St#state{queue = queue:in({Job, From, Reference},
St#state.queue)}
end.
dequeue(St) ->
case queue:out(St#state.queue) of
{empty, _} ->
St;
{{value, {Job, From, Reference}}, Queue} ->
start_job(Job, From, Reference, St#state{queue = Queue})
end.
start_job(Job, From, Reference, St) ->
From ! {start, Reference},
%% The default is to run tests in order unless otherwise specified
Order = proplists:get_value(order, Job#job.options, inorder),
eunit_proc:start(Job#job.test, Order, Job#job.super, Reference),
St#state{jobs = dict:store(Reference, From, St#state.jobs)}.
handle_done(Reference, St) ->
case dict:find(Reference, St#state.jobs) of
{ok, From} ->
From ! {done, Reference},
dequeue(St#state{jobs = dict:erase(Reference,
St#state.jobs)});
error ->
St
end.
%% Adding and removing watched modules or paths
add_watch({module, M}, St) ->
St#state{modules = sets:add_element(M, St#state.modules)};
add_watch({path, P}, St) ->
St#state{paths = sets:add_element(P, St#state.paths)};
add_watch({regexp, R}, St) ->
St#state{regexps = sets:add_element(R, St#state.regexps)}.
delete_watch({module, M}, St) ->
St#state{modules = sets:del_element(M, St#state.modules)};
delete_watch({path, P}, St) ->
St#state{paths = sets:del_element(P, St#state.paths)};
delete_watch({regexp, R}, St) ->
St#state{regexps = sets:del_element(R, St#state.regexps)}.
%% Checking if a module is being watched
is_watched(M, St) when is_atom(M) ->
sets:is_element(M, St#state.modules) orelse
is_watched(code:which(M), St);
is_watched(Path, St) ->
sets:is_element(filename:dirname(Path), St#state.paths) orelse
match_any(sets:to_list(St#state.regexps), Path).
match_any([R | Rs], Str) ->
case re:run(Str, R, [{capture,none}]) of
match -> true;
_ -> match_any(Rs, Str)
end;
match_any([], _Str) -> false.
%% Running automatic tests when a watched module is loaded.
%% Uses a queue in order to avoid overlapping output when several
%% watched modules are loaded simultaneously. (The currently running
%% automatic test is kept in the queue until it is done. An empty queue
%% means that no automatic test is running.)
new_auto_test(Server, M, St) ->
case queue:is_empty(St#state.auto_test) of
true ->
start_auto_test(Server, M);
false ->
ok
end,
St#state{auto_test = queue:in({Server, M}, St#state.auto_test)}.
auto_test_done(St) ->
%% remove finished test from queue before checking for more
{_, Queue} = queue:out(St#state.auto_test),
case queue:out(Queue) of
{{value, {Server, M}}, _} ->
%% this is just lookahead - the item is not removed
start_auto_test(Server, M);
{empty, _} ->
ok
end,
St#state{auto_test = Queue}.
start_auto_test(Server, M) ->
spawn(fun () -> auto_super(Server, M) end).
auto_super(Server, M) ->
process_flag(trap_exit, true),
%% Give the user a short delay before any output is produced
receive after 333 -> ok end,
%% Make sure output is sent to console on server node
group_leader(whereis(user), self()),
Pid = spawn_link(fun () -> auto_proc(Server, M) end),
receive
{'EXIT', Pid, _} ->
ok
after ?AUTO_TIMEOUT ->
exit(Pid, kill),
io:put_chars("\n== EUnit: automatic test was aborted ==\n"),
io:put_chars("\n> ")
end,
Server ! {done, auto_test, self()}.
auto_proc(Server, M) ->
%% Make the output start on a new line instead of on the same line
%% as the current shell prompt.
io:fwrite("\n== EUnit: testing module ~w ==\n", [M]),
eunit:test(Server, M, [enqueue]),
%% Make sure to print a dummy prompt at the end of the output, most
%% of all so that the Emacs mode realizes that input is active.
io:put_chars("\n-> ").
