1%% Licensed under the Apache License, Version 2.0 (the "License"); you may
2%% not use this file except in compliance with the License. You may obtain
3%% a copy of the License at <http://www.apache.org/licenses/LICENSE-2.0>
4%%
5%% Unless required by applicable law or agreed to in writing, software
6%% distributed under the License is distributed on an "AS IS" BASIS,
7%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
8%% See the License for the specific language governing permissions and
9%% limitations under the License.
10%%
11%% Alternatively, you may use this file under the terms of the GNU Lesser
12%% General Public License (the "LGPL") as published by the Free Software
13%% Foundation; either version 2.1, or (at your option) any later version.
14%% If you wish to allow use of your version of this file only under the
15%% terms of the LGPL, you should delete the provisions above and replace
16%% them with the notice and other provisions required by the LGPL; see
17%% <http://www.gnu.org/licenses/>. If you do not delete the provisions
18%% above, a recipient may use your version of this file under the terms of
19%% either the Apache License or the LGPL.
20%%
21%% @author Richard Carlsson <carlsson.richard@gmail.com>
22%% @copyright 2006 Richard Carlsson
23%% @private
24%% @see eunit
25%% @doc EUnit server process
26
27-module(eunit_server).
28
29-export([start/1, stop/1, start_test/4, watch/3, watch_path/3,
30	 watch_regexp/3]).
31
32-export([main/1]).  % private
33
34-include("eunit.hrl").
35-include("eunit_internal.hrl").
36
37
38-define(AUTO_TIMEOUT, 60000).   %% auto test time limit
39
40%% TODO: pass options to server, such as default timeout?
41
42start(Server) when is_atom(Server) ->
43    ensure_started(Server).
44
45stop(Server) ->
46    command(Server, stop).
47
48
49-record(job, {super, test, options}).
50
51%% The `Super' process will receive a stream of status messages; see
52%% eunit_proc:status_message/3 for details.
53
54start_test(Server, Super, T, Options) ->
55    command(Server, {start, #job{super = Super,
56				 test = T,
57				 options = Options}}).
58
59watch(Server, Module, Opts) when is_atom(Module) ->
60    command(Server, {watch, {module, Module}, Opts}).
61
62watch_path(Server, Path, Opts) ->
63    command(Server, {watch, {path, filename:flatten(Path)}, Opts}).
64
65%% note that the user must use $ at the end to match whole paths only
66watch_regexp(Server, Regex, Opts) ->
67    case re:compile(Regex,[anchored]) of
68	{ok, R} ->
69	    command(Server, {watch, {regexp, R}, Opts});
70	{error, _}=Error ->
71	    Error
72    end.
73
74%% This makes sure the server is started before sending the command, and
75%% returns {ok, Result} if the server accepted the command or {error,
76%% server_down} if the server process crashes. If the server does not
77%% reply, this function will wait until the server is killed.
78
79command(Server, Cmd) ->
80    if is_atom(Server), Cmd /= stop -> ensure_started(Server);
81       true -> ok
82    end,
83    if is_pid(Server) -> command_1(Server, Cmd);
84       true ->
85	    case whereis(Server) of
86		undefined -> {error, server_down};
87		Pid -> command_1(Pid, Cmd)
88	    end
89    end.
90
91command_1(Pid, Cmd) when is_pid(Pid) ->
92    Pid ! {command, self(), Cmd},
93    command_wait(Pid, 1000, undefined).
94
95command_wait(Pid, Timeout, Monitor) ->
96    receive
97	{Pid, Result} -> Result;
98	{'DOWN', Monitor, process, Pid, _R} -> {error, server_down}
99    after Timeout ->
100	    %% avoid creating a monitor unless some time has passed
101	    command_wait(Pid, infinity, erlang:monitor(process, Pid))
102    end.
103
104%% Starting the server
105
106ensure_started(Name) ->
107    ensure_started(Name, 5).
108
109ensure_started(Name, N) when N > 0 ->
110    case whereis(Name) of
111	undefined ->
112	    Parent = self(),
113	    Pid = spawn(fun () -> server_start(Name, Parent) end),
114	    receive
115		{Pid, ok} ->
116		    Pid;
117		{Pid, error} ->
118		    receive after 200 -> ensure_started(Name, N - 1) end
119	    end;
120	Pid ->
121	    Pid
122    end;
123ensure_started(_, _) ->
124    throw(no_server).
125
126server_start(undefined = Name, Parent) ->
127    %% anonymous server
128    server_start_1(Name, Parent);
129server_start(Name, Parent) ->
130    try register(Name, self()) of
131	true -> server_start_1(Name, Parent)
132    catch
133	_:_ ->
134	    Parent ! {self(), error},
135	    exit(error)
136    end.
137
138server_start_1(Name, Parent) ->
139    Parent ! {self(), ok},
140    server_init(Name).
141
142-record(state, {name,
143		stopped,
144		jobs,
145		queue,
146		auto_test,
147		modules,
148		paths,
149		regexps}).
150
151server_init(Name) ->
152    server(#state{name = Name,
153		  stopped = false,
154		  jobs = dict:new(),
155		  queue = queue:new(),
156		  auto_test = queue:new(),
157		  modules = sets:new(),
158		  paths = sets:new(),
159		  regexps = sets:new()}).
160
161server(St) ->
162    server_check_exit(St),
163    ?MODULE:main(St).
164
165%% @private
166main(St) ->
167    receive
168	{done, auto_test, _Pid} ->
169	    server(auto_test_done(St));
170	{done, Reference, _Pid} ->
171	    server(handle_done(Reference, St));
172	{command, From, _Cmd} when St#state.stopped ->
173	    From ! {self(), stopped};
174	{command, From, Cmd} ->
175	    server_command(From, Cmd, St);
176	{code_monitor, {loaded, M, _Time}} ->
177	    case is_watched(M, St) of
178		true ->
179		    server(new_auto_test(self(), M, St));
180		false ->
181		    server(St)
182	    end
183    end.
184
185server_check_exit(St) ->
186    case dict:size(St#state.jobs) of
187	0 when St#state.stopped -> exit(normal);
188	_ -> ok
189    end.
190
191server_command(From, {start, Job}, St) ->
192    Reference = make_ref(),
193    St1 = case proplists:get_bool(enqueue, Job#job.options) of
194	      true ->
195		  enqueue(Job, From, Reference, St);
196	      false ->
197		  start_job(Job, From, Reference, St)
198	  end,
199    server_command_reply(From, {ok, Reference}),
200    server(St1);
201server_command(From, stop, St) ->
202    %% unregister the server name and let remaining jobs finish
203    server_command_reply(From, {error, stopped}),
204    catch unregister(St#state.name),
205    server(St#state{stopped = true});
206server_command(From, {watch, Target, _Opts}, St) ->
207    %% the code watcher is only started on demand
208    %% TODO: this is disabled for now
209    %%code_monitor:monitor(self()),
210    %% TODO: propagate options to testing stage
211    St1 = add_watch(Target, St),
212    server_command_reply(From, ok),
213    server(St1);
214server_command(From, {forget, Target}, St) ->
215    St1 = delete_watch(Target, St),
216    server_command_reply(From, ok),
217    server(St1);
218server_command(From, Cmd, St) ->
219    server_command_reply(From, {error, {unknown_command, Cmd}}),
220    server(St).
221
222server_command_reply(From, Result) ->
223    From ! {self(), Result}.
224
225enqueue(Job, From, Reference, St) ->
226    case dict:size(St#state.jobs) of
227	0 ->
228	    start_job(Job, From, Reference, St);
229	_ ->
230	    St#state{queue = queue:in({Job, From, Reference},
231				      St#state.queue)}
232    end.
233
234dequeue(St) ->
235    case queue:out(St#state.queue) of
236	{empty, _} ->
237	    St;
238	{{value, {Job, From, Reference}}, Queue} ->
239	    start_job(Job, From, Reference, St#state{queue = Queue})
240    end.
241
242start_job(Job, From, Reference, St) ->
243    From ! {start, Reference},
244    %% The default is to run tests in order unless otherwise specified
245    Order = proplists:get_value(order, Job#job.options, inorder),
246    eunit_proc:start(Job#job.test, Order, Job#job.super, Reference),
247    St#state{jobs = dict:store(Reference, From, St#state.jobs)}.
248
249handle_done(Reference, St) ->
250    case dict:find(Reference, St#state.jobs) of
251	{ok, From} ->
252	    From ! {done, Reference},
253	    dequeue(St#state{jobs = dict:erase(Reference,
254					       St#state.jobs)});
255	error ->
256	    St
257    end.
258
259%% Adding and removing watched modules or paths
260
261add_watch({module, M}, St) ->
262    St#state{modules = sets:add_element(M, St#state.modules)};
263add_watch({path, P}, St) ->
264    St#state{paths = sets:add_element(P, St#state.paths)};
265add_watch({regexp, R}, St) ->
266    St#state{regexps = sets:add_element(R, St#state.regexps)}.
267
268delete_watch({module, M}, St) ->
269    St#state{modules = sets:del_element(M, St#state.modules)};
270delete_watch({path, P}, St) ->
271    St#state{paths = sets:del_element(P, St#state.paths)};
272delete_watch({regexp, R}, St) ->
273    St#state{regexps = sets:del_element(R, St#state.regexps)}.
274
275%% Checking if a module is being watched
276
277is_watched(M, St) when is_atom(M) ->
278    sets:is_element(M, St#state.modules) orelse
279	is_watched(code:which(M), St);
280is_watched(Path, St) ->
281    sets:is_element(filename:dirname(Path), St#state.paths) orelse
282	match_any(sets:to_list(St#state.regexps), Path).
283
284match_any([R | Rs], Str) ->
285    case re:run(Str, R, [{capture,none}]) of
286	match -> true;
287	_ -> match_any(Rs, Str)
288    end;
289match_any([], _Str) -> false.
290
291%% Running automatic tests when a watched module is loaded.
292%% Uses a queue in order to avoid overlapping output when several
293%% watched modules are loaded simultaneously. (The currently running
294%% automatic test is kept in the queue until it is done. An empty queue
295%% means that no automatic test is running.)
296
297new_auto_test(Server, M, St) ->
298    case queue:is_empty(St#state.auto_test) of
299	true ->
300	    start_auto_test(Server, M);
301	false ->
302	    ok
303    end,
304    St#state{auto_test = queue:in({Server, M}, St#state.auto_test)}.
305
306auto_test_done(St) ->
307    %% remove finished test from queue before checking for more
308    {_, Queue} = queue:out(St#state.auto_test),
309    case queue:out(Queue) of
310	{{value, {Server, M}}, _} ->
311	    %% this is just lookahead - the item is not removed
312	    start_auto_test(Server, M);
313	{empty, _} ->
314	    ok
315    end,
316    St#state{auto_test = Queue}.
317
318start_auto_test(Server, M) ->
319    spawn(fun () -> auto_super(Server, M) end).
320
321auto_super(Server, M) ->
322    process_flag(trap_exit, true),
323    %% Give the user a short delay before any output is produced
324    receive after 333 -> ok end,
325    %% Make sure output is sent to console on server node
326    group_leader(whereis(user), self()),
327    Pid = spawn_link(fun () -> auto_proc(Server, M) end),
328    receive
329	{'EXIT', Pid, _} ->
330	    ok
331    after ?AUTO_TIMEOUT	->
332	    exit(Pid, kill),
333	    io:put_chars("\n== EUnit: automatic test was aborted ==\n"),
334	    io:put_chars("\n> ")
335    end,
336    Server ! {done, auto_test, self()}.
337
338auto_proc(Server, M) ->
339    %% Make the output start on a new line instead of on the same line
340    %% as the current shell prompt.
341    io:fwrite("\n== EUnit: testing module ~w ==\n", [M]),
342    eunit:test(Server, M, [enqueue]),
343    %% Make sure to print a dummy prompt at the end of the output, most
344    %% of all so that the Emacs mode realizes that input is active.
345    io:put_chars("\n-> ").
346