aboutsummaryrefslogtreecommitdiff
path: root/learn-you-some-erlang/release/ppool-1.0/test
diff options
context:
space:
mode:
Diffstat (limited to 'learn-you-some-erlang/release/ppool-1.0/test')
-rw-r--r--learn-you-some-erlang/release/ppool-1.0/test/ppool_nagger.erl50
-rw-r--r--learn-you-some-erlang/release/ppool-1.0/test/ppool_tests.erl200
2 files changed, 250 insertions, 0 deletions
diff --git a/learn-you-some-erlang/release/ppool-1.0/test/ppool_nagger.erl b/learn-you-some-erlang/release/ppool-1.0/test/ppool_nagger.erl
new file mode 100644
index 0000000..903f821
--- /dev/null
+++ b/learn-you-some-erlang/release/ppool-1.0/test/ppool_nagger.erl
@@ -0,0 +1,50 @@
+%% demo module, a nagger for tasks,
+%% because the previous one wasn't good enough
+%%
+%% Can take:
+%% - a time delay for which to nag,
+%% - an adress to say where the messages should be sent
+%% - a message to send in the mailbox telling you what to nag,
+%% with an id to be able to call: ->
+%% - a command to say the task is done
+-module(ppool_nagger).
+-behaviour(gen_server).
+-export([start_link/4, stop/1]).
+-export([init/1, handle_call/3, handle_cast/2,
+ handle_info/2, code_change/3, terminate/2]).
+
+start_link(Task, Delay, Max, SendTo) ->
+ gen_server:start_link(?MODULE, {Task, Delay, Max, SendTo} , []).
+
+stop(Pid) ->
+ gen_server:call(Pid, stop).
+
+init({Task, Delay, Max, SendTo}) ->
+ process_flag(trap_exit, true), % for tests & terminate too
+ {ok, {Task, Delay, Max, SendTo}, Delay}.
+
+%%% OTP Callbacks
+handle_call(stop, _From, State) ->
+ {stop, normal, ok, State};
+handle_call(_Msg, _From, State) ->
+ {noreply, State}.
+
+handle_cast(_Msg, State) ->
+ {noreply, State}.
+
+handle_info(timeout, {Task, Delay, Max, SendTo}) ->
+ SendTo ! {self(), Task},
+ if Max =:= infinity ->
+ {noreply, {Task, Delay, Max, SendTo}, Delay};
+ Max =< 1 ->
+ {stop, normal, {Task, Delay, 0, SendTo}};
+ Max > 1 ->
+ {noreply, {Task, Delay, Max-1, SendTo}, Delay}
+ end;
+handle_info(_Msg, State) ->
+ {noreply, State}.
+
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+terminate(_Reason, _State) -> ok.
diff --git a/learn-you-some-erlang/release/ppool-1.0/test/ppool_tests.erl b/learn-you-some-erlang/release/ppool-1.0/test/ppool_tests.erl
new file mode 100644
index 0000000..8f0dfe2
--- /dev/null
+++ b/learn-you-some-erlang/release/ppool-1.0/test/ppool_tests.erl
@@ -0,0 +1,200 @@
+-module(ppool_tests).
+-include_lib("eunit/include/eunit.hrl").
+-export([test_mfa/1, wait_mfa/1]).
+
+%%% All Test Fixtures
+start_test_() ->
+ {"It should be possible to start a pool server and give it a name",
+ {setup,
+ fun find_unique_name/0,
+ fun(Name) ->
+ [start_and_test_name(Name)]
+ end}}.
+
+mfa_test_() ->
+ {"A pool process can be allocated which will be ordered "
+ "to run an MFA call determined at start time, with arguments "
+ "provided at call time",
+ {setup,
+ fun start_ppool/0,
+ fun kill_ppool/1,
+ fun(Name) ->
+ [pool_run_mfa(Name)]
+ end}
+ }.
+
+alloc_test_() ->
+ {"A pool process can be allocated which will be ordered "
+ "to run a worker, only if there are enough which "
+ "haven't been ordered to run yet.",
+ {setup,
+ fun start_ppool/0,
+ fun kill_ppool/1,
+ fun(Name) ->
+ [pool_run_alloc(Name),
+ pool_run_noalloc(Name)]
+ end}
+ }.
+
+realloc_test_() ->
+ {"When an allocated process dies, "
+ "A new one can be allocated to replace it.",
+ {setup,
+ fun start_ppool/0,
+ fun kill_ppool/1,
+ fun(Name) ->
+ [pool_run_realloc(Name)]
+ end}
+ }.
+
+queue_test_() ->
+ {"The queue function can be used to run the function as soon as possible. "
+ "If no space is available, the worker call is added to the queue.",
+ {foreach,
+ fun start_ppool/0,
+ fun kill_ppool/1,
+ [fun(Name) -> test_async_queue(Name) end,
+ fun(Name) -> test_sync_queue(Name) end]}
+ }.
+
+supervision_test_() ->
+ {"The ppool will never restart a dead child, but all children (OTP "
+ "compliant) will be shut down when closing the pool, even if they "
+ "are trapping exits",
+ {setup,
+ fun find_unique_name/0,
+ fun test_supervision/1}}.
+
+auth_test_() ->
+ {"The ppool should only dequeue tasks after receiving a down signal "
+ "from a worker and nobody else",
+ {setup,
+ fun start_ppool/0,
+ fun kill_ppool/1,
+ fun test_auth_dealloc/1}}.
+
+%%% Setups/teardowns
+find_unique_name() ->
+ application:start(ppool),
+ Name = list_to_atom(lists:flatten(io_lib:format("~p",[now()]))),
+ ?assertEqual(undefined, whereis(Name)),
+ Name.
+
+start_ppool() ->
+ Name = find_unique_name(),
+ ppool:start_pool(Name, 2, {ppool_nagger, start_link, []}),
+ Name.
+
+kill_ppool(Name) ->
+ ppool:stop_pool(Name).
+
+%%% Actual tests
+start_and_test_name(Name) ->
+ ppool:start_pool(Name, 1, {ppool_nagger, start_link, []}),
+ A = whereis(Name),
+ ppool:stop_pool(Name),
+ timer:sleep(100),
+ B = whereis(Name),
+ [?_assert(undefined =/= A),
+ ?_assertEqual(undefined, B)].
+
+pool_run_mfa(Name) ->
+ ppool:run(Name, [i_am_running, 1, 1, self()]),
+ X = receive
+ {_Pid, i_am_running} -> ok
+ after 3000 ->
+ timeout
+ end,
+ ?_assertEqual(ok, X).
+
+pool_run_alloc(Name) ->
+ {ok, Pid} = ppool:run(Name, [i_am_running, 1, 1, self()]),
+ X = receive
+ {Pid, i_am_running} -> ok
+ after 3000 ->
+ timeout
+ end,
+ [?_assert(is_pid(Pid)),
+ ?_assertEqual(ok, X)].
+
+pool_run_noalloc(Name) ->
+ %% Init function should have set the limit to 2
+ ppool:run(Name, [i_am_running, 300, 1, self()]),
+ ppool:run(Name, [i_am_running, 300, 1, self()]),
+ X = ppool:run(Name, [i_am_running, 1, 1, self()]),
+ ?_assertEqual(noalloc, X).
+
+pool_run_realloc(Name) ->
+ %% Init function should have set the limit to 2
+ {ok, A} = ppool:run(Name, [i_am_running, 500, 1, self()]),
+ timer:sleep(100),
+ {ok, B} = ppool:run(Name, [i_am_running, 500, 1, self()]),
+ timer:sleep(600),
+ {ok, Pid} = ppool:run(Name, [i_am_running, 1, 1, self()]),
+ timer:sleep(100),
+ L = flush(),
+ [?_assert(is_pid(Pid)),
+ ?_assertEqual([{A,i_am_running}, {B,i_am_running}, {Pid,i_am_running}],
+ L)].
+
+test_async_queue(Name) ->
+ %% Still two elements max!
+ ok = ppool:async_queue(Name, [i_am_running, 2000, 1, self()]),
+ ok = ppool:async_queue(Name, [i_am_running, 2000, 1, self()]),
+ noalloc = ppool:run(Name, [i_am_running, 2000, 1, self()]),
+ ok = ppool:async_queue(Name, [i_am_running, 500, 1, self()]),
+ timer:sleep(3500),
+ L = flush(),
+ ?_assertMatch([{_, i_am_running}, {_, i_am_running}, {_, i_am_running}], L).
+
+test_sync_queue(Name) ->
+ %% Hell yase, two max
+ {ok, Pid} = ppool:sync_queue(Name, [i_am_running, 200, 1, self()]),
+ ok = ppool:async_queue(Name, [i_am_running, 200, 1, self()]),
+ ok = ppool:async_queue(Name, [i_am_running, 200, 1, self()]),
+ {ok, Pid2} = ppool:sync_queue(Name, [i_am_running, 100, 1, self()]),
+ timer:sleep(300),
+ L = flush(),
+ [?_assert(is_pid(Pid)),
+ ?_assert(is_pid(Pid2)),
+ ?_assertMatch([{_,i_am_running}, {_,i_am_running},
+ {_,i_am_running}, {_,i_am_running}],
+ L)].
+
+test_supervision(Name) ->
+ ppool:start_pool(Name, 1, {ppool_nagger, start_link, []}),
+ {ok, Pid} = ppool:run(Name, [sup, 10000, 100, self()]),
+ ppool:stop_pool(Name),
+ timer:sleep(100),
+ ?_assertEqual(undefined, process_info(Pid)).
+
+test_auth_dealloc(Name) ->
+ %% Hell yase, two max
+ {ok, _Pid} = ppool:sync_queue(Name, [i_am_running, 500, 1, self()]),
+ ok = ppool:async_queue(Name, [i_am_running, 10000, 1, self()]),
+ ok = ppool:async_queue(Name, [i_am_running, 10000, 1, self()]),
+ ok = ppool:async_queue(Name, [i_am_running, 1, 1, self()]),
+ timer:sleep(600),
+ Name ! {'DOWN', make_ref(), process, self(), normal},
+ Name ! {'DOWN', make_ref(), process, self(), normal},
+ Name ! {'DOWN', make_ref(), process, self(), normal},
+ timer:sleep(200),
+ L = flush(),
+ ?_assertMatch([{_,i_am_running}], L).
+
+
+
+flush() ->
+ receive
+ X -> [X|flush()]
+ after 0 ->
+ []
+ end.
+
+%% Exported Helper functions
+test_mfa(Pid) ->
+ Pid ! i_am_running.
+
+wait_mfa(Pid) ->
+ Pid ! i_am_running,
+ timer:sleep(3000).
generated by cgit v1.2.3 (git 2.39.1) at 2024-09-18 14:37:56 +0000