wip

2 files changed, 250 insertions, 0 deletions

diff --git a/learn-you-some-erlang/ppool-1.0/test/ppool_nagger.erl b/learn-you-some-erlang/ppool-1.0/test/ppool_nagger.erl
new file mode 100644
index 0000000..903f821
--- /dev/null
+++ b/learn-you-some-erlang/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/ppool-1.0/test/ppool_tests.erl b/learn-you-some-erlang/ppool-1.0/test/ppool_tests.erl
new file mode 100644
index 0000000..8f0dfe2
--- /dev/null
+++ b/learn-you-some-erlang/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).