diff options
Diffstat (limited to 'learn-you-some-erlang/processquest/apps/regis-1.0.0')
7 files changed, 292 insertions, 0 deletions
diff --git a/learn-you-some-erlang/processquest/apps/regis-1.0.0/Emakefile b/learn-you-some-erlang/processquest/apps/regis-1.0.0/Emakefile new file mode 100644 index 0000000..b8be313 --- /dev/null +++ b/learn-you-some-erlang/processquest/apps/regis-1.0.0/Emakefile @@ -0,0 +1,2 @@ +{["src/*", "test/*"], [{outdir, "ebin"}]}. + diff --git a/learn-you-some-erlang/processquest/apps/regis-1.0.0/ebin/regis.app b/learn-you-some-erlang/processquest/apps/regis-1.0.0/ebin/regis.app new file mode 100644 index 0000000..169f6d2 --- /dev/null +++ b/learn-you-some-erlang/processquest/apps/regis-1.0.0/ebin/regis.app @@ -0,0 +1,7 @@ +{application, regis, + [{description, "A non-distributed process registry"}, + {vsn, "1.0.0"}, + {mod, {regis, []}}, + {registered, [regis_server]}, + {modules, [regis, regis_sup, regis_server]}, + {applications, [stdlib, kernel]}]}. diff --git a/learn-you-some-erlang/processquest/apps/regis-1.0.0/src/regis.erl b/learn-you-some-erlang/processquest/apps/regis-1.0.0/src/regis.erl new file mode 100644 index 0000000..0b37c7c --- /dev/null +++ b/learn-you-some-erlang/processquest/apps/regis-1.0.0/src/regis.erl @@ -0,0 +1,29 @@ +%%% Application wrapper module for regis, +%%% a process registration application. +%%% +%%% This was added because the standard process registry has a precise +%%% meaning of representing VM-global, non-dynamic processes. +%%% However, for this, we needed dynamic names and so we had to write +%%% one ourselves. Of course we could have used 'global' (but we +%%% didn't see distributed Erlang yet) or 'gproc' (I don't want to +%%% depend on external libs for this guide), so checkthem out +%%% if you're writing your own app. +-module(regis). +-behaviour(application). +-export([start/2, stop/1]). +-export([register/2, unregister/1, whereis/1, get_names/0]). + + +start(normal, []) -> + regis_sup:start_link(). + +stop(_) -> + ok. + +register(Name, Pid) -> regis_server:register(Name, Pid). + +unregister(Name) -> regis_server:unregister(Name). + +whereis(Name) -> regis_server:whereis(Name). + +get_names() -> regis_server:get_names(). diff --git a/learn-you-some-erlang/processquest/apps/regis-1.0.0/src/regis_server.erl b/learn-you-some-erlang/processquest/apps/regis-1.0.0/src/regis_server.erl new file mode 100644 index 0000000..a668b02 --- /dev/null +++ b/learn-you-some-erlang/processquest/apps/regis-1.0.0/src/regis_server.erl @@ -0,0 +1,98 @@ +%%% The core of the app: the server in charge of tracking processes. +-module(regis_server). +-behaviour(gen_server). + +-export([start_link/0, stop/0, register/2, unregister/1, whereis/1, + get_names/0]). +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, + code_change/3, terminate/2]). + +%% We have two indexes: one by name and one by pid, for +%% MAXIMUM SPEED (not actually measured). +-record(state, {pid, name}). + +%%%%%%%%%%%%%%%%% +%%% INTERFACE %%% +%%%%%%%%%%%%%%%%% +start_link() -> + gen_server:start_link({local, ?MODULE}, ?MODULE, [], []). + +stop() -> + gen_server:call(?MODULE, stop). + +%% Give a name to a process +register(Name, Pid) when is_pid(Pid) -> + gen_server:call(?MODULE, {register, Name, Pid}). + +%% Remove the name from a process +unregister(Name) -> + gen_server:call(?MODULE, {unregister, Name}). + +%% Find the pid associated with a process +whereis(Name) -> + gen_server:call(?MODULE, {whereis, Name}). + +%% Find all the names currently registered. +get_names() -> + gen_server:call(?MODULE, get_names). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% GEN_SERVER CALLBACKS %%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%% +init([]) -> + %% Using gb_trees to store items. gb_trees generally have + %% good overall performance. + {ok, #state{pid = gb_trees:empty(), + name = gb_trees:empty()}}. + +handle_call({register, Name, Pid}, _From, S = #state{pid=P, name=N}) -> + case {gb_trees:is_defined(Pid, P), gb_trees:is_defined(Name, N)} of + {true, _} -> + {reply, {error, already_named}, S}; + {_, true} -> + {reply, {error, name_taken}, S}; + {false, false} -> + Ref = erlang:monitor(process, Pid), + {reply, ok, S#state{pid=gb_trees:insert(Pid, {Name,Ref}, P), + name=gb_trees:insert(Name, {Pid,Ref}, N)}} + end; +handle_call({unregister, Name}, _From, S = #state{pid=P, name=N}) -> + case gb_trees:lookup(Name, N) of + {value, {Pid,Ref}} -> + erlang:demonitor(Ref, [flush]), + {reply, ok, S#state{pid=gb_trees:delete(Pid, P), + name=gb_trees:delete(Name, N)}}; + none -> + {reply, ok, S} + end; +handle_call({whereis, Name}, _From, S = #state{name=N}) -> + case gb_trees:lookup(Name, N) of + {value, {Pid,_}} -> + {reply, Pid, S}; + none -> + {reply, undefined, S} + end; +handle_call(get_names, _From, S = #state{name=N}) -> + {reply, gb_trees:keys(N), S}; +handle_call(stop, _From, State) -> + {stop, normal, ok, State}; +handle_call(_Event, _From, State) -> + {noreply, State}. + +handle_cast(_Event, State) -> + {noreply, State}. + +handle_info({'DOWN', Ref, process, Pid, _Reason}, S = #state{pid=P,name=N}) -> + {value, {Name, Ref}} = gb_trees:lookup(Pid, P), + {noreply, S#state{pid = gb_trees:delete(Pid, P), + name = gb_trees:delete(Name, N)}}; +handle_info(_Event, State) -> + {noreply, State}. + +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +terminate(_Reason, _State) -> + ok. + + diff --git a/learn-you-some-erlang/processquest/apps/regis-1.0.0/src/regis_sup.erl b/learn-you-some-erlang/processquest/apps/regis-1.0.0/src/regis_sup.erl new file mode 100644 index 0000000..be333e6 --- /dev/null +++ b/learn-you-some-erlang/processquest/apps/regis-1.0.0/src/regis_sup.erl @@ -0,0 +1,18 @@ +%%% The top-level supervisor of the registration +%%% server. +-module(regis_sup). +-behaviour(supervisor). +-export([start_link/0]). +-export([init/1]). + +start_link() -> + supervisor:start_link(?MODULE, []). + +init([]) -> + {ok, {{one_for_one, 1, 3600}, + [{server, + {regis_server, start_link, []}, + permanent, + 500, + worker, + [regis_server]}]}}. diff --git a/learn-you-some-erlang/processquest/apps/regis-1.0.0/test/regis_server_tests.erl b/learn-you-some-erlang/processquest/apps/regis-1.0.0/test/regis_server_tests.erl new file mode 100644 index 0000000..40e1af0 --- /dev/null +++ b/learn-you-some-erlang/processquest/apps/regis-1.0.0/test/regis_server_tests.erl @@ -0,0 +1,120 @@ +-module(regis_server_tests). +-include_lib("eunit/include/eunit.hrl"). + +-define(setup(F), {setup, fun start/0, fun stop/1, F}). + +%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% TESTS DESCRIPTIONS %%% +%%%%%%%%%%%%%%%%%%%%%%%%%% + +start_stop_test_() -> + {"The server can be started, stopped and has a registered name", + ?setup(fun is_registered/1)}. + +register_test_() -> + [{"A process can be registered and contacted", + ?setup(fun register_contact/1)}, + {"A list of registered processes can be obtained", + ?setup(fun registered_list/1)}, + {"An undefined name should return 'undefined' to crash calls", + ?setup(fun noregister/1)}, + {"A process can not have two names", + ?setup(fun two_names_one_pid/1)}, + {"Two processes cannot share the same name", + ?setup(fun two_pids_one_name/1)}]. + +unregister_test_() -> + [{"A process that was registered can be registered again iff it was " + "unregistered between both calls", + ?setup(fun re_un_register/1)}, + {"Unregistering never crashes", + ?setup(fun unregister_nocrash/1)}, + {"A crash unregisters a process", + ?setup(fun crash_unregisters/1)}]. + +%%%%%%%%%%%%%%%%%%%%%%% +%%% SETUP FUNCTIONS %%% +%%%%%%%%%%%%%%%%%%%%%%% +start() -> + {ok, Pid} = regis_server:start_link(), + Pid. + +stop(_) -> + regis_server:stop(). + +%%%%%%%%%%%%%%%%%%%% +%%% ACTUAL TESTS %%% +%%%%%%%%%%%%%%%%%%%% +is_registered(Pid) -> + [?_assert(erlang:is_process_alive(Pid)), + ?_assertEqual(Pid, whereis(regis_server))]. + +register_contact(_) -> + Pid = proc_lib:spawn_link(fun() -> callback(regcontact) end), + timer:sleep(15), + Ref = make_ref(), + WherePid = regis_server:whereis(regcontact), + regis_server:whereis(regcontact) ! {self(), Ref, hi}, + Rec = receive + {Ref, hi} -> true + after 2000 -> false + end, + [?_assertEqual(Pid, WherePid), + ?_assert(Rec)]. + +noregister(_) -> + [?_assertError(badarg, regis_server:whereis(make_ref()) ! hi), + ?_assertEqual(undefined, regis_server:whereis(make_ref()))]. + +two_names_one_pid(_) -> + ok = regis_server:register(make_ref(), self()), + Res = regis_server:register(make_ref(), self()), + [?_assertEqual({error, already_named}, Res)]. + +two_pids_one_name(_) -> + Pid = proc_lib:spawn(fun() -> callback(myname) end), + timer:sleep(15), + Res = regis_server:register(myname, self()), + exit(Pid, kill), + [?_assertEqual({error, name_taken}, Res)]. + +registered_list(_) -> + L1 = regis_server:get_names(), + Pids = [spawn(fun() -> callback(N) end) || N <- lists:seq(1,15)], + timer:sleep(200), + L2 = regis_server:get_names(), + [exit(Pid, kill) || Pid <- Pids], + [?_assertEqual([], L1), + ?_assertEqual(lists:sort(lists:seq(1,15)), lists:sort(L2))]. + +re_un_register(_) -> + Ref = make_ref(), + L = [regis_server:register(Ref, self()), + regis_server:register(make_ref(), self()), + regis_server:unregister(Ref), + regis_server:register(make_ref(), self())], + [?_assertEqual([ok, {error, already_named}, ok, ok], L)]. + +unregister_nocrash(_) -> + ?_assertEqual(ok, regis_server:unregister(make_ref())). + +crash_unregisters(_) -> + Ref = make_ref(), + Pid = spawn(fun() -> callback(Ref) end), + timer:sleep(150), + Pid = regis_server:whereis(Ref), + exit(Pid, kill), + timer:sleep(95), + regis_server:register(Ref, self()), + S = regis_server:whereis(Ref), + Self = self(), + ?_assertEqual(Self, S). + +%%%%%%%%%%%%%%%%%%%%%%%% +%%% HELPER FUNCTIONS %%% +%%%%%%%%%%%%%%%%%%%%%%%% +callback(Name) -> + ok = regis_server:register(Name, self()), + receive + {From, Ref, Msg} -> From ! {Ref, Msg} + end. diff --git a/learn-you-some-erlang/processquest/apps/regis-1.0.0/test/regis_tests.erl b/learn-you-some-erlang/processquest/apps/regis-1.0.0/test/regis_tests.erl new file mode 100644 index 0000000..61f5f16 --- /dev/null +++ b/learn-you-some-erlang/processquest/apps/regis-1.0.0/test/regis_tests.erl @@ -0,0 +1,18 @@ +-module(regis_tests). +-include_lib("eunit/include/eunit.hrl"). + +app_test_() -> + {inorder, + [?_assert(try application:start(regis) of + ok -> true; + {error, {already_started, regis}} -> true; + _ -> false + catch + _:_ -> false + end), + ?_assert(try application:stop(regis) of + ok -> true; + _ -> false + catch + _:_ -> false + end)]}. |