auser-poolparty 0.2.66 → 0.2.67

data/lib/erlang/messenger/lib/eunit/src/.svn/text-base/eunit_serial.erl.svn-base

@@ -0,0 +1,157 @@
+%% 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 <richardc@it.uu.se>
+%% @copyright 2006 Richard Carlsson
+%% @private
+%% @see eunit
+%% @doc Event serializing process which works as an adapter and
+%% multiplexer for "supervisor" processes
+
+-module(eunit_serial).
+
+-include("eunit.hrl").
+-include("eunit_internal.hrl").
+
+-export([start/1]).
+
+%% Notes:
+%% * Due to concurrency, there are no guarantees that we will receive
+%% all status messages for the items within a group before we receive
+%% the 'end' message of the group itself.
+%% 
+%% * A cancelling event may arrive at any time, and may concern items we
+%% are not yet expecting (if tests are executed in parallel), or may
+%% concern not only the current item but possibly a group ancestor of
+%% the current item (as in the case of a group timeout).
+%% 
+%% * It is not possible to use selective receive to extract only those
+%% cancelling messages that affect the current item and its parents;
+%% basically, because we cannot have a dynamically computed prefix as a
+%% pattern in a receive. Hence, we must extract each cancelling event as
+%% it arrives and keep track of them separately.
+%% 
+%% * Before we wait for a new item, we must check whether it (and thus
+%% also all its subitems, if any) is already cancelled.
+%% 
+%% * When a new cancelling event arrives, we must either store it for
+%% future use, and/or cancel the current item and possibly one or more
+%% of its parent groups.
+
+-record(state, {listeners,
+		cancelled = eunit_lib:trie_new(),
+		messages = dict:new()}).
+
+start(Pids) ->
+    spawn(fun () -> serializer(Pids) end).
+
+serializer(Pids) ->
+    St = #state{listeners = sets:from_list(Pids),
+		cancelled = eunit_lib:trie_new(),
+		messages = dict:new()},
+    item([], none, none, St),
+    exit(normal).
+
+item(Id, ParentId, N0, St0) ->
+    case wait(Id, 'begin', ParentId, N0, St0) of
+	{none, St1} ->
+	    {true, St1};
+	{{cancel, Done, undefined}, St1} ->
+	    {Done, cast({status, Id, {cancel, undefined}}, St1)};
+	{{cancel, Done, Msg}, St1} ->
+	    {Done, cast(Msg, St1)};
+	{{ok, Msg}, St1} ->
+	    %%?debugVal({got_begin, Id, Msg}),
+	    cast(Msg, St1),
+	    St2 = case Msg of
+		      {status, _, {progress, 'begin', group}} ->
+			  items(Id, 0, St1);
+		      _ -> St1
+		  end,
+	    case wait(Id, 'end', ParentId, N0, St2) of
+		{{cancel, Done, undefined}, St3} ->
+		    {Done, cast({status, Id, {cancel, undefined}}, St3)};
+		{{cancel, Done, Msg1}, St3} ->
+		    {Done, cast(Msg1, St3)};
+		{{ok, Msg1}, St3} ->
+		    %%?debugVal({got_end, Id, Msg1}),
+		    {false, cast(Msg1, St3)}
+	    end
+    end.
+
+items(ParentId, N0, St) ->
+    N = N0 + 1,
+    case item(ParentId ++ [N], ParentId, N0, St) of
+	{false, St1} ->
+	    items(ParentId, N, St1);
+	{true, St1} ->
+	    St1
+    end.
+
+cast(M, St) ->
+    sets:fold(fun (L, M) -> L ! M end, M, St#state.listeners),
+    St.
+
+wait(Id, Type, ParentId, N0, St) ->
+    %%?debugVal({wait, Id, Type}),
+    case check_cancelled(Id, St) of
+	no ->
+	    case recall(Id, St) of
+		undefined ->
+		    wait_1(Id, Type, ParentId, N0, St);
+		Msg ->
+		    {{ok, Msg}, forget(Id, St)}
+	    end;
+	Why ->
+	    %%?debugVal({cancelled, Why, Id, ParentId}),
+	    Done = (Why =:= prefix),
+	    {{cancel, Done, recall(Id, St)}, forget(Id, St)}
+    end.
+
+wait_1(Id, Type, ParentId, N0, St) ->
+    receive
+	{status, Id, {progress, Type, _}}=Msg ->
+	    %%?debugVal({Type, ParentId, Id}),
+	    {{ok, Msg}, St};
+	{status,ParentId,{progress,'end',{N0,_,_}}}=Msg ->
+	    %%?debugVal({end_group, ParentId, Id}),
+	    {none, remember(ParentId, Msg, St)};
+	{status, SomeId, {cancel, _Cause}}=Msg ->
+	    %%?debugVal({got_cancel, SomeId, ParentId, Id}),
+	    St1 = set_cancelled(SomeId, Msg, St),
+	    wait(Id, Type, ParentId, N0, St1)
+    end.
+
+set_cancelled(Id, Msg, St0) ->
+    St = remember(Id, Msg, St0),
+    St#state{cancelled = eunit_lib:trie_store(Id, St0#state.cancelled)}.
+
+check_cancelled(Id, St) ->
+    eunit_lib:trie_match(Id, St#state.cancelled).
+
+remember(Id, Msg, St) ->
+    St#state{messages = dict:store(Id, Msg, St#state.messages)}.
+
+forget(Id, St) ->
+    %% this is just to enable garbage collection of old messages
+    St#state{messages = dict:store(Id, undefined, St#state.messages)}.
+
+recall(Id, St) ->
+    case dict:find(Id, St#state.messages) of
+	{ok, Msg} -> Msg;
+	error -> undefined
+    end.

data/lib/erlang/messenger/lib/eunit/src/.svn/text-base/eunit_server.erl.svn-base

@@ -0,0 +1,340 @@
+%% 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 <richardc@it.uu.se>
+%% @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}).
+
+watch_regexp(Server, Regex, Opts) ->
+    case regexp:parse(Regex) 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(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
+    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 regexp:first_match(Str, R) 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-> ").