diff --git a/.github/workflows/erlang.yml b/.github/workflows/erlang.yml new file mode 100644 index 0000000..2509326 --- /dev/null +++ b/.github/workflows/erlang.yml @@ -0,0 +1,38 @@ +name: Erlang CI + +on: [push, pull_request] + +jobs: + + build: + + runs-on: ubuntu-latest + + strategy: + matrix: + otp: ['23.3', '24.0'] + rebar: ['3.16.1'] + + steps: + - uses: actions/checkout@v2 + - uses: erlef/setup-beam@v1 + id: setup-beam + with: + otp-version: ${{matrix.otp}} + rebar3-version: ${{matrix.rebar}} + - name: Restore _build + uses: actions/cache@v2 + with: + path: _build + key: _build-cache-for-os-${{runner.os}}-otp-${{steps.setup-beam.outputs.otp-version}}-rebar3-${{steps.setup-beam.outputs.rebar3-version}}-hash-${{hashFiles('rebar.lock')}} + - name: Restore rebar3's cache + uses: actions/cache@v2 + with: + path: ~/.cache/rebar3 + key: rebar3-cache-for-os-${{runner.os}}-otp-${{steps.setup-beam.outputs.otp-version}}-rebar3-${{steps.setup-beam.outputs.rebar3-version}}-hash-${{hashFiles('rebar.lock')}} + - name: Compile + run: rebar3 compile + - name: Format check + run: rebar3 format --verify + - name: Run tests and verifications + run: rebar3 test diff --git a/.gitignore b/.gitignore index dee833d..4fbd7e1 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,5 @@ +rebar3.crashdump +doc/ codecov.json _build/ all.coverdata diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 index ad850e7..0000000 --- a/.travis.yml +++ /dev/null @@ -1,16 +0,0 @@ -sudo: false -language: erlang -otp_release: - - 21.0.2 -before_install: - - ./ci before_install "${PWD:?}"/rebar3 -install: - - ./ci install "${PWD:?}"/rebar3 - - pip install --user codecov -script: - - ./ci script "${PWD:?}"/rebar3 -cache: - directories: - - .plt -after_success: - - codecov diff --git a/Emakefile b/Emakefile deleted file mode 100644 index 51f591a..0000000 --- a/Emakefile +++ /dev/null @@ -1,2 +0,0 @@ -{"src/*", [warn_unused_vars, warn_export_all, warn_shadow_vars, warn_unused_import, warn_unused_function, warn_bif_clash, warn_unused_record, warn_deprecated_function, warn_obsolete_guard, strict_validation, report, warn_export_vars, warn_exported_vars, warn_missing_spec, warn_untyped_record, debug_info, {outdir, "ebin"}, {i, "include"}]}. -{"test/*", [warn_unused_vars, warn_export_all, warn_shadow_vars, warn_unused_import, warn_unused_function, warn_bif_clash, warn_unused_record, warn_deprecated_function, warn_obsolete_guard, strict_validation, report, warn_export_vars, warn_exported_vars, warn_missing_spec, warn_untyped_record, debug_info, {outdir, "ebin"}, {i, "include"}]}. diff --git a/README.md b/README.md index 779066f..c892ded 100644 --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -# Worker Pool [![Build Status](https://travis-ci.org/inaka/worker_pool.svg?branch=master)](https://travis-ci.org/inaka/worker_pool)[![codecov](https://codecov.io/gh/inaka/worker_pool/branch/master/graph/badge.svg)](https://codecov.io/gh/inaka/worker_pool) +# Worker Pool [![Build Status](https://travis-ci.org/inaka/worker_pool.svg?branch=main)](https://travis-ci.org/inaka/worker_pool)[![codecov](https://codecov.io/gh/inaka/worker_pool/branch/main/graph/badge.svg)](https://codecov.io/gh/inaka/worker_pool) diff --git a/ci b/ci deleted file mode 100755 index 792fc8f..0000000 --- a/ci +++ /dev/null @@ -1,21 +0,0 @@ -#!/bin/bash - -set -ev # Ref https://docs.travis-ci.com/user/customizing-the-build/#Implementing-Complex-Build-Steps - -case "${1:?}" in - before_install) - ## Travis CI does not support rebar3 yet. See https://github.com/travis-ci/travis-ci/issues/6506#issuecomment-275189490 - Rebar3="${2:?}" - curl -f -L -o "${Rebar3:?}" https://github.com/erlang/rebar3/releases/download/3.6.1/rebar3 - chmod +x "${Rebar3:?}" - ;; - install) - Rebar3="${2:?}" - "${Rebar3:?}" deps - "${Rebar3:?}" dialyzer -u true -s false - ;; - script) - Rebar3="${2:?}" - "${Rebar3:?}" ct - ;; -esac diff --git a/elvis.config b/elvis.config index 80b3506..ed17396 100644 --- a/elvis.config +++ b/elvis.config @@ -1,62 +1,20 @@ -[ - { - elvis, - [ - {config, - [#{dirs => ["src"], - filter => "*.erl", - ruleset => erl_files, - rules => - [ { elvis_style - , invalid_dynamic_call - , #{ignore => [ wpool_process - , wpool_time_checker - ]} - } - , { elvis_style - , god_modules - , #{limit => 30} - } - , { elvis_style - , dont_repeat_yourself - , #{ ignore => [wpool_SUITE] - , min_complexity => 13 - } - } - , { elvis_style - , line_length - , #{limit => 100} - } - ] - }, - #{dirs => ["test"], - filter => "*.erl", - ruleset => erl_files, - rules => - [ { elvis_style - , no_debug_call - , disable - } - , { elvis_style - , dont_repeat_yourself - , #{min_complexity => 13} - } - , { elvis_style - , line_length - , #{limit => 100} - } - ] - }, - #{dirs => ["."], - filter => "Makefile", - ruleset => makefiles - }, - #{dirs => ["."], - filter => "elvis.config", - ruleset => elvis_config - } - ] - } - ] - } -]. +[{elvis, + [{config, + [#{dirs => ["src"], + filter => "*.erl", + ruleset => erl_files, + rules => + [{elvis_style, invalid_dynamic_call, #{ignore => [wpool_process, wpool_time_checker]}}, + {elvis_style, god_modules, #{limit => 30}}, + {elvis_style, state_record_and_type, disable}, + {elvis_style, dont_repeat_yourself, #{ignore => [wpool_SUITE], min_complexity => 13}}]}, + #{dirs => ["test"], + filter => "*.erl", + ruleset => erl_files, + rules => + [{elvis_style, no_debug_call, disable}, + {elvis_style, state_record_and_type, disable}, + {elvis_style, dont_repeat_yourself, #{min_complexity => 13}}]}, + #{dirs => ["."], + filter => "elvis.config", + ruleset => elvis_config}]}]}]. diff --git a/rebar.config b/rebar.config index 7bf5e15..7f1e955 100644 --- a/rebar.config +++ b/rebar.config @@ -2,75 +2,78 @@ %% ex: ts=4 sw=4 ft=erlang et %% == Erlang Compiler == -{minimum_otp_vsn, "21.0"}. +{minimum_otp_vsn, "23"}. %% Erlang compiler options -{erl_opts, [ warn_unused_vars - , ewarn_export_all - , warn_shadow_vars - , warn_unused_import - , warn_unused_function - , warn_bif_clash - , warn_unused_record - , warn_deprecated_function - , warn_obsolete_guard - , strict_validation - , warn_export_vars - , warn_exported_vars - , warn_missing_spec - , warn_untyped_record - , debug_info - ]}. +{erl_opts, + [warn_unused_vars, + ewarn_export_all, + warn_shadow_vars, + warn_unused_import, + warn_unused_function, + warn_bif_clash, + warn_unused_record, + warn_deprecated_function, + warn_obsolete_guard, + strict_validation, + warn_export_vars, + warn_exported_vars, + warn_missing_spec, + warn_untyped_record, + debug_info]}. -{profiles, [{test, [{deps, [ {katana_test, "1.0.1"} - , {katana, "0.4.0"} - , {mixer, "1.1.0", {pkg, inaka_mixer}} - , {meck, "0.8.13"} - ] - }] - }] -}. +{profiles, + [{test, + [{deps, [{katana, "1.0.0"}, {mixer, "1.2.0", {pkg, inaka_mixer}}, {meck, "0.9.2"}]}]}]}. -{ct_compile_opts, [ warn_unused_vars - , warn_export_all - , warn_shadow_vars - , warn_unused_import - , warn_unused_function - , warn_bif_clash - , warn_unused_record - , warn_deprecated_function - , warn_obsolete_guard - , strict_validation - , warn_export_vars - , warn_exported_vars - , warn_missing_spec - , warn_untyped_record - , debug_info - ]}. +{ct_compile_opts, + [warn_unused_vars, + warn_export_all, + warn_shadow_vars, + warn_unused_import, + warn_unused_function, + warn_bif_clash, + warn_unused_record, + warn_deprecated_function, + warn_obsolete_guard, + strict_validation, + warn_export_vars, + warn_exported_vars, + warn_missing_spec, + warn_untyped_record, + debug_info]}. {ct_opts, []}. {alias, [{test, [dialyzer, ct, cover]}]}. -{ct_extra_params,"-no_auto_compile -dir ebin -logdir log/ct --erl_args -smp enable -boot start_sasl"}. +{ct_extra_params, + "-no_auto_compile -dir ebin -logdir log/ct --erl_args -smp enable -boot start_sasl"}. -{edoc_opts, [ {report_missing_types, true} - , {source_path, ["src"]} - , {report_missing_types, true} - , {todo, true} - , {packages, false} - , {subpackages, false} - ]}. +{edoc_opts, + [{report_missing_types, true}, + {source_path, ["src"]}, + {report_missing_types, true}, + {todo, true}, + {packages, false}, + {subpackages, false}]}. -{dialyzer, [ {warnings, [ race_conditions - , no_return - , unmatched_returns - , error_handling - , unknown - ]} - , {plt_apps, all_deps} - , {plt_extra_apps, [erts, kernel, stdlib]} - , {plt_location, local} - , {base_plt_apps, [stdlib, kernel]} - , {base_plt_location, global} - ]}. +{dialyzer, + [{warnings, + [race_conditions, unknown, no_return, unmatched_returns, error_handling, underspecs]}]}. + +{project_plugins, + [{rebar3_hex, "~> 6.11.7"}, + {rebar3_format, "~> 1.0.1"}, + {rebar3_lint, "~> 0.5.0"}, + {rebar3_hank, "~> 1.2.2"}, + rebar3_depup]}. + +{cover_enabled, true}. + +{cover_opts, [verbose]}. + +{alias, + [{test, [compile, format, lint, hank, dialyzer, {ct, "--verbose"}, cover, edoc]}]}. + +{format, [{files, ["*.config", "src/*", "test/*"]}]}. diff --git a/src/worker_pool.app.src b/src/worker_pool.app.src index c60fdbb..c24d631 100644 --- a/src/worker_pool.app.src +++ b/src/worker_pool.app.src @@ -14,20 +14,19 @@ % specific language governing permissions and limitations % under the License. -{ application -, worker_pool -, [ {description, "Erlang Worker Pool"} - , {vsn, "4.0.3"} - , {id, "worker_pool"} - , {registered, []} - , {modules, []} - , {applications, [kernel, stdlib]} - , {mod, {wpool, []}} - , {env, []} - , {licenses, ["Apache2"]} - , {links, [ {"Github", "https://github.com/inaka/worker_pool"} - , {"Blog Post", "https://web.archive.org/web/20170602054156/http://inaka.net/blog/2014/09/25/worker-pool/"} - ]} - , {build_tools,["rebar3"]} - ] -}. +{application, + worker_pool, + [{description, "Erlang Worker Pool"}, + {vsn, "4.0.3"}, + {id, "worker_pool"}, + {registered, []}, + {modules, []}, + {applications, [kernel, stdlib]}, + {mod, {wpool, []}}, + {env, []}, + {licenses, ["Apache2"]}, + {links, + [{"Github", "https://github.com/inaka/worker_pool"}, + {"Blog Post", + "https://web.archive.org/web/20170602054156/http://inaka.net/blog/2014/09/25/worker-pool/"}]}, + {build_tools, ["rebar3"]}]}. diff --git a/src/wpool.erl b/src/wpool.erl index 7ab8af9..7ccf742 100644 --- a/src/wpool.erl +++ b/src/wpool.erl @@ -15,167 +15,152 @@ %%% @doc Worker pool main interface. %%% Use functions provided by this module to manage your pools of workers -module(wpool). --author('elbrujohalcon@inaka.net'). --define(DEFAULTS, [ {overrun_warning, infinity} - , {max_overrun_warnings, infinity} - , {overrun_handler, {error_logger, warning_report}} - , {workers, 100}, {worker_opt, []}, - {queue_type, fifo} - ]). +-behaviour(application). + +-define(DEFAULTS, + [{overrun_warning, infinity}, + {max_overrun_warnings, infinity}, + {overrun_handler, {error_logger, warning_report}}, + {workers, 100}, + {worker_opt, []}, + {queue_type, fifo}]). %% Copied from gen.erl --type debug_flag() :: 'trace' | 'log' | 'statistics' | 'debug' - | {'logfile', string()}. --type gen_option() :: {'timeout', timeout()} - | {'debug', [debug_flag()]} - | {'spawn_opt', [proc_lib:spawn_option()]}. +-type debug_flag() :: trace | log | statistics | debug | {logfile, string()}. +-type gen_option() :: + {timeout, timeout()} | {debug, [debug_flag()]} | {spawn_opt, [proc_lib:spawn_option()]}. -type gen_options() :: [gen_option()]. - -type name() :: atom(). --type supervisor_strategy() :: { supervisor:strategy() - , non_neg_integer() - , pos_integer() - }. --type option() :: {overrun_warning, infinity|pos_integer()} - | {max_overrun_warnings, infinity|pos_integer()} - | {overrun_handler, {Module::atom(), Fun::atom()}} - | {workers, pos_integer()} - | {worker_opt, gen_options()} - | {worker, {Module::atom(), InitArg::term()}} - | {strategy, supervisor_strategy()} - | {worker_type, gen_server} - | {pool_sup_intensity, non_neg_integer()} - | {pool_sup_period, non_neg_integer()} - | {queue_type, wpool_queue_manager:queue_type()} - . --type custom_strategy() :: fun(([atom()])-> Atom::atom()). --type strategy() :: best_worker - | random_worker - | next_worker - | available_worker - | next_available_worker - | {hash_worker, term()} - | custom_strategy(). --type worker_stats() :: [ {messsage_queue_len, non_neg_integer()} - | {memory, pos_integer()} - ]. --type stats() :: [ {pool, name()} - | {supervisor, pid()} - | {options, [option()]} - | {size, non_neg_integer()} - | {next_worker, pos_integer()} - | {total_message_queue_len, non_neg_integer()} - | {workers, [{pos_integer(), worker_stats()}]} - ]. --export_type([ name/0 - , option/0 - , custom_strategy/0 - , strategy/0 - , worker_stats/0 - , stats/0 - ]). - --export([ start/0 - , start/2 - , stop/0 - , stop/1 - ]). --export([ start_pool/1 - , start_pool/2 - , start_sup_pool/1 - , start_sup_pool/2 - ]). --export([ stop_pool/1 - , stop_sup_pool/1 - ]). --export([ call/2 - , cast/2 - , call/3 - , cast/3 - , call/4 - , broadcast/2 - ]). --export([ stats/0 - , stats/1 - ]). --export([ default_strategy/0 - ]). +-type supervisor_strategy() :: {supervisor:strategy(), non_neg_integer(), pos_integer()}. +-type option() :: + {overrun_warning, infinity | pos_integer()} | + {max_overrun_warnings, infinity | pos_integer()} | + {overrun_handler, {Module :: atom(), Fun :: atom()}} | + {workers, pos_integer()} | + {worker_opt, gen_options()} | + {worker, {Module :: atom(), InitArg :: term()}} | + {strategy, supervisor_strategy()} | + {worker_type, gen_server} | + {pool_sup_intensity, non_neg_integer()} | + {pool_sup_period, non_neg_integer()} | + {queue_type, wpool_queue_manager:queue_type()}. +-type custom_strategy() :: fun(([atom()]) -> Atom :: atom()). +-type strategy() :: + best_worker | + random_worker | + next_worker | + available_worker | + next_available_worker | + {hash_worker, term()} | + custom_strategy(). +-type worker_stats() :: + [{messsage_queue_len, non_neg_integer()} | {memory, pos_integer()}]. +-type stats() :: + [{pool, name()} | + {supervisor, pid()} | + {options, [option()]} | + {size, non_neg_integer()} | + {next_worker, pos_integer()} | + {total_message_queue_len, non_neg_integer()} | + {workers, [{pos_integer(), worker_stats()}]}]. + +-export_type([name/0, option/0, custom_strategy/0, strategy/0, worker_stats/0, stats/0]). + +-export([start/0, start/2, stop/0, stop/1]). +-export([start_pool/1, start_pool/2, start_sup_pool/1, start_sup_pool/2]). +-export([stop_pool/1, stop_sup_pool/1]). +-export([call/2, cast/2, call/3, cast/3, call/4, broadcast/2]). +-export([stats/0, stats/1]). +-export([default_strategy/0]). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% ADMIN API %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% @doc Starts the application -spec start() -> ok | {error, {already_started, ?MODULE}}. -start() -> application:start(worker_pool). +start() -> + application:start(worker_pool). %% @doc Stops the application -spec stop() -> ok. -stop() -> application:stop(worker_pool). +stop() -> + application:stop(worker_pool). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% BEHAVIOUR CALLBACKS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% @private -spec start(any(), any()) -> {ok, pid()} | {error, term()}. -start(_StartType, _StartArgs) -> wpool_sup:start_link(). +start(_StartType, _StartArgs) -> + wpool_sup:start_link(). %% @private -spec stop(any()) -> ok. -stop(_State) -> ok. +stop(_State) -> + ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% PUBLIC API %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% @equiv start_pool(Name, []) -spec start_pool(name()) -> {ok, pid()}. -start_pool(Name) -> start_pool(Name, []). +start_pool(Name) -> + start_pool(Name, []). %% @doc Starts (and links) a pool of N wpool_processes. %% The result pid belongs to a supervisor (in case you want to add it to a %% supervisor tree) -spec start_pool(name(), [option()]) -> - {ok, pid()} | {error, {already_started, pid()} | term()}. -start_pool(Name, Options) -> wpool_pool:start_link(Name, all_opts(Options)). + {ok, pid()} | {error, {already_started, pid()} | term()}. +start_pool(Name, Options) -> + wpool_pool:start_link(Name, all_opts(Options)). %% @doc Stops the pool -spec stop_pool(name()) -> true. stop_pool(Name) -> - case whereis(Name) of - undefined -> true; - Pid -> exit(Pid, normal) - end. + case whereis(Name) of + undefined -> + true; + Pid -> + exit(Pid, normal) + end. %% @equiv start_sup_pool(Name, []) --spec start_sup_pool(name()) -> - {ok, pid()} | {error, {already_started, pid()} | term()}. -start_sup_pool(Name) -> start_sup_pool(Name, []). +-spec start_sup_pool(name()) -> {ok, pid()} | {error, {already_started, pid()} | term()}. +start_sup_pool(Name) -> + start_sup_pool(Name, []). %% @doc Starts a pool of N wpool_processes supervised by {@link wpool_sup} -spec start_sup_pool(name(), [option()]) -> - {ok, pid()} | {error, {already_started, pid()} | term()}. + {ok, pid()} | {error, {already_started, pid()} | term()}. start_sup_pool(Name, Options) -> - wpool_sup:start_pool(Name, all_opts(Options)). + wpool_sup:start_pool(Name, all_opts(Options)). %% @doc Stops the pool -spec stop_sup_pool(name()) -> ok. -stop_sup_pool(Name) -> wpool_sup:stop_pool(Name). +stop_sup_pool(Name) -> + wpool_sup:stop_pool(Name). %% @doc Default strategy -spec default_strategy() -> strategy(). default_strategy() -> - case application:get_env(worker_pool, default_strategy) of - undefined -> available_worker; - {ok, Strategy} -> Strategy - end. + case application:get_env(worker_pool, default_strategy) of + undefined -> + available_worker; + {ok, Strategy} -> + Strategy + end. %% @equiv call(Sup, Call, default_strategy()) -spec call(name(), term()) -> term(). -call(Sup, Call) -> call(Sup, Call, default_strategy()). +call(Sup, Call) -> + call(Sup, Call, default_strategy()). %% @equiv call(Sup, Call, Strategy, 5000) -spec call(name(), term(), strategy()) -> term(). -call(Sup, Call, Strategy) -> call(Sup, Call, Strategy, 5000). +call(Sup, Call, Strategy) -> + call(Sup, Call, Strategy, 5000). %% @doc Picks a server and issues the call to it. %% For all strategies except available_worker, Timeout applies only to the @@ -184,43 +169,51 @@ call(Sup, Call, Strategy) -> call(Sup, Call, Strategy, 5000). %% For available_worker the time used choosing a worker is also considered -spec call(name(), term(), strategy(), timeout()) -> term(). call(Sup, Call, available_worker, Timeout) -> - wpool_pool:call_available_worker(Sup, Call, Timeout); + wpool_pool:call_available_worker(Sup, Call, Timeout); call(Sup, Call, {hash_worker, HashKey}, Timeout) -> - wpool_process:call(wpool_pool:hash_worker(Sup, HashKey), Call, Timeout); + wpool_process:call( + wpool_pool:hash_worker(Sup, HashKey), Call, Timeout); call(Sup, Call, Fun, Timeout) when is_function(Fun) -> - wpool_process:call(Fun(Sup), Call, Timeout); + wpool_process:call(Fun(Sup), Call, Timeout); call(Sup, Call, Strategy, Timeout) -> - wpool_process:call(wpool_pool:Strategy(Sup), Call, Timeout). + wpool_process:call( + wpool_pool:Strategy(Sup), Call, Timeout). %% @equiv cast(Sup, Cast, default_strategy()) -spec cast(name(), term()) -> ok. -cast(Sup, Cast) -> cast(Sup, Cast, default_strategy()). +cast(Sup, Cast) -> + cast(Sup, Cast, default_strategy()). %% @doc Picks a server and issues the cast to it -spec cast(name(), term(), strategy()) -> ok. cast(Sup, Cast, available_worker) -> - wpool_pool:cast_to_available_worker(Sup, Cast); + wpool_pool:cast_to_available_worker(Sup, Cast); cast(Sup, Cast, {hash_worker, HashKey}) -> - wpool_process:cast(wpool_pool:hash_worker(Sup, HashKey), Cast); + wpool_process:cast( + wpool_pool:hash_worker(Sup, HashKey), Cast); cast(Sup, Cast, Fun) when is_function(Fun) -> - wpool_process:cast(Fun(Sup), Cast); + wpool_process:cast(Fun(Sup), Cast); cast(Sup, Cast, Strategy) -> - wpool_process:cast(wpool_pool:Strategy(Sup), Cast). + wpool_process:cast( + wpool_pool:Strategy(Sup), Cast). %% @doc Retrieves a snapshot of the pool stats -spec stats() -> [stats()]. -stats() -> wpool_pool:stats(). +stats() -> + wpool_pool:stats(). %% @doc Retrieves a snapshot of a given pool stats -spec stats(name()) -> stats(). -stats(Sup) -> wpool_pool:stats(Sup). +stats(Sup) -> + wpool_pool:stats(Sup). %% @doc Casts a message to all the workers within the given pool. -spec broadcast(wpool:name(), term()) -> ok. broadcast(Sup, Cast) -> - wpool_pool:broadcast(Sup, Cast). + wpool_pool:broadcast(Sup, Cast). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% PRIVATE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -all_opts(Options) -> Options ++ ?DEFAULTS. +all_opts(Options) -> + Options ++ ?DEFAULTS. diff --git a/src/wpool_pool.erl b/src/wpool_pool.erl index f06c224..6594832 100644 --- a/src/wpool_pool.erl +++ b/src/wpool_pool.erl @@ -15,52 +15,31 @@ %%% @doc A pool of workers. If you want to put it in your supervisor tree, %%% remember it's a supervisor. -module(wpool_pool). --author('elbrujohalcon@inaka.net'). -behaviour(supervisor). %% API --export([ start_link/2 - , create_table/0 - ]). --export([ best_worker/1 - , random_worker/1 - , next_worker/1 - , hash_worker/2 - , next_available_worker/1 - , call_available_worker/3 - , time_checker_name/1 - ]). --export([ cast_to_available_worker/2 - , broadcast/2 - ]). --export([ stats/0 - , stats/1 - ]). --export([ worker_name/2 - , find_wpool/1 - , all/0 - ]). --export([ next/2 - , wpool_get/2 - ]). --export([ add_callback_module/2 - , remove_callback_module/2 - ]). - +-export([start_link/2, create_table/0]). +-export([best_worker/1, random_worker/1, next_worker/1, hash_worker/2, + next_available_worker/1, call_available_worker/3, time_checker_name/1]). +-export([cast_to_available_worker/2, broadcast/2]). +-export([stats/0, stats/1]). +-export([worker_name/2, find_wpool/1, all/0]). +-export([next/2, wpool_get/2]). +-export([add_callback_module/2, remove_callback_module/2]). %% Supervisor callbacks --export([ init/1 - ]). +-export([init/1]). --record(wpool, { name :: wpool:name() - , size :: pos_integer() - , next :: pos_integer() - , opts :: [wpool:option()] - , qmanager :: wpool_queue_manager:queue_mgr() - , born = os:timestamp() :: erlang:timestamp() - }). +-record(wpool, + {name :: wpool:name(), + size :: pos_integer(), + next :: pos_integer(), + opts :: [wpool:option()], + qmanager :: wpool_queue_manager:queue_mgr(), + born = os:timestamp() :: erlang:timestamp()}). -opaque wpool() :: #wpool{}. + -export_type([wpool/0]). %% =================================================================== @@ -69,72 +48,80 @@ %% @doc Creates the ets table that will hold the information about active pools -spec create_table() -> ok. create_table() -> - _ = ets:new( - ?MODULE, - [public, named_table, set, - {read_concurrency, true}, {keypos, #wpool.name}]), - ok. + _ = ets:new(?MODULE, + [public, named_table, set, {read_concurrency, true}, {keypos, #wpool.name}]), + ok. %% @doc Starts a supervisor with several {@link wpool_process}es as its children -spec start_link(wpool:name(), [wpool:option()]) -> - {ok, pid()} | {error, {already_started, pid()} | term()}. + {ok, pid()} | {error, {already_started, pid()} | term()}. start_link(Name, Options) -> - supervisor:start_link({local, Name}, ?MODULE, {Name, Options}). + supervisor:start_link({local, Name}, ?MODULE, {Name, Options}). %% @doc Picks the worker with the smaller queue of messages. %% @throws no_workers -spec best_worker(wpool:name()) -> atom(). best_worker(Sup) -> - case find_wpool(Sup) of - undefined -> exit(no_workers); - Wpool -> min_message_queue(Wpool) - end. + case find_wpool(Sup) of + undefined -> + exit(no_workers); + Wpool -> + min_message_queue(Wpool) + end. %% @doc Picks a random worker %% @throws no_workers -spec random_worker(wpool:name()) -> atom(). random_worker(Sup) -> - case wpool_size(Sup) of - undefined -> exit(no_workers); - WpoolSize -> - WorkerNumber = rand:uniform(WpoolSize), - worker_name(Sup, WorkerNumber) - end. + case wpool_size(Sup) of + undefined -> + exit(no_workers); + WpoolSize -> + WorkerNumber = rand:uniform(WpoolSize), + worker_name(Sup, WorkerNumber) + end. %% @doc Picks the next worker in a round robin fashion %% @throws no_workers -spec next_worker(wpool:name()) -> atom(). next_worker(Sup) -> - case move_wpool(Sup) of - undefined -> exit(no_workers); - Next -> worker_name(Sup, Next) - end. + case move_wpool(Sup) of + undefined -> + exit(no_workers); + Next -> + worker_name(Sup, Next) + end. %% @doc Picks the first available worker, if any %% @throws no_workers | no_available_workers -spec next_available_worker(wpool:name()) -> atom(). next_available_worker(Sup) -> - case find_wpool(Sup) of - undefined -> exit(no_workers); - Wpool -> - case worker_with_no_task(Wpool) of - undefined -> exit(no_available_workers); - Worker -> Worker - end - end. + case find_wpool(Sup) of + undefined -> + exit(no_workers); + Wpool -> + case worker_with_no_task(Wpool) of + undefined -> + exit(no_available_workers); + Worker -> + Worker + end + end. %% @doc Picks the first available worker and sends the call to it. %% The timeout provided includes the time it takes to get a worker %% and for it to process the call. %% @throws no_workers | timeout --spec call_available_worker(wpool:name(), any(), timeout()) -> any(). +-spec call_available_worker(wpool:name(), any(), timeout()) -> atom(). call_available_worker(Sup, Call, Timeout) -> - case wpool_queue_manager:call_available_worker( - queue_manager_name(Sup), Call, Timeout) of - noproc -> exit(no_workers); - timeout -> exit(timeout); - Result -> Result - end. + case wpool_queue_manager:call_available_worker(queue_manager_name(Sup), Call, Timeout) of + noproc -> + exit(no_workers); + timeout -> + exit(timeout); + Result -> + Result + end. %% @doc Picks a worker base on a hash result. %% 
phash2(Term, Range)
returns hash = integer, @@ -142,12 +129,13 @@ call_available_worker(Sup, Call, Timeout) -> %% @throws no_workers -spec hash_worker(wpool:name(), term()) -> atom(). hash_worker(Sup, HashKey) -> - case wpool_size(Sup) of - undefined -> exit(no_workers); - WpoolSize -> - Index = 1 + erlang:phash2(HashKey, WpoolSize), - worker_name(Sup, Index) - end. + case wpool_size(Sup) of + undefined -> + exit(no_workers); + WpoolSize -> + Index = 1 + erlang:phash2(HashKey, WpoolSize), + worker_name(Sup, Index) + end. %% @doc Casts a message to the first available worker. %% Since we can wait forever for a wpool:cast to be delivered @@ -155,352 +143,370 @@ hash_worker(Sup, HashKey) -> %% just forwards the cast when it gets the worker -spec cast_to_available_worker(wpool:name(), term()) -> ok. cast_to_available_worker(Sup, Cast) -> - wpool_queue_manager:cast_to_available_worker(queue_manager_name(Sup), Cast). + wpool_queue_manager:cast_to_available_worker(queue_manager_name(Sup), Cast). %% @doc Casts a message to all the workers within the given pool. -spec broadcast(wpool:name(), term()) -> ok. broadcast(Sup, Cast) -> - lists:foreach( fun(Worker) -> ok = wpool_process:cast(Worker, Cast) end - , all_workers(Sup) - ). + lists:foreach(fun(Worker) -> ok = wpool_process:cast(Worker, Cast) end, all_workers(Sup)). -spec all() -> [wpool:name()]. all() -> - [Name || #wpool{name = Name} <- ets:tab2list(?MODULE) - , find_wpool(Name) /= undefined]. + [Name || #wpool{name = Name} <- ets:tab2list(?MODULE), find_wpool(Name) /= undefined]. %% @doc Retrieves the pool stats for all pools -spec stats() -> [wpool:stats()]. -stats() -> [stats(Sup) || Sup <- all()]. +stats() -> + [stats(Sup) || Sup <- all()]. %% @doc Retrieves a snapshot of the pool stats %% @throws no_workers -spec stats(wpool:name()) -> wpool:stats(). stats(Sup) -> - case find_wpool(Sup) of - undefined -> exit(no_workers); - Wpool -> - stats(Wpool, Sup) - end. + case find_wpool(Sup) of + undefined -> + exit(no_workers); + Wpool -> + stats(Wpool, Sup) + end. stats(Wpool, Sup) -> - {Total, WorkerStats} = - lists:foldl( - fun(N, {T, L}) -> - case worker_info(Sup, N, [ message_queue_len - , memory - , current_function - , current_location - , dictionary - ]) of - undefined -> - {T, L}; - [{message_queue_len, MQL} = MQLT, Memory, Function, Location, {dictionary, Dictionary}] -> - WS = [MQLT, Memory] ++ - function_location(Function, Location) ++ - task(proplists:get_value(wpool_task, Dictionary)), - {T + MQL, [{N, WS} | L]} - end - end, {0, []}, lists:seq(1, Wpool#wpool.size)), - PendingTasks = wpool_queue_manager:pending_task_count(Wpool#wpool.qmanager), - [ {pool, Sup} - , {supervisor, erlang:whereis(Sup)} - , {options, lists:ukeysort(1, proplists:unfold(Wpool#wpool.opts))} - , {size, Wpool#wpool.size} - , {next_worker, Wpool#wpool.next} - , {total_message_queue_len, Total + PendingTasks} - , {workers, WorkerStats} - ]. + {Total, WorkerStats} = + lists:foldl(fun(N, {T, L}) -> + case worker_info(Sup, + N, + [message_queue_len, + memory, + current_function, + current_location, + dictionary]) + of + undefined -> + {T, L}; + [{message_queue_len, MQL} = MQLT, + Memory, + Function, + Location, + {dictionary, Dictionary}] -> + WS = [MQLT, Memory] + ++ function_location(Function, Location) + ++ task(proplists:get_value(wpool_task, Dictionary)), + {T + MQL, [{N, WS} | L]} + end + end, + {0, []}, + lists:seq(1, Wpool#wpool.size)), + PendingTasks = wpool_queue_manager:pending_task_count(Wpool#wpool.qmanager), + [{pool, Sup}, + {supervisor, erlang:whereis(Sup)}, + {options, lists:ukeysort(1, proplists:unfold(Wpool#wpool.opts))}, + {size, Wpool#wpool.size}, + {next_worker, Wpool#wpool.next}, + {total_message_queue_len, Total + PendingTasks}, + {workers, WorkerStats}]. worker_info(Sup, N, Info) -> - case erlang:whereis(worker_name(Sup, N)) of - undefined -> - undefined; - Worker -> - erlang:process_info(Worker, Info) - end. + case erlang:whereis(worker_name(Sup, N)) of + undefined -> + undefined; + Worker -> + erlang:process_info(Worker, Info) + end. function_location({current_function, {gen_server, loop, _}}, _) -> - []; + []; function_location({current_function, {erlang, hibernate, _}}, _) -> - []; + []; function_location(Function, Location) -> - [Function, Location]. + [Function, Location]. + task(undefined) -> - []; + []; task({_TaskId, Started, Task}) -> - Time = - calendar:datetime_to_gregorian_seconds(calendar:universal_time()), - [{task, Task}, {runtime, Time - Started}]. + Time = + calendar:datetime_to_gregorian_seconds( + calendar:universal_time()), + [{task, Task}, {runtime, Time - Started}]. %% @doc the number of workers in the pool -spec wpool_size(atom()) -> non_neg_integer() | undefined. wpool_size(Name) -> - try ets:update_counter(?MODULE, Name, {#wpool.size, 0}) of - WpoolSize -> - case erlang:whereis(Name) of - undefined -> - ets:delete(?MODULE, Name), - undefined; - _ -> - WpoolSize - end - catch - _:badarg -> - case build_wpool(Name) of - undefined -> undefined; - Wpool -> Wpool#wpool.size - end - end. - + try ets:update_counter(?MODULE, Name, {#wpool.size, 0}) of + WpoolSize -> + case erlang:whereis(Name) of + undefined -> + ets:delete(?MODULE, Name), + undefined; + _ -> + WpoolSize + end + catch + _:badarg -> + case build_wpool(Name) of + undefined -> + undefined; + Wpool -> + Wpool#wpool.size + end + end. %% @doc Set next within the worker pool record. Useful when using %% a custom strategy function. -spec next(pos_integer(), wpool()) -> wpool(). -next(Next, WPool) -> WPool#wpool{next = Next}. +next(Next, WPool) -> + WPool#wpool{next = Next}. -spec add_callback_module(wpool:name(), module()) -> ok | {error, term()}. add_callback_module(Pool, Module) -> - EventManager = event_manager_name(Pool), - wpool_process_callbacks:add_callback_module(EventManager, Module). + EventManager = event_manager_name(Pool), + wpool_process_callbacks:add_callback_module(EventManager, Module). -spec remove_callback_module(wpool:name(), module()) -> ok | {error, term()}. remove_callback_module(Pool, Module) -> - EventManager = event_manager_name(Pool), - wpool_process_callbacks:remove_callback_module(EventManager, Module). + EventManager = event_manager_name(Pool), + wpool_process_callbacks:remove_callback_module(EventManager, Module). %% @doc Get values from the worker pool record. Useful when using a custom %% strategy function. --spec wpool_get(atom(), wpool()) -> any(); ([atom()], wpool()) -> any(). -wpool_get(List, WPool) when is_list(List)-> - [g(Atom, WPool) || Atom <- List]; +-spec wpool_get(atom(), wpool()) -> any(); + ([atom()], wpool()) -> any(). +wpool_get(List, WPool) when is_list(List) -> + [g(Atom, WPool) || Atom <- List]; wpool_get(Atom, WPool) when is_atom(Atom) -> - g(Atom, WPool). - -g(name, #wpool{name=Ret}) -> Ret; -g(size, #wpool{size=Ret}) -> Ret; -g(next, #wpool{next=Ret}) -> Ret; -g(opts, #wpool{opts=Ret}) -> Ret; -g(qmanager, #wpool{qmanager=Ret}) -> Ret; -g(born, #wpool{born=Ret}) -> Ret. + g(Atom, WPool). + +g(name, #wpool{name = Ret}) -> + Ret; +g(size, #wpool{size = Ret}) -> + Ret; +g(next, #wpool{next = Ret}) -> + Ret; +g(opts, #wpool{opts = Ret}) -> + Ret; +g(qmanager, #wpool{qmanager = Ret}) -> + Ret; +g(born, #wpool{born = Ret}) -> + Ret. -spec time_checker_name(wpool:name()) -> atom(). time_checker_name(Sup) -> - list_to_atom( - ?MODULE_STRING ++ [$-|atom_to_list(Sup)] ++ "-time-checker"). + list_to_atom(?MODULE_STRING ++ [$- | atom_to_list(Sup)] ++ "-time-checker"). %% =================================================================== %% Supervisor callbacks %% =================================================================== %% @private -spec init({wpool:name(), [wpool:option()]}) -> - {ok, {supervisor:sup_flags(), [supervisor:child_spec()]}}. + {ok, {supervisor:sup_flags(), [supervisor:child_spec()]}}. init({Name, Options}) -> - Workers = proplists:get_value(workers, Options, 100), - QueueType = proplists:get_value(queue_type, Options), - OverrunHandler = - proplists:get_value( - overrun_handler, Options, {error_logger, warning_report}), - TimeChecker = time_checker_name(Name), - QueueManager = queue_manager_name(Name), - ProcessSup = process_sup_name(Name), - EventManagerName = event_manager_name(Name), - _Wpool = - store_wpool( - #wpool{ name = Name - , size = Workers - , next = 1 - , opts = Options - , qmanager = QueueManager - }), - TimeCheckerSpec = - { TimeChecker - , {wpool_time_checker, start_link, [Name, TimeChecker, OverrunHandler]} - , permanent - , brutal_kill - , worker - , [wpool_time_checker] - }, - QueueManagerSpec = - { QueueManager - , {wpool_queue_manager, start_link, [Name, QueueManager, - [{queue_type, QueueType}]] - } - , permanent - , brutal_kill - , worker - , [wpool_queue_manager] - }, - - EventManagerSpec = - { EventManagerName - , {gen_event, start_link, [{local, EventManagerName}]} - , permanent - , brutal_kill - , worker - , dynamic - }, - - SupShutdown = proplists:get_value(pool_sup_shutdown, Options, brutal_kill), - WorkerOpts = - [{queue_manager, QueueManager}, {time_checker, TimeChecker} - | Options] ++ maybe_event_manager(Options, {event_manager, EventManagerName}), - ProcessSupSpec = - { ProcessSup - , {wpool_process_sup, start_link, [Name, ProcessSup, WorkerOpts]} - , permanent - , SupShutdown - , supervisor - , [wpool_process_sup] - }, - - Children = [TimeCheckerSpec, QueueManagerSpec] ++ - maybe_event_manager(Options, EventManagerSpec) ++ - [ProcessSupSpec], - - SupIntensity = proplists:get_value(pool_sup_intensity, Options, 5), - SupPeriod = proplists:get_value(pool_sup_period, Options, 60), - SupStrategy = {one_for_all, SupIntensity, SupPeriod}, - {ok, {SupStrategy, Children}}. + Workers = proplists:get_value(workers, Options, 100), + QueueType = proplists:get_value(queue_type, Options), + OverrunHandler = + proplists:get_value(overrun_handler, Options, {error_logger, warning_report}), + TimeChecker = time_checker_name(Name), + QueueManager = queue_manager_name(Name), + ProcessSup = process_sup_name(Name), + EventManagerName = event_manager_name(Name), + _Wpool = + store_wpool(#wpool{name = Name, + size = Workers, + next = 1, + opts = Options, + qmanager = QueueManager}), + TimeCheckerSpec = + {TimeChecker, + {wpool_time_checker, start_link, [Name, TimeChecker, OverrunHandler]}, + permanent, + brutal_kill, + worker, + [wpool_time_checker]}, + QueueManagerSpec = + {QueueManager, + {wpool_queue_manager, start_link, [Name, QueueManager, [{queue_type, QueueType}]]}, + permanent, + brutal_kill, + worker, + [wpool_queue_manager]}, + + EventManagerSpec = + {EventManagerName, + {gen_event, start_link, [{local, EventManagerName}]}, + permanent, + brutal_kill, + worker, + dynamic}, + + SupShutdown = proplists:get_value(pool_sup_shutdown, Options, brutal_kill), + WorkerOpts = + [{queue_manager, QueueManager}, {time_checker, TimeChecker} | Options] + ++ maybe_event_manager(Options, {event_manager, EventManagerName}), + ProcessSupSpec = + {ProcessSup, + {wpool_process_sup, start_link, [Name, ProcessSup, WorkerOpts]}, + permanent, + SupShutdown, + supervisor, + [wpool_process_sup]}, + + Children = + [TimeCheckerSpec, QueueManagerSpec] + ++ maybe_event_manager(Options, EventManagerSpec) + ++ [ProcessSupSpec], + + SupIntensity = proplists:get_value(pool_sup_intensity, Options, 5), + SupPeriod = proplists:get_value(pool_sup_period, Options, 60), + SupStrategy = {one_for_all, SupIntensity, SupPeriod}, + {ok, {SupStrategy, Children}}. %% @private -spec worker_name(wpool:name(), pos_integer()) -> atom(). worker_name(Sup, I) -> - list_to_atom( - ?MODULE_STRING ++ [$-|atom_to_list(Sup)] ++ [$-| integer_to_list(I)]). + list_to_atom(?MODULE_STRING ++ [$- | atom_to_list(Sup)] ++ [$- | integer_to_list(I)]). %% =================================================================== %% Private functions %% =================================================================== process_sup_name(Sup) -> - list_to_atom(?MODULE_STRING ++ [$-|atom_to_list(Sup)] ++ "-process-sup"). + list_to_atom(?MODULE_STRING ++ [$- | atom_to_list(Sup)] ++ "-process-sup"). + queue_manager_name(Sup) -> - list_to_atom(?MODULE_STRING ++ [$-|atom_to_list(Sup)] ++ "-queue-manager"). + list_to_atom(?MODULE_STRING ++ [$- | atom_to_list(Sup)] ++ "-queue-manager"). + event_manager_name(Sup) -> - list_to_atom(?MODULE_STRING ++ [$-|atom_to_list(Sup)] ++ "-event-manager"). + list_to_atom(?MODULE_STRING ++ [$- | atom_to_list(Sup)] ++ "-event-manager"). worker_with_no_task(Wpool) -> - %% Moving the beginning of the list to a random point to ensure that clients - %% do not always start asking for process_info to the processes that are most - %% likely to have bigger message queues - First = rand:uniform(Wpool#wpool.size), - worker_with_no_task(0, Wpool#wpool{next = First}). + %% Moving the beginning of the list to a random point to ensure that clients + %% do not always start asking for process_info to the processes that are most + %% likely to have bigger message queues + First = rand:uniform(Wpool#wpool.size), + worker_with_no_task(0, Wpool#wpool{next = First}). + worker_with_no_task(Size, #wpool{size = Size}) -> - undefined; + undefined; worker_with_no_task(Checked, Wpool) -> - Worker = worker_name(Wpool#wpool.name, Wpool#wpool.next), - case try_process_info(whereis(Worker), [message_queue_len, dictionary]) of - [{message_queue_len, 0}, {dictionary, Dictionary}] -> - case proplists:get_value(wpool_task, Dictionary) of - undefined -> Worker; - _ -> worker_with_no_task(Checked + 1, next_wpool(Wpool)) - end; - _ -> - worker_with_no_task(Checked + 1, next_wpool(Wpool)) - end. + Worker = worker_name(Wpool#wpool.name, Wpool#wpool.next), + case try_process_info(whereis(Worker), [message_queue_len, dictionary]) of + [{message_queue_len, 0}, {dictionary, Dictionary}] -> + case proplists:get_value(wpool_task, Dictionary) of + undefined -> + Worker; + _ -> + worker_with_no_task(Checked + 1, next_wpool(Wpool)) + end; + _ -> + worker_with_no_task(Checked + 1, next_wpool(Wpool)) + end. try_process_info(undefined, _) -> - []; + []; try_process_info(Pid, Keys) -> - erlang:process_info(Pid, Keys). + erlang:process_info(Pid, Keys). min_message_queue(Wpool) -> - %% Moving the beginning of the list to a random point to ensure that clients - %% do not always start asking for process_info to the processes that are most - %% likely to have bigger message queues - First = rand:uniform(Wpool#wpool.size), - min_message_queue(0, Wpool#wpool{next = First}, []). + %% Moving the beginning of the list to a random point to ensure that clients + %% do not always start asking for process_info to the processes that are most + %% likely to have bigger message queues + First = rand:uniform(Wpool#wpool.size), + min_message_queue(0, Wpool#wpool{next = First}, []). + min_message_queue(Size, #wpool{size = Size}, Found) -> - {_, Worker} = lists:min(Found), - Worker; + {_, Worker} = lists:min(Found), + Worker; min_message_queue(Checked, Wpool, Found) -> - Worker = worker_name(Wpool#wpool.name, Wpool#wpool.next), - QLength = queue_length(whereis(Worker)), - min_message_queue(Checked + 1, next_wpool(Wpool), - [{QLength, Worker} | Found]). + Worker = worker_name(Wpool#wpool.name, Wpool#wpool.next), + QLength = queue_length(whereis(Worker)), + min_message_queue(Checked + 1, next_wpool(Wpool), [{QLength, Worker} | Found]). queue_length(undefined) -> - infinity; + infinity; queue_length(Pid) when is_pid(Pid) -> - case erlang:process_info(Pid, message_queue_len) of - {message_queue_len, L} -> L; - undefined -> infinity - end. + case erlang:process_info(Pid, message_queue_len) of + {message_queue_len, L} -> + L; + undefined -> + infinity + end. -spec all_workers(wpool:name()) -> [atom()]. all_workers(Wpool) -> - WPoolSize = wpool_size(Wpool), - case WPoolSize of - undefined -> exit(no_workers); - _ -> [wpool_pool:worker_name(Wpool, N) || N <- lists:seq(1, WPoolSize)] - end. + WPoolSize = wpool_size(Wpool), + case WPoolSize of + undefined -> + exit(no_workers); + _ -> + [wpool_pool:worker_name(Wpool, N) || N <- lists:seq(1, WPoolSize)] + end. %% =================================================================== %% ETS functions %% =================================================================== store_wpool(Wpool) -> - true = ets:insert(?MODULE, Wpool), - Wpool. + true = ets:insert(?MODULE, Wpool), + Wpool. move_wpool(Name) -> - try - WpoolSize = ets:update_counter(?MODULE, Name, {#wpool.size, 0}), - ets:update_counter(?MODULE, Name, {#wpool.next, 1, WpoolSize, 1}) - catch - _:badarg -> - case build_wpool(Name) of - undefined -> undefined; - Wpool -> Wpool#wpool.next - end - end. + try + WpoolSize = ets:update_counter(?MODULE, Name, {#wpool.size, 0}), + ets:update_counter(?MODULE, Name, {#wpool.next, 1, WpoolSize, 1}) + catch + _:badarg -> + case build_wpool(Name) of + undefined -> + undefined; + Wpool -> + Wpool#wpool.next + end + end. %% @doc Use this function to get the Worker pool record in a custom worker. -spec find_wpool(atom()) -> undefined | wpool(). find_wpool(Name) -> - try ets:lookup(?MODULE, Name) of - [Wpool | _] -> - case erlang:whereis(Name) of - undefined -> - ets:delete(?MODULE, Name), - undefined; + try ets:lookup(?MODULE, Name) of + [Wpool | _] -> + case erlang:whereis(Name) of + undefined -> + ets:delete(?MODULE, Name), + undefined; + _ -> + Wpool + end; _ -> - Wpool - end; - _ -> build_wpool(Name) - catch - _:badarg -> - build_wpool(Name) - end. + build_wpool(Name) + catch + _:badarg -> + build_wpool(Name) + end. %% @doc We use this function not to report an error if for some reason we've %% lost the record on the ets table. This SHOULDN'T be called too much build_wpool(Name) -> - error_logger:warning_msg( - "Building a #wpool record for ~p. Something must have failed.", [Name]), - try supervisor:count_children(process_sup_name(Name)) of - Children -> - Size = proplists:get_value(active, Children, 0), - Wpool = - #wpool{ name = Name - , size = Size - , next = 1 - , opts = [] - , qmanager = queue_manager_name(Name) - }, - store_wpool(Wpool) - catch - _:Error -> - error_logger:warning_msg("Wpool ~p not found: ~p", [Name, Error]), - undefined - end. + error_logger:warning_msg("Building a #wpool record for ~p. Something must have failed.", + [Name]), + try supervisor:count_children(process_sup_name(Name)) of + Children -> + Size = proplists:get_value(active, Children, 0), + Wpool = + #wpool{name = Name, + size = Size, + next = 1, + opts = [], + qmanager = queue_manager_name(Name)}, + store_wpool(Wpool) + catch + _:Error -> + error_logger:warning_msg("Wpool ~p not found: ~p", [Name, Error]), + undefined + end. next_wpool(Wpool) -> - Wpool#wpool{next = (Wpool#wpool.next rem Wpool#wpool.size) + 1}. + Wpool#wpool{next = Wpool#wpool.next rem Wpool#wpool.size + 1}. maybe_event_manager(Options, Item) -> - EnableEventManager = proplists:get_value(enable_callbacks, Options, false), - case EnableEventManager of - true -> - [Item]; - _ -> [] - end. + EnableEventManager = proplists:get_value(enable_callbacks, Options, false), + case EnableEventManager of + true -> + [Item]; + _ -> + [] + end. diff --git a/src/wpool_process.erl b/src/wpool_process.erl index e27cf01..2f6b379 100644 --- a/src/wpool_process.erl +++ b/src/wpool_process.erl @@ -15,264 +15,262 @@ %%% @doc Decorator over {@link gen_server} that lets {@link wpool_pool} %%% control certain aspects of the execution -module(wpool_process). --author('elbrujohalcon@inaka.net'). -behaviour(gen_server). --record(state, {name :: atom(), - mod :: atom(), - state :: term(), - options :: [ {time_checker|queue_manager, atom()} - | wpool:option() - ] - }). --type state() :: #state{}. +-record(state, + {name :: atom(), + mod :: atom(), + state :: term(), + options :: [{time_checker | queue_manager, atom()} | wpool:option()]}). +-type state() :: #state{}. -type from() :: {pid(), reference()}. -type next_step() :: timeout() | hibernate | {continue, term()}. %% api --export([ start_link/4 - , call/3 - , cast/2 - , cast_call/3 - ]). - +-export([start_link/4, call/3, cast/2, cast_call/3]). %% gen_server callbacks --export([ init/1 - , terminate/2 - , code_change/3 - , handle_call/3 - , handle_cast/2 - , handle_info/2 - , handle_continue/2 - , format_status/2 - ]). +-export([init/1, terminate/2, code_change/3, handle_call/3, handle_cast/2, handle_info/2, + handle_continue/2, format_status/2]). %%%=================================================================== %%% API %%%=================================================================== %% @doc Starts a named process -spec start_link(wpool:name(), module(), term(), [wpool:option()]) -> - {ok, pid()} | ignore | {error, {already_started, pid()} | term()}. + {ok, pid()} | ignore | {error, {already_started, pid()} | term()}. start_link(Name, Module, InitArgs, Options) -> - WorkerOpt = proplists:get_value(worker_opt, Options, []), - gen_server:start_link( - {local, Name}, ?MODULE, {Name, Module, InitArgs, Options}, WorkerOpt). + WorkerOpt = proplists:get_value(worker_opt, Options, []), + gen_server:start_link({local, Name}, + ?MODULE, + {Name, Module, InitArgs, Options}, + WorkerOpt). %% @equiv gen_server:call(Process, Call, Timeout) -spec call(wpool:name() | pid(), term(), timeout()) -> term(). -call(Process, Call, Timeout) -> gen_server:call(Process, Call, Timeout). +call(Process, Call, Timeout) -> + gen_server:call(Process, Call, Timeout). %% @equiv gen_server:cast(Process, {cast, Cast}) -spec cast(wpool:name() | pid(), term()) -> ok. -cast(Process, Cast) -> gen_server:cast(Process, {cast, Cast}). +cast(Process, Cast) -> + gen_server:cast(Process, {cast, Cast}). %% @equiv gen_server:cast(Process, {call, From, Call}) -spec cast_call(wpool:name() | pid(), from(), term()) -> ok. cast_call(Process, From, Call) -> - gen_server:cast(Process, {call, From, Call}). + gen_server:cast(Process, {call, From, Call}). %%%=================================================================== %%% init, terminate, code_change, info callbacks %%%=================================================================== %% @private -spec init({atom(), atom(), term(), [wpool:option()]}) -> - {ok, state()} | {ok, state(), next_step()} | {stop, can_not_ignore} | {stop, term()}. + {ok, state()} | {ok, state(), next_step()} | {stop, can_not_ignore} | {stop, term()}. init({Name, Mod, InitArgs, Options}) -> - wpool_process_callbacks:notify(handle_init_start, Options, [Name]), + wpool_process_callbacks:notify(handle_init_start, Options, [Name]), - case Mod:init(InitArgs) of - {ok, ModState} -> - ok = wpool_utils:notify_queue_manager(new_worker, Name, Options), - wpool_process_callbacks:notify(handle_worker_creation, Options, [Name]), - {ok, #state{ name = Name - , mod = Mod - , state = ModState - , options = Options - }}; - {ok, ModState, NextStep} -> - ok = wpool_utils:notify_queue_manager(new_worker, Name, Options), - wpool_process_callbacks:notify(handle_worker_creation, Options, [Name]), - {ok, #state{ name = Name - , mod = Mod - , state = ModState - , options = Options - }, NextStep}; - ignore -> {stop, can_not_ignore}; - Error -> Error - end. + case Mod:init(InitArgs) of + {ok, ModState} -> + ok = wpool_utils:notify_queue_manager(new_worker, Name, Options), + wpool_process_callbacks:notify(handle_worker_creation, Options, [Name]), + {ok, + #state{name = Name, + mod = Mod, + state = ModState, + options = Options}}; + {ok, ModState, NextStep} -> + ok = wpool_utils:notify_queue_manager(new_worker, Name, Options), + wpool_process_callbacks:notify(handle_worker_creation, Options, [Name]), + {ok, + #state{name = Name, + mod = Mod, + state = ModState, + options = Options}, + NextStep}; + ignore -> + {stop, can_not_ignore}; + Error -> + Error + end. %% @private -spec terminate(atom(), state()) -> term(). terminate(Reason, State) -> - #state{mod=Mod, state=ModState, name=Name, options=Options} = State, - ok = wpool_utils:notify_queue_manager(worker_dead, Name, Options), - wpool_process_callbacks:notify(handle_worker_death, Options, [Name, Reason]), - Mod:terminate(Reason, ModState). + #state{mod = Mod, + state = ModState, + name = Name, + options = Options} = + State, + ok = wpool_utils:notify_queue_manager(worker_dead, Name, Options), + wpool_process_callbacks:notify(handle_worker_death, Options, [Name, Reason]), + Mod:terminate(Reason, ModState). %% @private -spec code_change(string(), state(), any()) -> {ok, state()} | {error, term()}. code_change(OldVsn, State, Extra) -> - case (State#state.mod):code_change(OldVsn, State#state.state, Extra) of - {ok, NewState} -> {ok, State#state{state = NewState}}; - Error -> {error, Error} - end. + case (State#state.mod):code_change(OldVsn, State#state.state, Extra) of + {ok, NewState} -> + {ok, State#state{state = NewState}}; + Error -> + {error, Error} + end. %% @private -spec handle_info(any(), state()) -> - {noreply, state()} | {noreply, state(), next_step()} | {stop, term(), state()}. + {noreply, state()} | {noreply, state(), next_step()} | {stop, term(), state()}. handle_info(Info, State) -> - try (State#state.mod):handle_info(Info, State#state.state) of - {noreply, NewState} -> - {noreply, State#state{state = NewState}}; - {noreply, NewState, NextStep} -> - {noreply, State#state{state = NewState}, NextStep}; - {stop, Reason, NewState} -> - {stop, Reason, State#state{state = NewState}} - catch - _:{noreply, NewState} -> - {noreply, State#state{state = NewState}}; - _:{noreply, NewState, NextStep} -> - {noreply, State#state{state = NewState}, NextStep}; - _:{stop, Reason, NewState} -> - {stop, Reason, State#state{state = NewState}} - end. + try (State#state.mod):handle_info(Info, State#state.state) of + {noreply, NewState} -> + {noreply, State#state{state = NewState}}; + {noreply, NewState, NextStep} -> + {noreply, State#state{state = NewState}, NextStep}; + {stop, Reason, NewState} -> + {stop, Reason, State#state{state = NewState}} + catch + _:{noreply, NewState} -> + {noreply, State#state{state = NewState}}; + _:{noreply, NewState, NextStep} -> + {noreply, State#state{state = NewState}, NextStep}; + _:{stop, Reason, NewState} -> + {stop, Reason, State#state{state = NewState}} + end. %% @private -spec handle_continue(any(), state()) -> - {noreply, state()} | {noreply, state(), next_step()} | {stop, term(), state()}. + {noreply, state()} | + {noreply, state(), next_step()} | + {stop, term(), state()}. handle_continue(Continue, State) -> - try (State#state.mod):handle_continue(Continue, State#state.state) of - {noreply, NewState} -> - {noreply, State#state{state = NewState}}; - {noreply, NewState, NextStep} -> - {noreply, State#state{state = NewState}, NextStep}; - {stop, Reason, NewState} -> - {stop, Reason, State#state{state = NewState}} - catch - _:{noreply, NewState} -> - {noreply, State#state{state = NewState}}; - _:{noreply, NewState, NextStep} -> - {noreply, State#state{state = NewState}, NextStep}; - _:{stop, Reason, NewState} -> - {stop, Reason, State#state{state = NewState}} - end. + try (State#state.mod):handle_continue(Continue, State#state.state) of + {noreply, NewState} -> + {noreply, State#state{state = NewState}}; + {noreply, NewState, NextStep} -> + {noreply, State#state{state = NewState}, NextStep}; + {stop, Reason, NewState} -> + {stop, Reason, State#state{state = NewState}} + catch + _:{noreply, NewState} -> + {noreply, State#state{state = NewState}}; + _:{noreply, NewState, NextStep} -> + {noreply, State#state{state = NewState}, NextStep}; + _:{stop, Reason, NewState} -> + {stop, Reason, State#state{state = NewState}} + end. %% @private -spec format_status(normal | terminate, [[{_, _}] | state(), ...]) -> term(). format_status(Opt, [PDict, State]) -> - case erlang:function_exported(State#state.mod, format_status, 2) of - false -> - case Opt of % This is copied from gen_server:format_status/4 - terminate -> State#state.state; - normal -> [{data, [{"State", State#state.state}]}] - end; - true -> - (State#state.mod):format_status(Opt, [PDict, State#state.state]) - end. + case erlang:function_exported(State#state.mod, format_status, 2) of + false -> + case Opt % This is copied from gen_server:format_status/4 + of + terminate -> + State#state.state; + normal -> + [{data, [{"State", State#state.state}]}] + end; + true -> + (State#state.mod):format_status(Opt, [PDict, State#state.state]) + end. %%%=================================================================== %%% real (i.e. interesting) callbacks %%%=================================================================== %% @private -spec handle_cast(term(), state()) -> - {noreply, state()} | {noreply, state(), next_step()} | {stop, term(), state()}. + {noreply, state()} | {noreply, state(), next_step()} | {stop, term(), state()}. handle_cast({call, From, Call}, State) -> - case handle_call(Call, From, State) of - {reply, Response, NewState} -> - gen_server:reply(From, Response), - {noreply, NewState}; - {reply, Response, NewState, NextStep} -> - gen_server:reply(From, Response), - {noreply, NewState, NextStep}; - {stop, Reason, Response, NewState} -> - gen_server:reply(From, Response), - {stop, Reason, NewState}; - Reply -> Reply - end; + case handle_call(Call, From, State) of + {reply, Response, NewState} -> + gen_server:reply(From, Response), + {noreply, NewState}; + {reply, Response, NewState, NextStep} -> + gen_server:reply(From, Response), + {noreply, NewState, NextStep}; + {stop, Reason, Response, NewState} -> + gen_server:reply(From, Response), + {stop, Reason, NewState}; + Reply -> + Reply + end; handle_cast({cast, Cast}, State) -> - Task = - wpool_utils:task_init( - {cast, Cast}, - proplists:get_value(time_checker, State#state.options, undefined), - proplists:get_value(overrun_warning, State#state.options, infinity), - proplists:get_value(max_overrun_warnings, State#state.options, infinity)), - ok = wpool_utils:notify_queue_manager(worker_busy - , State#state.name - , State#state.options), - Reply = - try (State#state.mod):handle_cast(Cast, State#state.state) of - {noreply, NewState} -> - {noreply, State#state{state = NewState}}; - {noreply, NewState, NextStep} -> - {noreply, State#state{state = NewState}, NextStep}; - {stop, Reason, NewState} -> - {stop, Reason, State#state{state = NewState}} - catch - _:{noreply, NewState} -> - {noreply, State#state{state = NewState}}; - _:{noreply, NewState, NextStep} -> - {noreply, State#state{state = NewState}, NextStep}; - _:{stop, Reason, NewState} -> - {stop, Reason, State#state{state = NewState}} - end, - wpool_utils:task_end(Task), - ok = - wpool_utils:notify_queue_manager(worker_ready - , State#state.name - , State#state.options), - Reply. + Task = + wpool_utils:task_init({cast, Cast}, + proplists:get_value(time_checker, State#state.options, undefined), + proplists:get_value(overrun_warning, State#state.options, infinity), + proplists:get_value(max_overrun_warnings, + State#state.options, + infinity)), + ok = wpool_utils:notify_queue_manager(worker_busy, State#state.name, State#state.options), + Reply = + try (State#state.mod):handle_cast(Cast, State#state.state) of + {noreply, NewState} -> + {noreply, State#state{state = NewState}}; + {noreply, NewState, NextStep} -> + {noreply, State#state{state = NewState}, NextStep}; + {stop, Reason, NewState} -> + {stop, Reason, State#state{state = NewState}} + catch + _:{noreply, NewState} -> + {noreply, State#state{state = NewState}}; + _:{noreply, NewState, NextStep} -> + {noreply, State#state{state = NewState}, NextStep}; + _:{stop, Reason, NewState} -> + {stop, Reason, State#state{state = NewState}} + end, + wpool_utils:task_end(Task), + ok = + wpool_utils:notify_queue_manager(worker_ready, State#state.name, State#state.options), + Reply. %% @private -spec handle_call(term(), from(), state()) -> - {reply, term(), state()} - | {reply, term(), state(), next_step()} - | {noreply, state()} - | {noreply, state(), next_step()} - | {stop, term(), term(), state()} - | {stop, term(), state()}. + {reply, term(), state()} | + {reply, term(), state(), next_step()} | + {noreply, state()} | + {noreply, state(), next_step()} | + {stop, term(), term(), state()} | + {stop, term(), state()}. handle_call(Call, From, State) -> - Task = - wpool_utils:task_init( - {call, Call}, - proplists:get_value(time_checker, State#state.options, undefined), - proplists:get_value(overrun_warning, State#state.options, infinity), - proplists:get_value(max_overrun_warnings, State#state.options, infinity)), - ok = wpool_utils:notify_queue_manager(worker_busy - , State#state.name - , State#state.options), - Reply = - try (State#state.mod):handle_call(Call, From, State#state.state) of - {noreply, NewState} -> - {noreply, State#state{state = NewState}}; - {noreply, NewState, NextStep} -> - {noreply, State#state{state = NewState}, NextStep}; - {reply, Response, NewState} -> - {reply, Response, State#state{state = NewState}}; - {reply, Response, NewState, NextStep} -> - {reply, Response, State#state{state = NewState}, NextStep}; - {stop, Reason, NewState} -> - {stop, Reason, State#state{state = NewState}}; - {stop, Reason, Response, NewState} -> - {stop, Reason, Response, State#state{state = NewState}} - catch - _:{noreply, NewState} -> - {noreply, State#state{state = NewState}}; - _:{noreply, NewState, NextStep} -> - {noreply, State#state{state = NewState}, NextStep}; - _:{reply, Response, NewState} -> - {reply, Response, State#state{state = NewState}}; - _:{reply, Response, NewState, NextStep} -> - {reply, Response, State#state{state = NewState}, NextStep}; - _:{stop, Reason, NewState} -> - {stop, Reason, State#state{state = NewState}}; - _:{stop, Reason, Response, NewState} -> - {stop, Reason, Response, State#state{state = NewState}} - end, - wpool_utils:task_end(Task), - ok = - wpool_utils:notify_queue_manager(worker_ready - , State#state.name - , State#state.options), - Reply. + Task = + wpool_utils:task_init({call, Call}, + proplists:get_value(time_checker, State#state.options, undefined), + proplists:get_value(overrun_warning, State#state.options, infinity), + proplists:get_value(max_overrun_warnings, + State#state.options, + infinity)), + ok = wpool_utils:notify_queue_manager(worker_busy, State#state.name, State#state.options), + Reply = + try (State#state.mod):handle_call(Call, From, State#state.state) of + {noreply, NewState} -> + {noreply, State#state{state = NewState}}; + {noreply, NewState, NextStep} -> + {noreply, State#state{state = NewState}, NextStep}; + {reply, Response, NewState} -> + {reply, Response, State#state{state = NewState}}; + {reply, Response, NewState, NextStep} -> + {reply, Response, State#state{state = NewState}, NextStep}; + {stop, Reason, NewState} -> + {stop, Reason, State#state{state = NewState}}; + {stop, Reason, Response, NewState} -> + {stop, Reason, Response, State#state{state = NewState}} + catch + _:{noreply, NewState} -> + {noreply, State#state{state = NewState}}; + _:{noreply, NewState, NextStep} -> + {noreply, State#state{state = NewState}, NextStep}; + _:{reply, Response, NewState} -> + {reply, Response, State#state{state = NewState}}; + _:{reply, Response, NewState, NextStep} -> + {reply, Response, State#state{state = NewState}, NextStep}; + _:{stop, Reason, NewState} -> + {stop, Reason, State#state{state = NewState}}; + _:{stop, Reason, Response, NewState} -> + {stop, Reason, Response, State#state{state = NewState}} + end, + wpool_utils:task_end(Task), + ok = + wpool_utils:notify_queue_manager(worker_ready, State#state.name, State#state.options), + Reply. diff --git a/src/wpool_process_callbacks.erl b/src/wpool_process_callbacks.erl index 52f9788..eaf2edf 100644 --- a/src/wpool_process_callbacks.erl +++ b/src/wpool_process_callbacks.erl @@ -2,83 +2,76 @@ -behaviour(gen_event). -%% gen_event callbacks +%% The callbacks are called in an extremely dynamic from call/3. +-hank([unused_callbacks]). --export([ init/1 - , handle_event/2 - , handle_call/2 - ]). +-export([init/1, handle_event/2, handle_call/2]). +-export([notify/3, add_callback_module/2, remove_callback_module/2]). --export([ notify/3 - , add_callback_module/2 - , remove_callback_module/2 - ]). -type state() :: module(). - -type event() :: handle_init_start | handle_worker_creation | handle_worker_death. -callback handle_init_start(wpool:name()) -> any(). -callback handle_worker_creation(wpool:name()) -> any(). -callback handle_worker_death(wpool:name(), term()) -> any(). --optional_callbacks([handle_init_start/1, handle_worker_creation/1, handle_worker_death/2]). +-optional_callbacks([handle_init_start/1, handle_worker_creation/1, + handle_worker_death/2]). -spec init(module()) -> {ok, state()}. init(Module) -> - {ok, Module}. + {ok, Module}. -spec handle_event({event(), [any()]}, state()) -> {ok, state()}. handle_event({Event, Args}, Module) -> - call(Module, Event, Args), - {ok, Module}. + call(Module, Event, Args), + {ok, Module}. -spec handle_call(Msg, state()) -> {ok, {error, {unexpected_call, Msg}}, state()}. handle_call(Msg, State) -> - {ok, {error, {unexpected_call, Msg}}, State}. + {ok, {error, {unexpected_call, Msg}}, State}. -spec notify(event(), [wpool:option()], [any()]) -> ok. notify(Event, Options, Args) -> - case lists:keyfind(event_manager, 1, Options) of - {event_manager, EventMgr} -> - gen_event:notify(EventMgr, {Event, Args}); - _ -> - ok - end. + case lists:keyfind(event_manager, 1, Options) of + {event_manager, EventMgr} -> + gen_event:notify(EventMgr, {Event, Args}); + _ -> + ok + end. -spec add_callback_module(wpool:name(), module()) -> ok | {error, any()}. add_callback_module(EventManager, Module) -> - case ensure_loaded(Module) of - ok -> - gen_event:add_handler(EventManager, - {wpool_process_callbacks, Module}, Module); - Other -> - Other - end. - + case ensure_loaded(Module) of + ok -> + gen_event:add_handler(EventManager, {wpool_process_callbacks, Module}, Module); + Other -> + Other + end. -spec remove_callback_module(wpool:name(), module()) -> ok | {error, any()}. remove_callback_module(EventManager, Module) -> - gen_event:delete_handler(EventManager, {wpool_process_callbacks, Module}, Module). + gen_event:delete_handler(EventManager, {wpool_process_callbacks, Module}, Module). call(Module, Event, Args) -> - try - case erlang:function_exported(Module, Event, length(Args)) of - true -> - erlang:apply(Module, Event, Args); - _ -> - ok - end - catch - E:R -> - error_logger:warning_msg("Could not call callback module, error:~p, reason:~p", [E, R]) - end. + try + case erlang:function_exported(Module, Event, length(Args)) of + true -> + erlang:apply(Module, Event, Args); + _ -> + ok + end + catch + E:R -> + error_logger:warning_msg("Could not call callback module, error:~p, reason:~p", [E, R]) + end. ensure_loaded(Module) -> - case code:ensure_loaded(Module) of - {module, Module} -> - ok; - {error, embedded} -> %% We are in embedded mode so the module was loaded if exists - ok; - Other -> - Other - end. + case code:ensure_loaded(Module) of + {module, Module} -> + ok; + {error, embedded} -> %% We are in embedded mode so the module was loaded if exists + ok; + Other -> + Other + end. diff --git a/src/wpool_process_sup.erl b/src/wpool_process_sup.erl index 5bf5375..24b58ef 100644 --- a/src/wpool_process_sup.erl +++ b/src/wpool_process_sup.erl @@ -13,66 +13,59 @@ % under the License. %%% @hidden -module(wpool_process_sup). --author('elbrujohalcon@inaka.net'). -behaviour(supervisor). %% API -export([start_link/3]). - %% Supervisor callbacks -export([init/1]). %% @private -spec start_link(wpool:name(), atom(), [wpool:option()]) -> {ok, pid()}. start_link(Parent, Name, Options) -> - supervisor:start_link({local, Name}, ?MODULE, {Parent, Options}). + supervisor:start_link({local, Name}, ?MODULE, {Parent, Options}). %% @private -spec init({wpool:name(), [wpool:option()]}) -> - {ok, {supervisor:sup_flags(), [supervisor:child_spec()]}}. + {ok, {supervisor:sup_flags(), [supervisor:child_spec()]}}. init({Name, Options}) -> - Workers = proplists:get_value(workers, Options, 100), - Strategy = proplists:get_value(strategy, Options, {one_for_one, 5, 60}), - maybe_add_event_handler(Options), - {WorkerType, Worker, InitArgs} = - case proplists:get_value(worker_type, Options, gen_server) of - gen_server -> - {W, IA} = - proplists:get_value(worker, Options, {wpool_worker, undefined}), - {wpool_process, W, IA} - %% We'll eventually add more types (like gen_statem), - %% that's why this case remains - end, - WorkerShutdown = proplists:get_value(worker_shutdown, Options, 5000), - WorkerSpecs = - [ { wpool_pool:worker_name(Name, I) - , { WorkerType - , start_link - , [wpool_pool:worker_name(Name, I), Worker, InitArgs, Options] - } - , permanent - , WorkerShutdown - , worker - , [Worker] - } || I <- lists:seq(1, Workers)], - {ok, {Strategy, WorkerSpecs}}. + Workers = proplists:get_value(workers, Options, 100), + Strategy = proplists:get_value(strategy, Options, {one_for_one, 5, 60}), + maybe_add_event_handler(Options), + {WorkerType, Worker, InitArgs} = + case proplists:get_value(worker_type, Options, gen_server) of + gen_server -> + {W, IA} = proplists:get_value(worker, Options, {wpool_worker, undefined}), + {wpool_process, W, IA} + end, + %% We'll eventually add more types (like gen_statem), + %% that's why this case remains + WorkerShutdown = proplists:get_value(worker_shutdown, Options, 5000), + WorkerSpecs = + [{wpool_pool:worker_name(Name, I), + {WorkerType, start_link, [wpool_pool:worker_name(Name, I), Worker, InitArgs, Options]}, + permanent, + WorkerShutdown, + worker, + [Worker]} + || I <- lists:seq(1, Workers)], + {ok, {Strategy, WorkerSpecs}}. maybe_add_event_handler(Options) -> - case proplists:get_value(event_manager, Options, undefined) of - undefined -> - ok; - EventMgr -> - lists:foreach(fun(M) -> add_initial_callback(EventMgr, M) end, - proplists:get_value(callbacks, Options, [])) - end. + case proplists:get_value(event_manager, Options, undefined) of + undefined -> + ok; + EventMgr -> + lists:foreach(fun(M) -> add_initial_callback(EventMgr, M) end, + proplists:get_value(callbacks, Options, [])) + end. add_initial_callback(EventManager, Module) -> - case wpool_process_callbacks:add_callback_module(EventManager, Module) of - ok -> - ok; - Other -> - error_logger:warning_msg("The callback module:~p could not be loaded, reason:~p", - [Module, Other]) - end. - + case wpool_process_callbacks:add_callback_module(EventManager, Module) of + ok -> + ok; + Other -> + error_logger:warning_msg("The callback module:~p could not be loaded, reason:~p", + [Module, Other]) + end. diff --git a/src/wpool_queue_manager.erl b/src/wpool_queue_manager.erl index 55144d8..de17ecf 100644 --- a/src/wpool_queue_manager.erl +++ b/src/wpool_queue_manager.erl @@ -13,49 +13,33 @@ % under the License. %%% @hidden -module(wpool_queue_manager). --author('elbrujohalcon@inaka.net'). -behaviour(gen_server). %% api --export([ start_link/2 - , start_link/3 - ]). --export([ call_available_worker/3 - , cast_to_available_worker/2 - , new_worker/2 - , worker_dead/2 - , worker_ready/2 - , worker_busy/2 - , pending_task_count/1 - ]). - +-export([start_link/2, start_link/3]). +-export([call_available_worker/3, cast_to_available_worker/2, new_worker/2, worker_dead/2, + worker_ready/2, worker_busy/2, pending_task_count/1]). %% gen_server callbacks --export([ init/1 - , terminate/2 - , code_change/3 - , handle_call/3 - , handle_cast/2 - , handle_info/2 - ]). +-export([init/1, handle_call/3, handle_cast/2, handle_info/2]). --record(state, { wpool :: wpool:name() - , clients :: queue:queue({cast|{pid(), _}, term()}) - , workers :: gb_sets:set(atom()) - , monitors :: gb_trees:tree(atom(), monitored_from()) - , queue_type :: queue_type() - }). --type state() :: #state{}. +-record(state, + {wpool :: wpool:name(), + clients :: queue:queue({cast | {pid(), _}, term()}), + workers :: gb_sets:set(atom()), + monitors :: gb_trees:tree(atom(), monitored_from()), + queue_type :: queue_type()}). +-type state() :: #state{}. -type from() :: {pid(), reference()}. -type monitored_from() :: {reference(), from()}. -type options() :: [{option(), term()}]. -type option() :: queue_type. -type args() :: [{arg(), term()}]. -type arg() :: option() | pool. - -type queue_mgr() :: atom(). -type queue_type() :: fifo | lifo. + -export_type([queue_mgr/0, queue_type/0]). %%%=================================================================== @@ -63,37 +47,33 @@ %%%=================================================================== %% @equiv start_link(WPool, Name, []) -spec start_link(wpool:name(), queue_mgr()) -> - {ok, pid()} | {error, {already_started, pid()} | term()}. + {ok, pid()} | {error, {already_started, pid()} | term()}. start_link(WPool, Name) -> - start_link(WPool, Name, []). + start_link(WPool, Name, []). %% @private -spec start_link(wpool:name(), queue_mgr(), options()) -> - {ok, pid()} | {error, {already_started, pid()} | term()}. + {ok, pid()} | {error, {already_started, pid()} | term()}. start_link(WPool, Name, Options) -> - gen_server:start_link({local, Name}, ?MODULE, [{pool, WPool} | Options], - []). + gen_server:start_link({local, Name}, ?MODULE, [{pool, WPool} | Options], []). %% @doc returns the first available worker in the pool --spec call_available_worker(queue_mgr(), any(), timeout()) -> - noproc | timeout | atom(). +-spec call_available_worker(queue_mgr(), any(), timeout()) -> noproc | timeout | any(). call_available_worker(QueueManager, Call, Timeout) -> - Expires = expires(Timeout), - try - gen_server:call(QueueManager, {available_worker, Call, Expires}, Timeout) - of - {'EXIT', _, noproc} -> - noproc; - {'EXIT', Worker, Exit} -> - exit({Exit, {gen_server, call, [Worker, Call, Timeout]}}); - Result -> - Result - catch - _:{noproc, {gen_server, call, _}} -> - noproc; - _:{timeout, {gen_server, call, _}} -> - timeout - end. + Expires = expires(Timeout), + try gen_server:call(QueueManager, {available_worker, Call, Expires}, Timeout) of + {'EXIT', _, noproc} -> + noproc; + {'EXIT', Worker, Exit} -> + exit({Exit, {gen_server, call, [Worker, Call, Timeout]}}); + Result -> + Result + catch + _:{noproc, {gen_server, call, _}} -> + noproc; + _:{timeout, {gen_server, call, _}} -> + timeout + end. %% @doc Casts a message to the first available worker. %% Since we can wait forever for a wpool:cast to be delivered @@ -101,33 +81,33 @@ call_available_worker(QueueManager, Call, Timeout) -> %% just forwards the cast when it gets the worker -spec cast_to_available_worker(queue_mgr(), term()) -> ok. cast_to_available_worker(QueueManager, Cast) -> - gen_server:cast(QueueManager, {cast_to_available_worker, Cast}). + gen_server:cast(QueueManager, {cast_to_available_worker, Cast}). %% @doc Mark a brand new worker as available -spec new_worker(queue_mgr(), atom()) -> ok. new_worker(QueueManager, Worker) -> - gen_server:cast(QueueManager, {new_worker, Worker}). + gen_server:cast(QueueManager, {new_worker, Worker}). %% @doc Mark a worker as available -spec worker_ready(queue_mgr(), atom()) -> ok. worker_ready(QueueManager, Worker) -> - gen_server:cast(QueueManager, {worker_ready, Worker}). + gen_server:cast(QueueManager, {worker_ready, Worker}). %% @doc Mark a worker as no longer available -spec worker_busy(queue_mgr(), atom()) -> ok. worker_busy(QueueManager, Worker) -> - gen_server:cast(QueueManager, {worker_busy, Worker}). + gen_server:cast(QueueManager, {worker_busy, Worker}). %% @doc Decrement the total number of workers -spec worker_dead(queue_mgr(), atom()) -> ok. worker_dead(QueueManager, Worker) -> - gen_server:cast(QueueManager, {worker_dead, Worker}). + gen_server:cast(QueueManager, {worker_dead, Worker}). %% @doc Retrieves the number of pending tasks (used for stats) %% @see wpool_pool:stats/1 -spec pending_task_count(queue_mgr()) -> non_neg_integer(). pending_task_count(QueueManager) -> - gen_server:call(QueueManager, pending_task_count). + gen_server:call(QueueManager, pending_task_count). %%%=================================================================== %%% gen_server callbacks @@ -135,142 +115,147 @@ pending_task_count(QueueManager) -> %% @private -spec init(args()) -> {ok, state()}. init(Args) -> - WPool = proplists:get_value(pool, Args), - QueueType = proplists:get_value(queue_type, Args), - put(pending_tasks, 0), - {ok, #state{wpool = WPool, clients = queue:new(), - workers = gb_sets:new(), monitors = gb_trees:empty(), - queue_type = QueueType}}. + WPool = proplists:get_value(pool, Args), + QueueType = proplists:get_value(queue_type, Args), + put(pending_tasks, 0), + {ok, + #state{wpool = WPool, + clients = queue:new(), + workers = gb_sets:new(), + monitors = gb_trees:empty(), + queue_type = QueueType}}. -type worker_event() :: new_worker | worker_dead | worker_busy | worker_ready. + %% @private -spec handle_cast({worker_event(), atom()}, state()) -> {noreply, state()}. handle_cast({new_worker, Worker}, State) -> - handle_cast({worker_ready, Worker}, State); + handle_cast({worker_ready, Worker}, State); handle_cast({worker_dead, Worker}, #state{workers = Workers} = State) -> - NewWorkers = gb_sets:delete_any(Worker, Workers), - {noreply, State#state{workers = NewWorkers}}; + NewWorkers = gb_sets:delete_any(Worker, Workers), + {noreply, State#state{workers = NewWorkers}}; handle_cast({worker_busy, Worker}, #state{workers = Workers} = State) -> - {noreply, State#state{workers = gb_sets:delete_any(Worker, Workers)}}; + {noreply, State#state{workers = gb_sets:delete_any(Worker, Workers)}}; handle_cast({worker_ready, Worker}, State0) -> - #state{workers = Workers, clients = Clients, monitors = Mons, - queue_type = QueueType} = State0, - State = case gb_trees:is_defined(Worker, Mons) of - true -> - {Ref, _Client} = gb_trees:get(Worker, Mons), - demonitor(Ref, [flush]), - State0#state{monitors = gb_trees:delete(Worker, Mons)}; - false -> - State0 - end, - case queue_out(Clients, QueueType) of - {empty, _Clients} -> - {noreply, State#state{workers = gb_sets:add(Worker, Workers)}}; - {{value, {cast, Cast}}, NewClients} -> - dec_pending_tasks(), - ok = wpool_process:cast(Worker, Cast), - {noreply, State#state{clients = NewClients}}; - {{value, {Client = {ClientPid, _}, Call, Expires}}, NewClients} -> - dec_pending_tasks(), - NewState = State#state{clients = NewClients}, - case is_process_alive(ClientPid) andalso - Expires > now_in_microseconds() of + #state{workers = Workers, + clients = Clients, + monitors = Mons, + queue_type = QueueType} = + State0, + State = + case gb_trees:is_defined(Worker, Mons) of + true -> + {Ref, _Client} = gb_trees:get(Worker, Mons), + demonitor(Ref, [flush]), + State0#state{monitors = gb_trees:delete(Worker, Mons)}; + false -> + State0 + end, + case queue_out(Clients, QueueType) of + {empty, _Clients} -> + {noreply, State#state{workers = gb_sets:add(Worker, Workers)}}; + {{value, {cast, Cast}}, NewClients} -> + dec_pending_tasks(), + ok = wpool_process:cast(Worker, Cast), + {noreply, State#state{clients = NewClients}}; + {{value, {Client = {ClientPid, _}, Call, Expires}}, NewClients} -> + dec_pending_tasks(), + NewState = State#state{clients = NewClients}, + case is_process_alive(ClientPid) andalso Expires > now_in_microseconds() of + true -> + MonitorState = monitor_worker(Worker, Client, NewState), + ok = wpool_process:cast_call(Worker, Client, Call), + {noreply, MonitorState}; + false -> + handle_cast({worker_ready, Worker}, NewState) + end + end; +handle_cast({cast_to_available_worker, Cast}, State) -> + #state{workers = Workers, clients = Clients} = State, + case gb_sets:is_empty(Workers) of true -> - MonitorState = monitor_worker(Worker, Client, NewState), - ok = wpool_process:cast_call(Worker, Client, Call), - {noreply, MonitorState}; + inc_pending_tasks(), + {noreply, State#state{clients = queue:in({cast, Cast}, Clients)}}; false -> - handle_cast({worker_ready, Worker}, NewState) - end - end; -handle_cast({cast_to_available_worker, Cast}, State) -> - #state{workers = Workers, clients = Clients} = State, - case gb_sets:is_empty(Workers) of - true -> - inc_pending_tasks(), - {noreply, State#state{clients = queue:in({cast, Cast}, Clients)}}; - false -> - {Worker, NewWorkers} = gb_sets:take_smallest(Workers), - ok = wpool_process:cast(Worker, Cast), - {noreply, State#state{workers = NewWorkers}} - end. + {Worker, NewWorkers} = gb_sets:take_smallest(Workers), + ok = wpool_process:cast(Worker, Cast), + {noreply, State#state{workers = NewWorkers}} + end. + +-type call_request() :: {available_worker, infinity | pos_integer()} | pending_task_count. --type call_request() :: - {available_worker, infinity|pos_integer()} | pending_task_count. %% @private -spec handle_call(call_request(), from(), state()) -> - {reply, {ok, atom()}, state()} | {noreply, state()}. -handle_call( - {available_worker, Call, Expires}, Client = {ClientPid, _Ref}, State) -> - #state{workers = Workers, clients = Clients} = State, - case gb_sets:is_empty(Workers) of - true -> - inc_pending_tasks(), - { noreply - , State#state{clients = queue:in({Client, Call, Expires}, Clients)} - }; - false -> - {Worker, NewWorkers} = gb_sets:take_smallest(Workers), - %NOTE: It could've been a while since this call was made, so we check - case erlang:is_process_alive(ClientPid) andalso - Expires > now_in_microseconds() of - true -> - NewState = monitor_worker(Worker, Client, - State#state{workers = NewWorkers}), - ok = wpool_process:cast_call(Worker, Client, Call), - {noreply, NewState}; + {reply, {ok, atom()}, state()} | {noreply, state()}. +handle_call({available_worker, Call, Expires}, Client = {ClientPid, _Ref}, State) -> + #state{workers = Workers, clients = Clients} = State, + case gb_sets:is_empty(Workers) of + true -> + inc_pending_tasks(), + {noreply, State#state{clients = queue:in({Client, Call, Expires}, Clients)}}; false -> - {noreply, State} - end - end; + {Worker, NewWorkers} = gb_sets:take_smallest(Workers), + %NOTE: It could've been a while since this call was made, so we check + case erlang:is_process_alive(ClientPid) andalso Expires > now_in_microseconds() of + true -> + NewState = monitor_worker(Worker, Client, State#state{workers = NewWorkers}), + ok = wpool_process:cast_call(Worker, Client, Call), + {noreply, NewState}; + false -> + {noreply, State} + end + end; handle_call(pending_task_count, _From, State) -> - {reply, get(pending_tasks), State}. + {reply, get(pending_tasks), State}. %% @private -spec handle_info(any(), state()) -> {noreply, state()}. handle_info({'DOWN', Ref, Type, {Worker, _Node}, Exit}, State) -> handle_info({'DOWN', Ref, Type, Worker, Exit}, State); handle_info({'DOWN', _, _, Worker, Exit}, State = #state{monitors = Mons}) -> - case gb_trees:is_defined(Worker, Mons) of - true -> - {_Ref, Client} = gb_trees:get(Worker, Mons), - gen_server:reply(Client, {'EXIT', Worker, Exit}), - {noreply, State#state{monitors = gb_trees:delete(Worker, Mons)}}; - false -> - {noreply, State} - end; -handle_info(_Info, State) -> {noreply, State}. - -%% @private --spec terminate(atom(), state()) -> ok. -terminate(_Reason, _State) -> ok. - -%% @private --spec code_change(string(), state(), any()) -> {ok, state()}. -code_change(_OldVsn, State, _Extra) -> {ok, State}. + case gb_trees:is_defined(Worker, Mons) of + true -> + {_Ref, Client} = gb_trees:get(Worker, Mons), + gen_server:reply(Client, {'EXIT', Worker, Exit}), + {noreply, State#state{monitors = gb_trees:delete(Worker, Mons)}}; + false -> + {noreply, State} + end; +handle_info(_Info, State) -> + {noreply, State}. %%%=================================================================== %%% private %%%=================================================================== -inc_pending_tasks() -> inc(pending_tasks). -dec_pending_tasks() -> dec(pending_tasks). +inc_pending_tasks() -> + inc(pending_tasks). + +dec_pending_tasks() -> + dec(pending_tasks). + +inc(Key) -> + put(Key, get(Key) + 1). -inc(Key) -> put(Key, get(Key) + 1). -dec(Key) -> put(Key, get(Key) - 1). +dec(Key) -> + put(Key, get(Key) - 1). -now_in_microseconds() -> timer:now_diff(os:timestamp(), {0, 0, 0}). +now_in_microseconds() -> + timer:now_diff( + os:timestamp(), {0, 0, 0}). expires(Timeout) -> - case Timeout of - infinity -> infinity; - Timeout -> now_in_microseconds() + Timeout * 1000 - end. + case Timeout of + infinity -> + infinity; + Timeout -> + now_in_microseconds() + Timeout * 1000 + end. monitor_worker(Worker, Client, State = #state{monitors = Mons}) -> - Ref = monitor(process, Worker), - State#state{monitors = gb_trees:enter(Worker, {Ref, Client}, Mons)}. + Ref = monitor(process, Worker), + State#state{monitors = gb_trees:enter(Worker, {Ref, Client}, Mons)}. queue_out(Clients, fifo) -> - queue:out(Clients); + queue:out(Clients); queue_out(Clients, lifo) -> - queue:out_r(Clients). + queue:out_r(Clients). diff --git a/src/wpool_sup.erl b/src/wpool_sup.erl index 90f62fa..e0c3527 100644 --- a/src/wpool_sup.erl +++ b/src/wpool_sup.erl @@ -13,7 +13,6 @@ % under the License. %%% @hidden -module(wpool_sup). --author('elbrujohalcon@inaka.net'). -behaviour(supervisor). @@ -24,43 +23,34 @@ %% PUBLIC API %%------------------------------------------------------------------- %% @doc Starts the supervisor --spec start_link() -> - {ok, pid()} | {error, {already_started, pid()} | term()}. -start_link() -> supervisor:start_link({local, ?MODULE}, ?MODULE, []). +-spec start_link() -> {ok, pid()} | {error, {already_started, pid()} | term()}. +start_link() -> + supervisor:start_link({local, ?MODULE}, ?MODULE, []). %% @doc Starts a new pool -spec start_pool(wpool:name(), [wpool:option()]) -> - {ok, pid()} | {error, {already_started, pid()} | term()}. -start_pool(Name, Options) -> supervisor:start_child(?MODULE, [Name, Options]). + {ok, pid()} | {error, {already_started, pid()} | term()}. +start_pool(Name, Options) -> + supervisor:start_child(?MODULE, [Name, Options]). %% @doc Stops a pool -spec stop_pool(wpool:name()) -> ok. stop_pool(Name) -> - case erlang:whereis(Name) of - undefined -> - error_logger:warning_msg("Couldn't stop ~p. It was not running", [Name]), - ok; - Pid -> - ok = supervisor:terminate_child(?MODULE, Pid) - end. + case erlang:whereis(Name) of + undefined -> + error_logger:warning_msg("Couldn't stop ~p. It was not running", [Name]), + ok; + Pid -> + ok = supervisor:terminate_child(?MODULE, Pid) + end. %%---------------------------------------------------------------------- %% Supervisor behaviour callbacks %%---------------------------------------------------------------------- %% @hidden --spec init([]) -> - {ok, {{simple_one_for_one, 5, 60}, [supervisor:child_spec()]}}. +-spec init([]) -> {ok, {{simple_one_for_one, 5, 60}, [supervisor:child_spec()]}}. init([]) -> - ok = wpool_pool:create_table(), - { ok - , { {simple_one_for_one, 5, 60} - , [ { wpool_pool - , {wpool_pool, start_link, []} - , permanent - , 2000 - , supervisor - , dynamic - } - ] - } - }. + ok = wpool_pool:create_table(), + {ok, + {{simple_one_for_one, 5, 60}, + [{wpool_pool, {wpool_pool, start_link, []}, permanent, 2000, supervisor, dynamic}]}}. diff --git a/src/wpool_time_checker.erl b/src/wpool_time_checker.erl index 72d936e..cf65c88 100644 --- a/src/wpool_time_checker.erl +++ b/src/wpool_time_checker.erl @@ -13,71 +13,54 @@ % under the License. %%% @hidden -module(wpool_time_checker). --author('elbrujohalcon@inaka.net'). -behaviour(gen_server). -type handler() :: {atom(), atom()}. --record(state, { wpool :: wpool:name() - , handlers :: [handler()] - }). +-record(state, {wpool :: wpool:name(), handlers :: [handler()]}). + -type state() :: #state{}. %% api --export([ start_link/3 - , add_handler/2 - ]). - +-export([start_link/3, add_handler/2]). %% gen_server callbacks --export([ init/1 - , terminate/2 - , code_change/3 - , handle_call/3 - , handle_cast/2 - , handle_info/2 - ]). +-export([init/1, handle_call/3, handle_cast/2, handle_info/2]). %%%=================================================================== %%% API %%%=================================================================== %% @private -spec start_link(wpool:name(), atom(), handler() | [handler()]) -> - {ok, pid()} | {error, {already_started, pid()} | term()}. + {ok, pid()} | {error, {already_started, pid()} | term()}. start_link(WPool, Name, Handlers) when is_list(Handlers) -> - gen_server:start_link({local, Name}, ?MODULE, {WPool, Handlers}, []); + gen_server:start_link({local, Name}, ?MODULE, {WPool, Handlers}, []); start_link(WPool, Name, Handler) when is_tuple(Handler) -> - start_link(WPool, Name, [Handler]). + start_link(WPool, Name, [Handler]). %% @private -spec add_handler(atom(), handler()) -> ok. add_handler(Name, Handler) -> - gen_server:call(Name, {add_handler, Handler}). + gen_server:call(Name, {add_handler, Handler}). %%%=================================================================== -%%% init, terminate, code_change, info callbacks +%%% simple callbacks %%%=================================================================== %% @private -spec init({wpool:name(), [{atom(), atom()}]}) -> {ok, state()}. -init({WPool, Handlers}) -> {ok, #state{wpool = WPool, handlers = Handlers}}. - -%% @private --spec terminate(atom(), state()) -> ok. -terminate(_Reason, _State) -> ok. - -%% @private --spec code_change(string(), state(), any()) -> {ok, state()}. -code_change(_OldVsn, State, _Extra) -> {ok, State}. +init({WPool, Handlers}) -> + {ok, #state{wpool = WPool, handlers = Handlers}}. %% @private -spec handle_cast(term(), state()) -> {noreply, state()}. -handle_cast(_Cast, State) -> {noreply, State}. +handle_cast(_Cast, State) -> + {noreply, State}. -type from() :: {pid(), reference()}. --spec handle_call({add_handler, handler()}, from(), state()) -> - {reply, ok, state()}. + +-spec handle_call({add_handler, handler()}, from(), state()) -> {reply, ok, state()}. handle_call({add_handler, Handler}, _, State = #state{handlers = Handlers}) -> - {reply, ok, State#state{handlers = [Handler | Handlers]}}. + {reply, ok, State#state{handlers = [Handler | Handlers]}}. %%%=================================================================== %%% real (i.e. interesting) callbacks @@ -85,30 +68,43 @@ handle_call({add_handler, Handler}, _, State = #state{handlers = Handlers}) -> %% @private -spec handle_info(any(), state()) -> {noreply, state()}. handle_info({check, Pid, TaskId, Runtime, WarningsLeft}, State) -> - case erlang:process_info(Pid, dictionary) of - {dictionary, Values} -> - run_task( - TaskId, proplists:get_value(wpool_task, Values), Pid, - State#state.wpool, State#state.handlers, Runtime, WarningsLeft); - _ -> ok - end, - {noreply, State}; -handle_info(_Info, State) -> {noreply, State}. + case erlang:process_info(Pid, dictionary) of + {dictionary, Values} -> + run_task(TaskId, + proplists:get_value(wpool_task, Values), + Pid, + State#state.wpool, + State#state.handlers, + Runtime, + WarningsLeft); + _ -> + ok + end, + {noreply, State}; +handle_info(_Info, State) -> + {noreply, State}. run_task(TaskId, {TaskId, _, Task}, Pid, Pool, Handlers, Runtime, 1) -> - send_reports(Handlers, max_overrun_limit, Pool, Pid, Task, Runtime), - exit(Pid, kill), - ok; + send_reports(Handlers, max_overrun_limit, Pool, Pid, Task, Runtime), + exit(Pid, kill), + ok; run_task(TaskId, {TaskId, _, Task}, Pid, Pool, Handlers, Runtime, WarningsLeft) -> - send_reports(Handlers, overrun, Pool, Pid, Task, Runtime), - case new_overrun_time(Runtime, WarningsLeft) of - NewOverrunTime when NewOverrunTime =< 4294967295 -> - erlang:send_after( - Runtime, self(), {check, Pid, TaskId, NewOverrunTime, decrease_warnings(WarningsLeft)}), - ok; - _ -> ok - end; -run_task(_TaskId, _Value, _Pid, _Pool, _Handlers, _Runtime, _WarningsLeft) -> ok. + send_reports(Handlers, overrun, Pool, Pid, Task, Runtime), + case new_overrun_time(Runtime, WarningsLeft) of + NewOverrunTime when NewOverrunTime =< 4294967295 -> + erlang:send_after(Runtime, + self(), + {check, + Pid, + TaskId, + NewOverrunTime, + decrease_warnings(WarningsLeft)}), + ok; + _ -> + ok + end; +run_task(_TaskId, _Value, _Pid, _Pool, _Handlers, _Runtime, _WarningsLeft) -> + ok. -spec new_overrun_time(pos_integer(), pos_integer() | infinity) -> pos_integer(). new_overrun_time(Runtime, infinity) -> @@ -117,13 +113,19 @@ new_overrun_time(Runtime, _) -> Runtime * 2. -spec decrease_warnings(pos_integer() | infinity) -> non_neg_integer() | infinity. -decrease_warnings(infinity) -> infinity; -decrease_warnings(N) -> N -1. - --spec send_reports([{atom(), atom()}], atom(), atom(), pid(), term(), infinity | pos_integer()) -> - ok. +decrease_warnings(infinity) -> + infinity; +decrease_warnings(N) -> + N - 1. + +-spec send_reports([{atom(), atom()}], + atom(), + atom(), + pid(), + term(), + infinity | pos_integer()) -> + ok. send_reports(Handlers, Alert, Pool, Pid, Task, Runtime) -> - Args = [ {alert, Alert}, {pool, Pool}, {worker, Pid}, {task, Task} - , {runtime, Runtime}], - _ = [catch Mod:Fun(Args) || {Mod, Fun} <- Handlers], - ok. + Args = [{alert, Alert}, {pool, Pool}, {worker, Pid}, {task, Task}, {runtime, Runtime}], + _ = [catch Mod:Fun(Args) || {Mod, Fun} <- Handlers], + ok. diff --git a/src/wpool_utils.erl b/src/wpool_utils.erl index c8c9374..b5dc881 100644 --- a/src/wpool_utils.erl +++ b/src/wpool_utils.erl @@ -14,13 +14,11 @@ %%% @author Felipe Ripoll %%% @doc Common functions for wpool_process and other modules. -module(wpool_utils). + -author('ferigis@gmail.com'). %% API --export([ task_init/4 - , task_end/1 - , notify_queue_manager/3]). - +-export([task_init/4, task_end/1, notify_queue_manager/3]). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Api @@ -28,28 +26,36 @@ %% @doc Marks Task as started in this worker -spec task_init(term(), atom(), infinity | pos_integer(), infinity | pos_integer()) -> - undefined | reference(). + undefined | reference(). task_init(Task, _TimeChecker, infinity, _MaxWarnings) -> - Time = calendar:datetime_to_gregorian_seconds(calendar:universal_time()), - erlang:put(wpool_task, {undefined, Time, Task}), - undefined; + Time = + calendar:datetime_to_gregorian_seconds( + calendar:universal_time()), + erlang:put(wpool_task, {undefined, Time, Task}), + undefined; task_init(Task, TimeChecker, OverrunTime, MaxWarnings) -> - TaskId = erlang:make_ref(), - Time = calendar:datetime_to_gregorian_seconds(calendar:universal_time()), - erlang:put(wpool_task, {TaskId, Time, Task}), - erlang:send_after( - OverrunTime, TimeChecker, {check, self(), TaskId, OverrunTime, MaxWarnings}). + TaskId = erlang:make_ref(), + Time = + calendar:datetime_to_gregorian_seconds( + calendar:universal_time()), + erlang:put(wpool_task, {TaskId, Time, Task}), + erlang:send_after(OverrunTime, + TimeChecker, + {check, self(), TaskId, OverrunTime, MaxWarnings}). %% @doc Removes the current task from the worker -spec task_end(undefined | reference()) -> ok. -task_end(undefined) -> erlang:erase(wpool_task); +task_end(undefined) -> + erlang:erase(wpool_task); task_end(TimerRef) -> - _ = erlang:cancel_timer(TimerRef), - erlang:erase(wpool_task). + _ = erlang:cancel_timer(TimerRef), + erlang:erase(wpool_task). -spec notify_queue_manager(atom(), atom(), list()) -> ok | any(). notify_queue_manager(Function, Name, Options) -> - case proplists:get_value(queue_manager, Options) of - undefined -> ok; - QueueManager -> wpool_queue_manager:Function(QueueManager, Name) - end. + case proplists:get_value(queue_manager, Options) of + undefined -> + ok; + QueueManager -> + wpool_queue_manager:Function(QueueManager, Name) + end. diff --git a/src/wpool_worker.erl b/src/wpool_worker.erl index 5d48bcc..044f6ea 100644 --- a/src/wpool_worker.erl +++ b/src/wpool_worker.erl @@ -14,23 +14,13 @@ %%% @author Fernando Benavides %%% @doc Default instance for {@link wpool_process} -module(wpool_worker). --author('elbrujohalcon@inaka.net'). -behaviour(gen_server). %% api --export([ call/4 - , cast/4 - ]). - +-export([call/4, cast/4]). %% gen_server callbacks --export([ init/1 - , terminate/2 - , code_change/3 - , handle_call/3 - , handle_cast/2 - , handle_info/2 - ]). +-export([init/1, handle_call/3, handle_cast/2]). %%%=================================================================== %%% API @@ -38,34 +28,30 @@ %% @doc Returns the result of M:F(A) from any of the workers of the pool S -spec call(wpool:name(), module(), atom(), [term()]) -> term(). call(S, M, F, A) -> - case wpool:call(S, {M, F, A}) of - {ok, Result} -> Result; - {error, Error} -> exit(Error) - end. + case wpool:call(S, {M, F, A}) of + {ok, Result} -> + Result; + {error, Error} -> + exit(Error) + end. %% @doc Executes M:F(A) in any of the workers of the pool S -spec cast(wpool:name(), module(), atom(), [term()]) -> ok. -cast(S, M, F, A) -> wpool:cast(S, {M, F, A}). +cast(S, M, F, A) -> + wpool:cast(S, {M, F, A}). %%%=================================================================== -%%% init, terminate, code_change, info callbacks +%%% simple callbacks %%%=================================================================== -record(state, {}). + -type state() :: #state{}. %% @private -spec init(undefined) -> {ok, state()}. -init(undefined) -> {ok, #state{}}. -%% @private --spec terminate(atom(), state()) -> ok. -terminate(_Reason, _State) -> ok. -%% @private --spec code_change(string(), state(), any()) -> {ok, state()}. -code_change(_OldVsn, State, _Extra) -> {ok, State}. -%% @private --spec handle_info(any(), state()) -> {noreply, state()}. -handle_info(_Info, State) -> {noreply, State}. +init(undefined) -> + {ok, #state{}}. %%%=================================================================== %%% real (i.e. interesting) callbacks @@ -73,39 +59,39 @@ handle_info(_Info, State) -> {noreply, State}. %% @private -spec handle_cast(term(), state()) -> {noreply, state(), hibernate}. handle_cast({M, F, A}, State) -> - try erlang:apply(M, F, A) of - _ -> - {noreply, State, hibernate} - catch - _:Error:Stacktrace -> - log_error(M, F, A, Error, Stacktrace), - {noreply, State, hibernate} - end; + try erlang:apply(M, F, A) of + _ -> + {noreply, State, hibernate} + catch + _:Error:Stacktrace -> + log_error(M, F, A, Error, Stacktrace), + {noreply, State, hibernate} + end; handle_cast(Cast, State) -> - error_logger:error_msg("Invalid cast:~p", [Cast]), - {noreply, State, hibernate}. + error_logger:error_msg("Invalid cast:~p", [Cast]), + {noreply, State, hibernate}. -type from() :: {pid(), reference()}. + %% @private -spec handle_call(term(), from(), state()) -> - {reply, {ok, term()} | {error, term()}, state(), hibernate}. + {reply, {ok, term()} | {error, term()}, state(), hibernate}. handle_call({M, F, A}, _From, State) -> - try erlang:apply(M, F, A) of - R -> - {reply, {ok, R}, State, hibernate} - catch - _:Error:Stacktrace -> - log_error(M, F, A, Error, Stacktrace), - {reply, {error, Error}, State, hibernate} - end; + try erlang:apply(M, F, A) of + R -> + {reply, {ok, R}, State, hibernate} + catch + _:Error:Stacktrace -> + log_error(M, F, A, Error, Stacktrace), + {reply, {error, Error}, State, hibernate} + end; handle_call(Call, _From, State) -> - error_logger:error_msg("Invalid call:~p", [Call]), - {reply, {error, invalid_request}, State, hibernate}. + error_logger:error_msg("Invalid call:~p", [Call]), + {reply, {error, invalid_request}, State, hibernate}. %%%=================================================================== %%% not exported functions %%%=================================================================== log_error(M, F, A, Error, Stacktrace) -> - error_logger:error_msg( - "Error on ~p:~p~p >> ~p Backtrace ~p", - [M, F, A, Error, Stacktrace]). + error_logger:error_msg("Error on ~p:~p~p >> ~p Backtrace ~p", + [M, F, A, Error, Stacktrace]). diff --git a/test/crashy_server.erl b/test/crashy_server.erl index 7dcc673..e58a658 100644 --- a/test/crashy_server.erl +++ b/test/crashy_server.erl @@ -17,13 +17,8 @@ -behaviour(gen_server). %% gen_server callbacks --export([ init/1 - , terminate/2 - , code_change/3 - , handle_call/3 - , handle_cast/2 - , handle_info/2 - ]). +-export([init/1, terminate/2, code_change/3, handle_call/3, handle_cast/2, + handle_info/2]). -dialyzer([no_behaviours]). @@ -31,24 +26,35 @@ %%% callbacks %%%=================================================================== -spec init(Something) -> Something. -init(Something) -> {ok, Something}. +init(Something) -> + {ok, Something}. -spec terminate(Any, term()) -> Any. -terminate(Reason, _State) -> Reason. +terminate(Reason, _State) -> + Reason. -spec code_change(string(), State, any()) -> {ok, State}. -code_change(_OldVsn, State, _Extra) -> {ok, State}. +code_change(_OldVsn, State, _Extra) -> + {ok, State}. -spec handle_info(timeout | Info, term()) -> {noreply, timeout} | Info. -handle_info(timeout, _State) -> {noreply, timeout}; -handle_info(Info, _State) -> Info. +handle_info(timeout, _State) -> + {noreply, timeout}; +handle_info(Info, _State) -> + Info. -spec handle_cast(Cast, term()) -> Cast. -handle_cast(crash, _State) -> error(crash_requested); -handle_cast(Cast, _State) -> Cast. +handle_cast(crash, _State) -> + error(crash_requested); +handle_cast(Cast, _State) -> + Cast. -type from() :: {pid(), reference()}. + -spec handle_call(state | Call, from(), State) -> {reply, State, State} | Call. -handle_call(state, _From, State) -> {reply, State, State}; -handle_call(crash, _From, _State) -> error(crash_requested); -handle_call(Call, _From, State) -> {reply, Call, State}. +handle_call(state, _From, State) -> + {reply, State, State}; +handle_call(crash, _From, _State) -> + error(crash_requested); +handle_call(Call, _From, State) -> + {reply, Call, State}. diff --git a/test/echo_server.erl b/test/echo_server.erl index a06ab51..d748ff8 100644 --- a/test/echo_server.erl +++ b/test/echo_server.erl @@ -13,20 +13,12 @@ % under the License. %% @doc a gen_server built to test wpool_process -module(echo_server). --author('elbrujohalcon@inaka.net'). -behaviour(gen_server). %% gen_server callbacks --export([ init/1 - , terminate/2 - , code_change/3 - , handle_call/3 - , handle_cast/2 - , handle_info/2 - , handle_continue/2 - , format_status/2 - ]). +-export([init/1, terminate/2, code_change/3, handle_call/3, handle_cast/2, handle_info/2, + handle_continue/2, format_status/2]). -dialyzer([no_behaviours]). @@ -34,28 +26,38 @@ %%% callbacks %%%=================================================================== -spec init(Something) -> Something. -init(Something) -> Something. +init(Something) -> + Something. -spec terminate(Any, term()) -> Any. -terminate(Reason, _State) -> Reason. +terminate(Reason, _State) -> + Reason. -spec code_change(string(), State, any()) -> any() | {ok, State}. -code_change(_OldVsn, _State, Extra) -> Extra. +code_change(_OldVsn, _State, Extra) -> + Extra. -spec handle_info(timeout | Info, term()) -> {noreply, timeout} | Info. -handle_info(timeout, _State) -> {noreply, timeout}; -handle_info(Info, _State) -> Info. +handle_info(timeout, _State) -> + {noreply, timeout}; +handle_info(Info, _State) -> + Info. -spec handle_cast(Cast, term()) -> Cast. -handle_cast(Cast, _State) -> Cast. +handle_cast(Cast, _State) -> + Cast. -type from() :: {pid(), reference()}. + -spec handle_call(Call, from(), term()) -> Call. -handle_call(Call, _From, _State) -> Call. +handle_call(Call, _From, _State) -> + Call. -spec handle_continue(Continue, term()) -> Continue. -handle_continue(Continue, _State) -> Continue. +handle_continue(Continue, _State) -> + Continue. -spec format_status(normal | terminate, [[{_, _}] | State, ...]) -> + {formatted_state, State}. +format_status(_, [_PDict, State]) -> {formatted_state, State}. -format_status(_, [_PDict, State]) -> {formatted_state, State}. diff --git a/test/sleepy_server.erl b/test/sleepy_server.erl index 763ba83..3f7014f 100644 --- a/test/sleepy_server.erl +++ b/test/sleepy_server.erl @@ -13,15 +13,11 @@ % under the License. %% @doc a gen_server built to test wpool_process -module(sleepy_server). --author('elbrujohalcon@inaka.net'). -behaviour(gen_server). %% gen_server callbacks --export([ init/1 - , handle_call/3 - , handle_cast/2 - ]). +-export([init/1, handle_call/3, handle_cast/2]). -dialyzer([no_behaviours]). @@ -30,18 +26,19 @@ %%%=================================================================== -spec init(pos_integer()) -> {ok, state}. init(TimeToSleep) -> - ct:pal("Waiting ~pms to return...", [TimeToSleep]), - _ = timer:sleep(TimeToSleep), - ct:pal("Done waiting ~pms", [TimeToSleep]), - {ok, state}. + ct:pal("Waiting ~pms to return...", [TimeToSleep]), + _ = timer:sleep(TimeToSleep), + ct:pal("Done waiting ~pms", [TimeToSleep]), + {ok, state}. -spec handle_cast(pos_integer(), State) -> {noreply, State}. handle_cast(TimeToSleep, State) -> - _ = timer:sleep(TimeToSleep), - {noreply, State}. + _ = timer:sleep(TimeToSleep), + {noreply, State}. -type from() :: {pid(), reference()}. + -spec handle_call(pos_integer(), from(), State) -> {reply, ok, State}. handle_call(TimeToSleep, _From, State) -> - _ = timer:sleep(TimeToSleep), - {reply, ok, State}. + _ = timer:sleep(TimeToSleep), + {reply, ok, State}. diff --git a/test/wpool_SUITE.erl b/test/wpool_SUITE.erl index 4418781..6faba19 100644 --- a/test/wpool_SUITE.erl +++ b/test/wpool_SUITE.erl @@ -15,443 +15,448 @@ %% @hidden -module(wpool_SUITE). +-behaviour(ct_suite). + +-elvis([{elvis_style, atom_naming_convention, disable}]). + -type config() :: [{atom(), term()}]. --export([ all/0 - ]). --export([ init_per_suite/1 - , end_per_suite/1 - ]). --export([ stats/1 - , stop_pool/1 - , non_brutal_shutdown/1 - , brutal_worker_shutdown/1 - , overrun/1 - , kill_on_overrun/1 - , too_much_overrun/1 - , default_strategy/1 - , overrun_handler1/1 - , overrun_handler2/1 - , default_options/1 - , complete_coverage/1 - , broadcast/1 - , worker_killed_stats/1 - ]). +-export([all/0]). +-export([init_per_suite/1, end_per_suite/1]). +-export([stats/1, stop_pool/1, non_brutal_shutdown/1, brutal_worker_shutdown/1, overrun/1, + kill_on_overrun/1, too_much_overrun/1, default_strategy/1, overrun_handler1/1, + overrun_handler2/1, default_options/1, complete_coverage/1, broadcast/1, + worker_killed_stats/1]). -spec all() -> [atom()]. all() -> - [too_much_overrun, overrun, stop_pool, non_brutal_shutdown, brutal_worker_shutdown, - stats, default_strategy, default_options, complete_coverage, broadcast, - kill_on_overrun, worker_killed_stats]. + [too_much_overrun, + overrun, + stop_pool, + non_brutal_shutdown, + brutal_worker_shutdown, + stats, + default_strategy, + default_options, + complete_coverage, + broadcast, + kill_on_overrun, + worker_killed_stats]. -spec init_per_suite(config()) -> config(). init_per_suite(Config) -> - ok = wpool:start(), - Config. + ok = wpool:start(), + Config. -spec end_per_suite(config()) -> config(). end_per_suite(Config) -> - wpool:stop(), - Config. + wpool:stop(), + Config. -spec overrun_handler1(M) -> M. -overrun_handler1(M) -> overrun_handler ! {overrun1, M}. +overrun_handler1(M) -> + overrun_handler ! {overrun1, M}. -spec overrun_handler2(M) -> M. -overrun_handler2(M) -> overrun_handler ! {overrun2, M}. +overrun_handler2(M) -> + overrun_handler ! {overrun2, M}. -spec too_much_overrun(config()) -> {comment, []}. too_much_overrun(_Config) -> - ct:comment("Receiving overruns here..."), - true = register(overrun_handler, self()), - {ok, PoolPid} = - wpool:start_sup_pool( - wpool_SUITE_too_much_overrun, - [ {workers, 1} - , {overrun_warning, 999} - , {overrun_handler, {?MODULE, overrun_handler1}} - ]), - - CheckerName = wpool_pool:time_checker_name(wpool_SUITE_too_much_overrun), - ok = wpool_time_checker:add_handler(CheckerName, {?MODULE, overrun_handler2}), - - ct:comment("Find the worker and the time checker..."), - {ok, Worker} = wpool:call(wpool_SUITE_too_much_overrun, {erlang, self, []}), - TCPid = get_time_checker(PoolPid), - - ct:comment("Start a long running task..."), - ok = wpool:cast(wpool_SUITE_too_much_overrun, {timer, sleep, [5000]}), - TaskId = - ktn_task:wait_for_success( - fun() -> - {dictionary, Dict} = erlang:process_info(Worker, dictionary), - {TId, _, _} = proplists:get_value(wpool_task, Dict), - TId - end), - - ct:comment("Simulate overrun warning..."), - % huge runtime => no more overruns - TCPid ! {check, Worker, TaskId, 9999999999, infinity}, - - ct:comment("Get overrun message..."), - _ = receive - {overrun1, Message1} -> - overrun = proplists:get_value(alert, Message1), - wpool_SUITE_too_much_overrun = proplists:get_value(pool, Message1), - Worker = proplists:get_value(worker, Message1), - {cast, {timer, sleep, [5000]}} = proplists:get_value(task, Message1), - 9999999999 = proplists:get_value(runtime, Message1) - after 100 -> - ct:fail(no_overrun) - end, - - ct:comment("Get overrun message..."), - _ = receive - {overrun2, Message2} -> - overrun = proplists:get_value(alert, Message2), - wpool_SUITE_too_much_overrun = proplists:get_value(pool, Message2), - Worker = proplists:get_value(worker, Message2), - {cast, {timer, sleep, [5000]}} = proplists:get_value(task, Message2), - 9999999999 = proplists:get_value(runtime, Message2) - after 100 -> - ct:fail(no_overrun) - end, - - ct:comment("No more overruns..."), - _ = case get_messages(100) of - [] -> ok; - Msgs1 -> ct:fail({unexpected_messages, Msgs1}) - end, - - ct:comment("Kill the worker..."), - exit(Worker, kill), - - ct:comment("Simulate overrun warning..."), - TCPid ! {check, Worker, TaskId, 100}, % tiny runtime, to check - - ct:comment("Nothing happens..."), - ok = no_messages(), - - ct:comment("Stop pool..."), - ok = wpool:stop_sup_pool(wpool_SUITE_too_much_overrun), - - {comment, []}. + ct:comment("Receiving overruns here..."), + true = register(overrun_handler, self()), + {ok, PoolPid} = + wpool:start_sup_pool(wpool_SUITE_too_much_overrun, + [{workers, 1}, + {overrun_warning, 999}, + {overrun_handler, {?MODULE, overrun_handler1}}]), + + CheckerName = wpool_pool:time_checker_name(wpool_SUITE_too_much_overrun), + ok = wpool_time_checker:add_handler(CheckerName, {?MODULE, overrun_handler2}), + + ct:comment("Find the worker and the time checker..."), + {ok, Worker} = wpool:call(wpool_SUITE_too_much_overrun, {erlang, self, []}), + TCPid = get_time_checker(PoolPid), + + ct:comment("Start a long running task..."), + ok = wpool:cast(wpool_SUITE_too_much_overrun, {timer, sleep, [5000]}), + TaskId = + ktn_task:wait_for_success(fun() -> + {dictionary, Dict} = erlang:process_info(Worker, dictionary), + {TId, _, _} = proplists:get_value(wpool_task, Dict), + TId + end), + + ct:comment("Simulate overrun warning..."), + % huge runtime => no more overruns + TCPid ! {check, Worker, TaskId, 9999999999, infinity}, + + ct:comment("Get overrun message..."), + _ = receive + {overrun1, Message1} -> + overrun = proplists:get_value(alert, Message1), + wpool_SUITE_too_much_overrun = proplists:get_value(pool, Message1), + Worker = proplists:get_value(worker, Message1), + {cast, {timer, sleep, [5000]}} = proplists:get_value(task, Message1), + 9999999999 = proplists:get_value(runtime, Message1) + after 100 -> + ct:fail(no_overrun) + end, + + ct:comment("Get overrun message..."), + _ = receive + {overrun2, Message2} -> + overrun = proplists:get_value(alert, Message2), + wpool_SUITE_too_much_overrun = proplists:get_value(pool, Message2), + Worker = proplists:get_value(worker, Message2), + {cast, {timer, sleep, [5000]}} = proplists:get_value(task, Message2), + 9999999999 = proplists:get_value(runtime, Message2) + after 100 -> + ct:fail(no_overrun) + end, + + ct:comment("No more overruns..."), + _ = case get_messages(100) of + [] -> + ok; + Msgs1 -> + ct:fail({unexpected_messages, Msgs1}) + end, + + ct:comment("Kill the worker..."), + exit(Worker, kill), + + ct:comment("Simulate overrun warning..."), + TCPid ! {check, Worker, TaskId, 100}, % tiny runtime, to check + + ct:comment("Nothing happens..."), + ok = no_messages(), + + ct:comment("Stop pool..."), + ok = wpool:stop_sup_pool(wpool_SUITE_too_much_overrun), + + {comment, []}. -spec overrun(config()) -> {comment, []}. overrun(_Config) -> - true = register(overrun_handler, self()), - {ok, _Pid} = - wpool:start_sup_pool( - wpool_SUITE_overrun_pool, - [ {workers, 1} - , {overrun_warning, 1000} - , {overrun_handler, {?MODULE, overrun_handler1}} - ]), - ok = wpool:cast(wpool_SUITE_overrun_pool, {timer, sleep, [1500]}), - _ = receive - {overrun1, Message} -> - overrun = proplists:get_value(alert, Message), - wpool_SUITE_overrun_pool = proplists:get_value(pool, Message), - WPid = proplists:get_value(worker, Message), - true = is_pid(WPid), - {cast, {timer, sleep, [1500]}} = proplists:get_value(task, Message), - Runtime = proplists:get_value(runtime, Message), - true = Runtime >= 1000 - after 1500 -> - ct:fail(no_overrun) - end, - - ok = no_messages(), - - ok = wpool:stop_sup_pool(wpool_SUITE_overrun_pool), - - {comment, []}. + true = register(overrun_handler, self()), + {ok, _Pid} = + wpool:start_sup_pool(wpool_SUITE_overrun_pool, + [{workers, 1}, + {overrun_warning, 1000}, + {overrun_handler, {?MODULE, overrun_handler1}}]), + ok = wpool:cast(wpool_SUITE_overrun_pool, {timer, sleep, [1500]}), + _ = receive + {overrun1, Message} -> + overrun = proplists:get_value(alert, Message), + wpool_SUITE_overrun_pool = proplists:get_value(pool, Message), + WPid = proplists:get_value(worker, Message), + true = is_pid(WPid), + {cast, {timer, sleep, [1500]}} = proplists:get_value(task, Message), + Runtime = proplists:get_value(runtime, Message), + true = Runtime >= 1000 + after 1500 -> + ct:fail(no_overrun) + end, + + ok = no_messages(), + + ok = wpool:stop_sup_pool(wpool_SUITE_overrun_pool), + + {comment, []}. -spec kill_on_overrun(config()) -> {comment, []}. kill_on_overrun(_Config) -> - true = register(overrun_handler, self()), - {ok, _Pid} = - wpool:start_sup_pool( - wpool_SUITE_kill_on_overrun_pool, - [ {workers, 1} - , {overrun_warning, 500} - , {max_overrun_warnings, 2} %% The worker must be killed after 2 overrun - %% warnings, which is after 1 secs with this - %% configuration - , {overrun_handler, {?MODULE, overrun_handler1}} - ]), - ok = wpool:cast(wpool_SUITE_kill_on_overrun_pool, {timer, sleep, [2000]}), - _ = receive - {overrun1, Message} -> - overrun = proplists:get_value(alert, Message), - wpool_SUITE_kill_on_overrun_pool = proplists:get_value(pool, Message), - WPid = proplists:get_value(worker, Message), - true = is_pid(WPid), - true = erlang:is_process_alive(WPid) - after 2000 -> - ct:fail(no_overrun) - end, - - _ = receive - {overrun1, Message2} -> - max_overrun_limit = proplists:get_value(alert, Message2), - wpool_SUITE_kill_on_overrun_pool = - proplists:get_value(pool, Message2), - WPid2 = proplists:get_value(worker, Message2), - true = is_pid(WPid2), - false = erlang:is_process_alive(WPid2) - after 2000 -> - ct:fail(no_overrun) - end, - ok = no_messages(), - - ok = wpool:stop_sup_pool(wpool_SUITE_overrun_pool), - - {comment, []}. + true = register(overrun_handler, self()), + {ok, _Pid} = + wpool:start_sup_pool(wpool_SUITE_kill_on_overrun_pool, + [{workers, 1}, + {overrun_warning, 500}, + {max_overrun_warnings, + 2}, %% The worker must be killed after 2 overrun + %% warnings, which is after 1 secs with this + %% configuration + {overrun_handler, {?MODULE, overrun_handler1}}]), + ok = wpool:cast(wpool_SUITE_kill_on_overrun_pool, {timer, sleep, [2000]}), + _ = receive + {overrun1, Message} -> + overrun = proplists:get_value(alert, Message), + wpool_SUITE_kill_on_overrun_pool = proplists:get_value(pool, Message), + WPid = proplists:get_value(worker, Message), + true = is_pid(WPid), + true = erlang:is_process_alive(WPid) + after 2000 -> + ct:fail(no_overrun) + end, + + _ = receive + {overrun1, Message2} -> + max_overrun_limit = proplists:get_value(alert, Message2), + wpool_SUITE_kill_on_overrun_pool = proplists:get_value(pool, Message2), + WPid2 = proplists:get_value(worker, Message2), + true = is_pid(WPid2), + false = erlang:is_process_alive(WPid2) + after 2000 -> + ct:fail(no_overrun) + end, + ok = no_messages(), + + ok = wpool:stop_sup_pool(wpool_SUITE_overrun_pool), + + {comment, []}. -spec stop_pool(config()) -> {comment, []}. stop_pool(_Config) -> - {ok, PoolPid} = wpool:start_sup_pool(wpool_SUITE_stop_pool, [{workers, 1}]), - true = erlang:is_process_alive(PoolPid), - ok = wpool:stop_sup_pool(wpool_SUITE_stop_pool), - false = erlang:is_process_alive(PoolPid), - ok = wpool:stop_sup_pool(wpool_SUITE_stop_pool), + {ok, PoolPid} = wpool:start_sup_pool(wpool_SUITE_stop_pool, [{workers, 1}]), + true = erlang:is_process_alive(PoolPid), + ok = wpool:stop_sup_pool(wpool_SUITE_stop_pool), + false = erlang:is_process_alive(PoolPid), + ok = wpool:stop_sup_pool(wpool_SUITE_stop_pool), - {comment, []}. + {comment, []}. -spec non_brutal_shutdown(config()) -> {comment, []}. non_brutal_shutdown(_Config) -> - {ok, PoolPid} = wpool:start_sup_pool(wpool_SUITE_non_brutal_shutdown, - [{workers, 1}, - {pool_sup_shutdown, 100}]), - true = erlang:is_process_alive(PoolPid), - Stats = wpool:stats(wpool_SUITE_non_brutal_shutdown), - {workers, [{WorkerId, _}]} = lists:keyfind(workers, 1, Stats), - Worker = wpool_pool:worker_name(wpool_SUITE_non_brutal_shutdown, WorkerId), - monitor(process, Worker), - ok = wpool:stop_sup_pool(wpool_SUITE_non_brutal_shutdown), - receive {'DOWN', _, process, {Worker, _}, Reason} -> shutdown = Reason - after 200 -> ct:fail(worker_not_stopped) - end, - - {comment, []}. + {ok, PoolPid} = + wpool:start_sup_pool(wpool_SUITE_non_brutal_shutdown, + [{workers, 1}, {pool_sup_shutdown, 100}]), + true = erlang:is_process_alive(PoolPid), + Stats = wpool:stats(wpool_SUITE_non_brutal_shutdown), + {workers, [{WorkerId, _}]} = lists:keyfind(workers, 1, Stats), + Worker = wpool_pool:worker_name(wpool_SUITE_non_brutal_shutdown, WorkerId), + monitor(process, Worker), + ok = wpool:stop_sup_pool(wpool_SUITE_non_brutal_shutdown), + receive + {'DOWN', _, process, {Worker, _}, Reason} -> + shutdown = Reason + after 200 -> + ct:fail(worker_not_stopped) + end, + + {comment, []}. -spec brutal_worker_shutdown(config()) -> {comment, []}. brutal_worker_shutdown(_Config) -> - {ok, PoolPid} = wpool:start_sup_pool(wpool_SUITE_non_brutal_shutdown, - [{workers, 1}, - {pool_sup_shutdown, 100}, - {worker_shutdown, brutal_kill}]), - true = erlang:is_process_alive(PoolPid), - Stats = wpool:stats(wpool_SUITE_non_brutal_shutdown), - {workers, [{WorkerId, _}]} = lists:keyfind(workers, 1, Stats), - Worker = wpool_pool:worker_name(wpool_SUITE_non_brutal_shutdown, WorkerId), - monitor(process, Worker), - ok = wpool:stop_sup_pool(wpool_SUITE_non_brutal_shutdown), - receive {'DOWN', _, process, {Worker, _}, Reason} -> killed = Reason - after 200 -> - ct:fail(worker_not_stopped) - end, - - {comment, []}. + {ok, PoolPid} = + wpool:start_sup_pool(wpool_SUITE_non_brutal_shutdown, + [{workers, 1}, + {pool_sup_shutdown, 100}, + {worker_shutdown, brutal_kill}]), + true = erlang:is_process_alive(PoolPid), + Stats = wpool:stats(wpool_SUITE_non_brutal_shutdown), + {workers, [{WorkerId, _}]} = lists:keyfind(workers, 1, Stats), + Worker = wpool_pool:worker_name(wpool_SUITE_non_brutal_shutdown, WorkerId), + monitor(process, Worker), + ok = wpool:stop_sup_pool(wpool_SUITE_non_brutal_shutdown), + receive + {'DOWN', _, process, {Worker, _}, Reason} -> + killed = Reason + after 200 -> + ct:fail(worker_not_stopped) + end, + + {comment, []}. -spec stats(config()) -> {comment, []}. stats(_Config) -> - Get = fun proplists:get_value/2, - - ok = try _ = wpool:stats(?MODULE), ok - catch _:no_workers -> ok - end, - - {ok, PoolPid} = wpool:start_sup_pool(wpool_SUITE_stats_pool, [{workers, 10}]), - true = is_process_alive(PoolPid), - PoolPid = erlang:whereis(wpool_SUITE_stats_pool), - - % Checks ... - [InitStats] = wpool:stats(), - wpool_SUITE_stats_pool = Get(pool, InitStats), - PoolPid = Get(supervisor, InitStats), - Options = Get(options, InitStats), - infinity = Get(overrun_warning, Options), - {error_logger, warning_report} = Get(overrun_handler, Options), - 10 = Get(workers, Options), - 10 = Get(size, InitStats), - 1 = Get(next_worker, InitStats), - InitWorkers = Get(workers, InitStats), - 10 = length(InitWorkers), - _ = [ begin - WorkerStats = Get(I, InitWorkers), - 0 = Get(message_queue_len, WorkerStats), - [] = - lists:keydelete( - message_queue_len, 1, lists:keydelete(memory, 1, WorkerStats)) - end || I <- lists:seq(1, 10)], - - % Start a long task on every worker - Sleep = {timer, sleep, [2000]}, - [wpool:cast(wpool_SUITE_stats_pool, Sleep, next_worker) - || _ <- lists:seq(1, 10)], - - ok = - ktn_task:wait_for_success( - fun() -> - WorkingStats = wpool:stats(wpool_SUITE_stats_pool), - wpool_SUITE_stats_pool = Get(pool, WorkingStats), - PoolPid = Get(supervisor, WorkingStats), - Options = Get(options, WorkingStats), - 10 = Get(size, WorkingStats), - 1 = Get(next_worker, WorkingStats), - WorkingWorkers = Get(workers, WorkingStats), - 10 = length(WorkingWorkers), - [ begin - WorkerStats = Get(I, WorkingWorkers), - 0 = Get(message_queue_len, WorkerStats), - {timer, sleep, 1} = Get(current_function, WorkerStats), - {timer, sleep, 1, _} = Get(current_location, WorkerStats), - {cast, Sleep} = Get(task, WorkerStats), - true = is_number(Get(runtime, WorkerStats)) - end || I <- lists:seq(1, 10)], - ok - end), - - wpool:stop_sup_pool(wpool_SUITE_stats_pool), - - no_workers = - ktn_task:wait_for( - fun() -> - try wpool:stats(wpool_SUITE_stats_pool) - catch - _:E -> E - end - end, no_workers, 100, 50), + Get = fun proplists:get_value/2, - {comment, []}. + ok = + try + _ = wpool:stats(?MODULE), + ok + catch + _:no_workers -> + ok + end, + + {ok, PoolPid} = wpool:start_sup_pool(wpool_SUITE_stats_pool, [{workers, 10}]), + true = is_process_alive(PoolPid), + PoolPid = erlang:whereis(wpool_SUITE_stats_pool), + + % Checks ... + [InitStats] = wpool:stats(), + wpool_SUITE_stats_pool = Get(pool, InitStats), + PoolPid = Get(supervisor, InitStats), + Options = Get(options, InitStats), + infinity = Get(overrun_warning, Options), + {error_logger, warning_report} = Get(overrun_handler, Options), + 10 = Get(workers, Options), + 10 = Get(size, InitStats), + 1 = Get(next_worker, InitStats), + InitWorkers = Get(workers, InitStats), + 10 = length(InitWorkers), + _ = [begin + WorkerStats = Get(I, InitWorkers), + 0 = Get(message_queue_len, WorkerStats), + [] = lists:keydelete(message_queue_len, 1, lists:keydelete(memory, 1, WorkerStats)) + end + || I <- lists:seq(1, 10)], + + % Start a long task on every worker + Sleep = {timer, sleep, [2000]}, + [wpool:cast(wpool_SUITE_stats_pool, Sleep, next_worker) || _ <- lists:seq(1, 10)], + + ok = + ktn_task:wait_for_success(fun() -> + WorkingStats = wpool:stats(wpool_SUITE_stats_pool), + wpool_SUITE_stats_pool = Get(pool, WorkingStats), + PoolPid = Get(supervisor, WorkingStats), + Options = Get(options, WorkingStats), + 10 = Get(size, WorkingStats), + 1 = Get(next_worker, WorkingStats), + WorkingWorkers = Get(workers, WorkingStats), + 10 = length(WorkingWorkers), + [begin + WorkerStats = Get(I, WorkingWorkers), + 0 = Get(message_queue_len, WorkerStats), + {timer, sleep, 1} = Get(current_function, WorkerStats), + {timer, sleep, 1, _} = Get(current_location, WorkerStats), + {cast, Sleep} = Get(task, WorkerStats), + true = is_number(Get(runtime, WorkerStats)) + end + || I <- lists:seq(1, 10)], + ok + end), + + wpool:stop_sup_pool(wpool_SUITE_stats_pool), + + no_workers = + ktn_task:wait_for(fun() -> + try + wpool:stats(wpool_SUITE_stats_pool) + catch + _:E -> + E + end + end, + no_workers, + 100, + 50), + + {comment, []}. -spec default_strategy(config()) -> {comment, []}. default_strategy(_Config) -> - application:unset_env(worker_pool, default_strategy), - available_worker = wpool:default_strategy(), - application:set_env(worker_pool, default_strategy, best_worker), - best_worker = wpool:default_strategy(), - application:unset_env(worker_pool, default_strategy), - available_worker = wpool:default_strategy(), - {comment, []}. + application:unset_env(worker_pool, default_strategy), + available_worker = wpool:default_strategy(), + application:set_env(worker_pool, default_strategy, best_worker), + best_worker = wpool:default_strategy(), + application:unset_env(worker_pool, default_strategy), + available_worker = wpool:default_strategy(), + {comment, []}. -spec default_options(config()) -> {comment, []}. default_options(_Config) -> - ct:comment("Starts a pool with default options"), - {ok, PoolPid} = wpool:start_pool(default_pool), - true = is_pid(PoolPid), + ct:comment("Starts a pool with default options"), + {ok, PoolPid} = wpool:start_pool(default_pool), + true = is_pid(PoolPid), - ct:comment("Starts a supervised pool with default options"), - {ok, SupPoolPid} = wpool:start_sup_pool(default_sup_pool), - true = is_pid(SupPoolPid), + ct:comment("Starts a supervised pool with default options"), + {ok, SupPoolPid} = wpool:start_sup_pool(default_sup_pool), + true = is_pid(SupPoolPid), - {comment, []}. + {comment, []}. -spec complete_coverage(config()) -> {comment, []}. complete_coverage(_Config) -> + ct:comment("Time checker"), + {ok, _} = wpool_time_checker:init({pool, [{x, y}]}), - ct:comment("Time checker"), - {ok, State} = wpool_time_checker:init({pool, [{x, y}]}), - ok = wpool_time_checker:terminate(reason, State), - {ok, State} = wpool_time_checker:code_change("oldvsn", State, extra), - - {ok, PoolPid} = wpool:start_pool(coverage, []), - TCPid = get_time_checker(PoolPid), - TCPid ! info, - ok = gen_server:cast(TCPid, cast), + {ok, PoolPid} = wpool:start_pool(coverage, []), + TCPid = get_time_checker(PoolPid), + TCPid ! info, + ok = gen_server:cast(TCPid, cast), - ct:comment("Queue Manager"), - QMPid = get_queue_manager(PoolPid), - QMPid ! info, - {ok, QMState} = wpool_queue_manager:init([{pool, pool}]), - ok = wpool_queue_manager:terminate(reason, QMState), - {ok, QMState} = wpool_queue_manager:code_change("oldvsn", QMState, extra), + ct:comment("Queue Manager"), + QMPid = get_queue_manager(PoolPid), + QMPid ! info, + {ok, _} = wpool_queue_manager:init([{pool, pool}]), - {comment, []}. + {comment, []}. -spec broadcast(config()) -> {comment, []}. broadcast(_Config) -> - Pool = broadcast, - WorkersCount = 19, - {ok, _Pid} = wpool:start_pool(Pool, [{workers, WorkersCount}]), - - ct:comment("Check mecked function is called ~p times.", [WorkersCount]), - meck:new(x, [non_strict]), - meck:expect(x, x, fun() -> ok end), - % Broadcast x:x() execution to workers. - wpool:broadcast(Pool, {x, x, []}), - % Give some time for the workers to perform the calls. - WorkersCount = - ktn_task:wait_for(fun() -> meck:num_calls(x, x, '_') end, WorkersCount), - - ct:comment("Check they all are \"working\""), - % Make all the workers sleep for 1.5 seconds - wpool:broadcast(Pool, {timer, sleep, [1500]}), - % check they all are actually busy (executing timer:sleep/1 function). - try - wpool:call(Pool, {io, format, ["I am awake.~n"]}, next_available_worker), - ct:fail("There was at least 1 worker available") - catch - _:no_available_workers -> ok - end, - - meck:unload(x), - {comment, []}. + Pool = broadcast, + WorkersCount = 19, + {ok, _Pid} = wpool:start_pool(Pool, [{workers, WorkersCount}]), + + ct:comment("Check mecked function is called ~p times.", [WorkersCount]), + meck:new(x, [non_strict]), + meck:expect(x, x, fun() -> ok end), + % Broadcast x:x() execution to workers. + wpool:broadcast(Pool, {x, x, []}), + % Give some time for the workers to perform the calls. + WorkersCount = ktn_task:wait_for(fun() -> meck:num_calls(x, x, '_') end, WorkersCount), + + ct:comment("Check they all are \"working\""), + % Make all the workers sleep for 1.5 seconds + wpool:broadcast(Pool, {timer, sleep, [1500]}), + % check they all are actually busy (executing timer:sleep/1 function). + try + wpool:call(Pool, {io, format, ["I am awake.~n"]}, next_available_worker), + ct:fail("There was at least 1 worker available") + catch + _:no_available_workers -> + ok + end, + + meck:unload(x), + {comment, []}. -spec worker_killed_stats(config()) -> {comment, []}. worker_killed_stats(_Config) -> - %% Each server will take 100ms to start, but the start_sup_pool/2 call is synchronous anyway - {ok, PoolPid} = wpool:start_sup_pool( - wpool_SUITE_worker_killed_stats, [{workers, 3}, {worker, {sleepy_server, 500}}]), - true = erlang:is_process_alive(PoolPid), + %% Each server will take 100ms to start, but the start_sup_pool/2 call is synchronous anyway + {ok, PoolPid} = + wpool:start_sup_pool(wpool_SUITE_worker_killed_stats, + [{workers, 3}, {worker, {sleepy_server, 500}}]), + true = erlang:is_process_alive(PoolPid), - Workers = fun() -> lists:keyfind(workers, 1, wpool:stats(wpool_SUITE_worker_killed_stats)) end, - WorkerName = wpool_pool:worker_name(wpool_SUITE_worker_killed_stats, 1), + Workers = + fun() -> lists:keyfind(workers, 1, wpool:stats(wpool_SUITE_worker_killed_stats)) end, + WorkerName = wpool_pool:worker_name(wpool_SUITE_worker_killed_stats, 1), - ct:comment("wpool:stats/1 should work normally"), - {workers, [_, _, _]} = Workers(), + ct:comment("wpool:stats/1 should work normally"), + {workers, [_, _, _]} = Workers(), - ct:comment("wpool:stats/1 should work even if a process just dies and it's not yet back alive"), - exit(whereis(WorkerName), kill), - {workers, [_, _]} = Workers(), + ct:comment("wpool:stats/1 should work even if a process just dies and it's not yet back alive"), + exit(whereis(WorkerName), kill), + {workers, [_, _]} = Workers(), - ct:comment("Once the process is alive again, we should see it at the stats"), - true = ktn_task:wait_for(fun() -> is_pid(whereis(WorkerName)) end, true, 10, 75), - {workers, [_, _, _]} = Workers(), + ct:comment("Once the process is alive again, we should see it at the stats"), + true = ktn_task:wait_for(fun() -> is_pid(whereis(WorkerName)) end, true, 10, 75), + {workers, [_, _, _]} = Workers(), - {comment, []}. + {comment, []}. %% ============================================================================= %% Helpers %% ============================================================================= get_time_checker(PoolPid) -> - [TCPid] = - [ P - || {_, P, worker, [wpool_time_checker]} <- - supervisor:which_children(PoolPid) - ], - TCPid. + [TCPid] = + [P || {_, P, worker, [wpool_time_checker]} <- supervisor:which_children(PoolPid)], + TCPid. get_queue_manager(PoolPid) -> - [QMPid] = - [ P - || {_, P, worker, [wpool_queue_manager]} <- - supervisor:which_children(PoolPid) - ], - QMPid. + [QMPid] = + [P || {_, P, worker, [wpool_queue_manager]} <- supervisor:which_children(PoolPid)], + QMPid. get_messages(MaxTimeout) -> - get_messages(MaxTimeout, []). + get_messages(MaxTimeout, []). get_messages(MaxTimeout, Acc) -> - receive Any -> get_messages(MaxTimeout, [Any | Acc]) - after MaxTimeout -> Acc - end. + receive + Any -> + get_messages(MaxTimeout, [Any | Acc]) + after MaxTimeout -> + Acc + end. no_messages() -> - case get_messages(1000) of - [] -> ok; - Msgs2 -> ct:fail({unexpected_messages, Msgs2}) - end. + case get_messages(1000) of + [] -> + ok; + Msgs2 -> + ct:fail({unexpected_messages, Msgs2}) + end. diff --git a/test/wpool_bench.erl b/test/wpool_bench.erl index 0a30318..4c53da6 100644 --- a/test/wpool_bench.erl +++ b/test/wpool_bench.erl @@ -1,32 +1,30 @@ -module(wpool_bench). --author('elbrujohalcon@inaka.net'). -export([run_tasks/3]). %% @doc Returns the average time involved in processing the small tasks --spec run_tasks( - [{small|large, pos_integer()}, ...], - wpool:strategy(), [wpool:option()]) -> float(). +-spec run_tasks([{small | large, pos_integer()}, ...], + wpool:strategy(), + [wpool:option()]) -> + float(). run_tasks(TaskGroups, Strategy, Options) -> - Tasks = lists:flatten([lists:duplicate(N, Type) || {Type, N} <- TaskGroups]), - {ok, _Pool} = wpool:start_sup_pool(?MODULE, Options), - try lists:foldl( - fun(Task, Acc) -> run_task(Task, Strategy, Acc) end, - [], Tasks) of - [] -> - error_logger:warning_msg("No times"), - 0.0; - Times -> - error_logger:info_msg("Times: ~p", [Times]), - lists:sum(Times) / length(Times) - after - wpool:stop_sup_pool(?MODULE) - end. + Tasks = lists:flatten([lists:duplicate(N, Type) || {Type, N} <- TaskGroups]), + {ok, _Pool} = wpool:start_sup_pool(?MODULE, Options), + try lists:foldl(fun(Task, Acc) -> run_task(Task, Strategy, Acc) end, [], Tasks) of + [] -> + error_logger:warning_msg("No times"), + 0.0; + Times -> + error_logger:info_msg("Times: ~p", [Times]), + lists:sum(Times) / length(Times) + after + wpool:stop_sup_pool(?MODULE) + end. run_task(small, Strategy, Acc) -> - {Time, {ok, 0}} = - timer:tc(wpool, call, [?MODULE, {erlang, '+', [0, 0]}, Strategy, infinity]), - [Time/1000|Acc]; + {Time, {ok, 0}} = + timer:tc(wpool, call, [?MODULE, {erlang, '+', [0, 0]}, Strategy, infinity]), + [Time / 1000 | Acc]; run_task(large, Strategy, Acc) -> - wpool:cast(?MODULE, {timer, sleep, [30000]}, Strategy), - Acc. + wpool:cast(?MODULE, {timer, sleep, [30000]}, Strategy), + Acc. diff --git a/test/wpool_meta_SUITE.erl b/test/wpool_meta_SUITE.erl deleted file mode 100644 index 2860d05..0000000 --- a/test/wpool_meta_SUITE.erl +++ /dev/null @@ -1,27 +0,0 @@ --module(wpool_meta_SUITE). - --include_lib("mixer/include/mixer.hrl"). --mixin([{ktn_meta_SUITE, [dialyzer/1, elvis/1]}]). - --export([init_per_suite/1, end_per_suite/1]). - --type config() :: [{atom(), term()}]. - --export([all/0]). - --spec all() -> [dialyzer | elvis]. -all() -> [dialyzer, elvis]. - --spec init_per_suite(config()) -> config(). -init_per_suite(Config) -> - [ {application, worker_pool} - %% Until the next version of katana-test fixes the missing test deps in plt - %% issue, we can't use the default warnings that include 'unknown' here. - , { dialyzer_warnings - , [error_handling, race_conditions, unmatched_returns, no_return] - } - | Config - ]. - --spec end_per_suite(config()) -> config(). -end_per_suite(Config) -> Config. diff --git a/test/wpool_pool_SUITE.erl b/test/wpool_pool_SUITE.erl index a0fb306..e5c1302 100644 --- a/test/wpool_pool_SUITE.erl +++ b/test/wpool_pool_SUITE.erl @@ -15,525 +15,533 @@ %% @hidden -module(wpool_pool_SUITE). +-behaviour(ct_suite). + -type config() :: [{atom(), term()}]. -define(WORKERS, 6). --export([ all/0 - ]). --export([ init_per_suite/1 - , end_per_suite/1 - , init_per_testcase/2 - , end_per_testcase/2 - ]). --export([ stop_worker/1 - , best_worker/1 - , next_worker/1 - , random_worker/1 - , available_worker/1 - , hash_worker/1 - , custom_worker/1 - , next_available_worker/1 - , wpool_record/1 - , queue_type_fifo/1 - , queue_type_lifo/1 - ]). --export([ manager_crash/1 - , super_fast/1 - , ets_mess_up/1 - ]). +-export([all/0]). +-export([init_per_suite/1, end_per_suite/1, init_per_testcase/2, end_per_testcase/2]). +-export([stop_worker/1, best_worker/1, next_worker/1, random_worker/1, available_worker/1, + hash_worker/1, custom_worker/1, next_available_worker/1, wpool_record/1, + queue_type_fifo/1, queue_type_lifo/1]). +-export([manager_crash/1, super_fast/1, ets_mess_up/1]). -spec all() -> [atom()]. all() -> - [Fun || {Fun, 1} <- module_info(exports), - not lists:member( Fun - , [ init_per_suite - , end_per_suite - , module_info - ] - )]. + [Fun + || {Fun, 1} <- module_info(exports), + not lists:member(Fun, [init_per_suite, end_per_suite, module_info])]. -spec init_per_suite(config()) -> config(). init_per_suite(Config) -> - ok = wpool:start(), - Config. + ok = wpool:start(), + Config. -spec end_per_suite(config()) -> config(). end_per_suite(Config) -> - wpool:stop(), - Config. + wpool:stop(), + Config. -spec init_per_testcase(atom(), config()) -> config(). init_per_testcase(queue_type_lifo = TestCase, Config) -> - {ok, _} = wpool:start_pool(TestCase, [ - {workers, 1}, {queue_type, lifo}] - ), - Config; - + {ok, _} = wpool:start_pool(TestCase, [{workers, 1}, {queue_type, lifo}]), + Config; init_per_testcase(queue_type_fifo = TestCase, Config) -> - {ok, _} = wpool:start_pool(TestCase, [ - {workers, 1}, {queue_type, fifo}] - ), - Config; - + {ok, _} = wpool:start_pool(TestCase, [{workers, 1}, {queue_type, fifo}]), + Config; init_per_testcase(TestCase, Config) -> - {ok, _} = wpool:start_pool(TestCase, [{workers, ?WORKERS}]), - Config. + {ok, _} = wpool:start_pool(TestCase, [{workers, ?WORKERS}]), + Config. -spec end_per_testcase(atom(), config()) -> config(). end_per_testcase(TestCase, Config) -> - catch wpool:stop_sup_pool(TestCase), - Config. + catch wpool:stop_sup_pool(TestCase), + Config. -spec stop_worker(config()) -> {comment, []}. stop_worker(_Config) -> - true = (undefined /= wpool_pool:find_wpool(stop_worker)), - true = wpool:stop_pool(stop_worker), - undefined = - ktn_task:wait_for( - fun() -> wpool_pool:find_wpool(stop_worker) end, undefined), - true = wpool:stop_pool(stop_worker), - undefined = wpool_pool:find_wpool(stop_worker), - {comment, ""}. + true = undefined /= wpool_pool:find_wpool(stop_worker), + true = wpool:stop_pool(stop_worker), + undefined = ktn_task:wait_for(fun() -> wpool_pool:find_wpool(stop_worker) end, undefined), + true = wpool:stop_pool(stop_worker), + undefined = wpool_pool:find_wpool(stop_worker), + {comment, ""}. -spec available_worker(config()) -> {comment, []}. available_worker(_Config) -> - Pool = available_worker, - try wpool:call(not_a_pool, x) of - Result -> no_result = Result - catch - _:no_workers -> ok - end, + Pool = available_worker, + try wpool:call(not_a_pool, x) of + Result -> + no_result = Result + catch + _:no_workers -> + ok + end, - ct:log( - "Put them all to work, each request should go to a different worker"), - [wpool:cast(Pool, {timer, sleep, [5000]}) || _ <- lists:seq(1, ?WORKERS)], + ct:log("Put them all to work, each request should go to a different worker"), + [wpool:cast(Pool, {timer, sleep, [5000]}) || _ <- lists:seq(1, ?WORKERS)], - [0] = ktn_task:wait_for(fun() -> worker_msg_queue_lengths(Pool) end, [0]), + [0] = ktn_task:wait_for(fun() -> worker_msg_queue_lengths(Pool) end, [0]), - ct:log( - "Now send another round of messages, + ct:log("Now send another round of messages, the workers queues should still be empty"), - [wpool:cast(Pool, {timer, sleep, [100 * I]}) || I <- lists:seq(1, ?WORKERS)], - - % Check that we have ?WORKERS pending tasks - ?WORKERS = - ktn_task:wait_for( - fun() -> - Stats1 = wpool:stats(Pool), - [0] = - lists:usort( - [proplists:get_value(message_queue_len, WS) - || {_, WS} <- proplists:get_value(workers, Stats1)]), - proplists:get_value(total_message_queue_len, Stats1) - end, ?WORKERS), - - ct:log("If we can't wait we get no workers"), - try wpool:call(Pool, {erlang, self, []}, available_worker, 100) of - R -> should_fail = R - catch - _:Error -> timeout = Error - end, - - ct:log("Let's wait until all workers are free"), - wpool:call(Pool, {erlang, self, []}, available_worker, infinity), - - % Check we have no pending tasks - Stats2 = wpool:stats(Pool), - 0 = proplists:get_value(total_message_queue_len, Stats2), - - ct:log("Now they all should be free"), - ct:log("We get half of them working for a while"), - [wpool:cast(Pool, {timer, sleep, [60000]}) || _ <- lists:seq(1, ?WORKERS, 2)], - - % Check we have no pending tasks - 0 = - ktn_task:wait_for( - fun() -> - proplists:get_value(total_message_queue_len, wpool:stats(Pool)) - end, 0), - - ct:log( - "We run tons of calls, and none is blocked, + [wpool:cast(Pool, {timer, sleep, [100 * I]}) || I <- lists:seq(1, ?WORKERS)], + + % Check that we have ?WORKERS pending tasks + ?WORKERS = + ktn_task:wait_for(fun() -> + Stats1 = wpool:stats(Pool), + [0] = + lists:usort([proplists:get_value(message_queue_len, WS) + || {_, WS} <- proplists:get_value(workers, Stats1)]), + proplists:get_value(total_message_queue_len, Stats1) + end, + ?WORKERS), + + ct:log("If we can't wait we get no workers"), + try wpool:call(Pool, {erlang, self, []}, available_worker, 100) of + R -> + should_fail = R + catch + _:Error -> + timeout = Error + end, + + ct:log("Let's wait until all workers are free"), + wpool:call(Pool, {erlang, self, []}, available_worker, infinity), + + % Check we have no pending tasks + Stats2 = wpool:stats(Pool), + 0 = proplists:get_value(total_message_queue_len, Stats2), + + ct:log("Now they all should be free"), + ct:log("We get half of them working for a while"), + [wpool:cast(Pool, {timer, sleep, [60000]}) || _ <- lists:seq(1, ?WORKERS, 2)], + + % Check we have no pending tasks + 0 = + ktn_task:wait_for(fun() -> proplists:get_value(total_message_queue_len, wpool:stats(Pool)) + end, + 0), + + ct:log("We run tons of calls, and none is blocked, because all of them are handled by different workers"), - Workers = - [ wpool:call(Pool, {erlang, self, []}, available_worker, 5000) - || _ <- lists:seq(1, 20 * ?WORKERS)], - UniqueWorkers = sets:to_list(sets:from_list(Workers)), - {?WORKERS, UniqueWorkers, true} = - {?WORKERS, UniqueWorkers, (?WORKERS/2) >= length(UniqueWorkers)}, + Workers = + [wpool:call(Pool, {erlang, self, []}, available_worker, 5000) + || _ <- lists:seq(1, 20 * ?WORKERS)], + UniqueWorkers = + sets:to_list( + sets:from_list(Workers)), + {?WORKERS, UniqueWorkers, true} = + {?WORKERS, UniqueWorkers, ?WORKERS / 2 >= length(UniqueWorkers)}, - {comment, []}. + {comment, []}. -spec best_worker(config()) -> {comment, []}. best_worker(_Config) -> - Pool = best_worker, - try wpool:call(not_a_pool, x, best_worker) of - Result -> no_result = Result - catch - _:no_workers -> ok - end, + Pool = best_worker, + try wpool:call(not_a_pool, x, best_worker) of + Result -> + no_result = Result + catch + _:no_workers -> + ok + end, - %% Fill up their message queues... - [ wpool:cast(Pool, {timer, sleep, [60000]}, next_worker) - || _ <- lists:seq(1, ?WORKERS)], - [0] = ktn_task:wait_for(fun() -> worker_msg_queue_lengths(Pool) end, [0]), + %% Fill up their message queues... + [wpool:cast(Pool, {timer, sleep, [60000]}, next_worker) || _ <- lists:seq(1, ?WORKERS)], + [0] = ktn_task:wait_for(fun() -> worker_msg_queue_lengths(Pool) end, [0]), - [ wpool:cast(Pool, {timer, sleep, [60000]}, best_worker) - || _ <- lists:seq(1, ?WORKERS)], + [wpool:cast(Pool, {timer, sleep, [60000]}, best_worker) || _ <- lists:seq(1, ?WORKERS)], - [1] = ktn_task:wait_for(fun() -> worker_msg_queue_lengths(Pool) end, [1]), + [1] = ktn_task:wait_for(fun() -> worker_msg_queue_lengths(Pool) end, [1]), - %% Now try best worker once per worker - [ wpool:cast(Pool, {timer, sleep, [60000]}, best_worker) - || _ <- lists:seq(1, ?WORKERS)], - %% The load should be evenly distributed... - [2] = ktn_task:wait_for(fun() -> worker_msg_queue_lengths(Pool) end, [2]), + %% Now try best worker once per worker + [wpool:cast(Pool, {timer, sleep, [60000]}, best_worker) || _ <- lists:seq(1, ?WORKERS)], + %% The load should be evenly distributed... + [2] = ktn_task:wait_for(fun() -> worker_msg_queue_lengths(Pool) end, [2]), - {comment, []}. + {comment, []}. -spec next_available_worker(config()) -> {comment, []}. next_available_worker(_Config) -> - Pool = next_available_worker, - ct:log("not_a_pool is not a pool"), - try wpool:call(not_a_pool, x, next_available_worker) of - Result -> no_result = Result - catch - _:no_workers -> ok - end, - - ct:log("Put them all to work..."), - [ wpool:cast(Pool, {timer, sleep, [1500 + I]}, next_available_worker) - || I <- lists:seq(0, (?WORKERS - 1) * 60000, 60000)], - - AvailableWorkers = - fun() -> - length( - [a_worker - || {_, WS} <- proplists:get_value(workers, wpool:stats(Pool)) - , proplists:get_value(task, WS) == undefined]) + Pool = next_available_worker, + ct:log("not_a_pool is not a pool"), + try wpool:call(not_a_pool, x, next_available_worker) of + Result -> + no_result = Result + catch + _:no_workers -> + ok end, - ct:log("All busy..."), - 0 = ktn_task:wait_for(AvailableWorkers, 0), - - ct:log("No available workers..."), - try wpool:cast(Pool, {timer, sleep, [60000]}, next_available_worker) of - ok -> ct:fail("Exception expected") - catch - _:no_available_workers -> ok - end, + ct:log("Put them all to work..."), + [wpool:cast(Pool, {timer, sleep, [1500 + I]}, next_available_worker) + || I <- lists:seq(0, (?WORKERS - 1) * 60000, 60000)], + + AvailableWorkers = + fun() -> + length([a_worker + || {_, WS} <- proplists:get_value(workers, wpool:stats(Pool)), + proplists:get_value(task, WS) == undefined]) + end, + + ct:log("All busy..."), + 0 = ktn_task:wait_for(AvailableWorkers, 0), + + ct:log("No available workers..."), + try wpool:cast(Pool, {timer, sleep, [60000]}, next_available_worker) of + ok -> + ct:fail("Exception expected") + catch + _:no_available_workers -> + ok + end, - ct:log("Wait until the first frees up..."), - 1 = ktn_task:wait_for(AvailableWorkers, 1), + ct:log("Wait until the first frees up..."), + 1 = ktn_task:wait_for(AvailableWorkers, 1), - ok = wpool:cast(Pool, {timer, sleep, [60000]}, next_available_worker), + ok = wpool:cast(Pool, {timer, sleep, [60000]}, next_available_worker), - ct:log("No more available workers..."), - try wpool:cast(Pool, {timer, sleep, [60000]}, next_available_worker) of - ok -> ct:fail("Exception expected") - catch - _:no_available_workers -> ok - end, + ct:log("No more available workers..."), + try wpool:cast(Pool, {timer, sleep, [60000]}, next_available_worker) of + ok -> + ct:fail("Exception expected") + catch + _:no_available_workers -> + ok + end, - {comment, []}. + {comment, []}. -spec next_worker(config()) -> {comment, []}. next_worker(_Config) -> - Pool = next_worker, - - try wpool:call(not_a_pool, x, next_worker) of - Result -> no_result = Result - catch - _:no_workers -> ok - end, - - Res0 = [begin - Stats = wpool:stats(Pool), - I = proplists:get_value(next_worker, Stats), - wpool:call(Pool, {erlang, self, []}, next_worker, infinity) - end || I <- lists:seq(1, ?WORKERS)], - ?WORKERS = sets:size(sets:from_list(Res0)), - Res0 = [begin - Stats = wpool:stats(Pool), - I = proplists:get_value(next_worker, Stats), - wpool:call(Pool, {erlang, self, []}, next_worker) - end || I <- lists:seq(1, ?WORKERS)], - - {comment, []}. + Pool = next_worker, + + try wpool:call(not_a_pool, x, next_worker) of + Result -> + no_result = Result + catch + _:no_workers -> + ok + end, + + Res0 = + [begin + Stats = wpool:stats(Pool), + I = proplists:get_value(next_worker, Stats), + wpool:call(Pool, {erlang, self, []}, next_worker, infinity) + end + || I <- lists:seq(1, ?WORKERS)], + ?WORKERS = + sets:size( + sets:from_list(Res0)), + Res0 = + [begin + Stats = wpool:stats(Pool), + I = proplists:get_value(next_worker, Stats), + wpool:call(Pool, {erlang, self, []}, next_worker) + end + || I <- lists:seq(1, ?WORKERS)], + + {comment, []}. -spec random_worker(config()) -> {comment, []}. random_worker(_Config) -> - Pool = random_worker, - - try wpool:call(not_a_pool, x, random_worker) of - Result -> no_result = Result - catch - _:no_workers -> ok - end, - - %% Ask for a random worker's identity 20x more than the number of workers - %% and expect to get an answer from every worker at least once. - Serial = - [ wpool:call(Pool, {erlang, self, []}, random_worker) - || _ <- lists:seq(1, 20 * ?WORKERS)], - ?WORKERS = sets:size(sets:from_list(Serial)), - - %% Now do the same with a freshly spawned process for each request to ensure - %% randomness isn't reset with each spawn of the process_dictionary - Self = self(), - _ = [spawn(fun() -> - WorkerId = wpool:call(Pool, {erlang, self, []}, random_worker), - Self ! {worker, WorkerId} - end) || _ <- lists:seq(1, 20 * ?WORKERS)], - Concurrent = collect_results(20 * ?WORKERS, []), - ?WORKERS = sets:size(sets:from_list(Concurrent)), - - {comment, []}. + Pool = random_worker, + + try wpool:call(not_a_pool, x, random_worker) of + Result -> + no_result = Result + catch + _:no_workers -> + ok + end, + + %% Ask for a random worker's identity 20x more than the number of workers + %% and expect to get an answer from every worker at least once. + Serial = + [wpool:call(Pool, {erlang, self, []}, random_worker) || _ <- lists:seq(1, 20 * ?WORKERS)], + ?WORKERS = + sets:size( + sets:from_list(Serial)), + + %% Now do the same with a freshly spawned process for each request to ensure + %% randomness isn't reset with each spawn of the process_dictionary + Self = self(), + _ = [spawn(fun() -> + WorkerId = wpool:call(Pool, {erlang, self, []}, random_worker), + Self ! {worker, WorkerId} + end) + || _ <- lists:seq(1, 20 * ?WORKERS)], + Concurrent = collect_results(20 * ?WORKERS, []), + ?WORKERS = + sets:size( + sets:from_list(Concurrent)), + + {comment, []}. -spec hash_worker(config()) -> {comment, []}. hash_worker(_Config) -> - Pool = hash_worker, - - try wpool:call(not_a_pool, x, {hash_worker, 1}) of - Result -> no_result = Result - catch - _:no_workers -> ok - end, - - %% Use two hash keys that have different values (0, 1) to target only - %% two workers. Other workers should be missing. - Targeted = - [ wpool:call(Pool, {erlang, self, []}, {hash_worker, I rem 2}) - || I <- lists:seq(1, 20 * ?WORKERS)], - 2 = sets:size(sets:from_list(Targeted)), + Pool = hash_worker, + + try wpool:call(not_a_pool, x, {hash_worker, 1}) of + Result -> + no_result = Result + catch + _:no_workers -> + ok + end, - %% Now use many different hash keys. All workers should be hit. - Spread = - [ wpool:call(Pool, {erlang, self, []}, {hash_worker, I}) + %% Use two hash keys that have different values (0, 1) to target only + %% two workers. Other workers should be missing. + Targeted = + [wpool:call(Pool, {erlang, self, []}, {hash_worker, I rem 2}) + || I <- lists:seq(1, 20 * ?WORKERS)], + 2 = + sets:size( + sets:from_list(Targeted)), + + %% Now use many different hash keys. All workers should be hit. + Spread = + [wpool:call(Pool, {erlang, self, []}, {hash_worker, I}) + || I <- lists:seq(1, 20 * ?WORKERS)], + ?WORKERS = + sets:size( + sets:from_list(Spread)), + + %% Fill up their message queues... + [wpool:cast(Pool, {timer, sleep, [60000]}, {hash_worker, I}) || I <- lists:seq(1, 20 * ?WORKERS)], - ?WORKERS = sets:size(sets:from_list(Spread)), - %% Fill up their message queues... - [ wpool:cast(Pool, {timer, sleep, [60000]}, {hash_worker, I}) - || I <- lists:seq(1, 20 * ?WORKERS)], + false = + ktn_task:wait_for(fun() -> lists:member(0, worker_msg_queue_lengths(Pool)) end, false), - false = - ktn_task:wait_for( - fun() -> lists:member(0, worker_msg_queue_lengths(Pool)) end, false), - - {comment, []}. + {comment, []}. -spec custom_worker(config()) -> {comment, []}. custom_worker(_Config) -> - Pool = custom_worker, - - Strategy = fun wpool_pool:next_worker/1, - - try wpool:call(not_a_pool, x, Strategy) of - Result -> no_result = Result - catch - _:no_workers -> ok - end, - - _ = - [ begin - Stats = wpool:stats(Pool), - I = proplists:get_value(next_worker, Stats), - wpool:cast(Pool, {io, format, ["ok!"]}, Strategy) - end || I <- lists:seq(1, ?WORKERS)], - - Res0 = [begin - Stats = wpool:stats(Pool), - I = proplists:get_value(next_worker, Stats), - wpool:call(Pool, {erlang, self, []}, Strategy, infinity) - end || I <- lists:seq(1, ?WORKERS)], - ?WORKERS = sets:size(sets:from_list(Res0)), - Res0 = [begin - Stats = wpool:stats(Pool), - I = proplists:get_value(next_worker, Stats), - wpool:call(Pool, {erlang, self, []}, Strategy) - end || I <- lists:seq(1, ?WORKERS)], - - {comment, []}. + Pool = custom_worker, + + Strategy = fun wpool_pool:next_worker/1, + + try wpool:call(not_a_pool, x, Strategy) of + Result -> + no_result = Result + catch + _:no_workers -> + ok + end, + + _ = [begin + Stats = wpool:stats(Pool), + I = proplists:get_value(next_worker, Stats), + wpool:cast(Pool, {io, format, ["ok!"]}, Strategy) + end + || I <- lists:seq(1, ?WORKERS)], + + Res0 = + [begin + Stats = wpool:stats(Pool), + I = proplists:get_value(next_worker, Stats), + wpool:call(Pool, {erlang, self, []}, Strategy, infinity) + end + || I <- lists:seq(1, ?WORKERS)], + ?WORKERS = + sets:size( + sets:from_list(Res0)), + Res0 = + [begin + Stats = wpool:stats(Pool), + I = proplists:get_value(next_worker, Stats), + wpool:call(Pool, {erlang, self, []}, Strategy) + end + || I <- lists:seq(1, ?WORKERS)], + + {comment, []}. -spec manager_crash(config()) -> {comment, []}. manager_crash(_Config) -> - Pool = manager_crash, - QueueManager = 'wpool_pool-manager_crash-queue-manager', + Pool = manager_crash, + QueueManager = 'wpool_pool-manager_crash-queue-manager', - ct:log("Check that the pool is working"), - {ok, ok} = send_io_format(Pool), + ct:log("Check that the pool is working"), + {ok, ok} = send_io_format(Pool), - OldPid = whereis(QueueManager), + OldPid = whereis(QueueManager), - ct:log("Crash the pool manager"), - exit(whereis(QueueManager), kill), + ct:log("Crash the pool manager"), + exit(whereis(QueueManager), kill), - false = - ktn_task:wait_for( - fun() -> - lists:member(whereis(QueueManager), [OldPid, undefined]) - end, false), + false = + ktn_task:wait_for(fun() -> lists:member(whereis(QueueManager), [OldPid, undefined]) end, + false), - ct:log("Check that the pool is working again"), - {ok, ok} = send_io_format(Pool), + ct:log("Check that the pool is working again"), + {ok, ok} = send_io_format(Pool), - {comment, []}. + {comment, []}. -spec super_fast(config()) -> {comment, []}. super_fast(_Config) -> - Pool = super_fast, - - ct:log("Check that the pool is working"), - {ok, ok} = send_io_format(Pool), - - ct:log("Impossible task"), - Self = self(), - try wpool:call( - Pool, {erlang, send, [Self, something]}, available_worker, 0) of - R -> ct:fail("Unexpected ~p", [R]) - catch - _:timeout -> ok - end, + Pool = super_fast, + + ct:log("Check that the pool is working"), + {ok, ok} = send_io_format(Pool), + + ct:log("Impossible task"), + Self = self(), + try wpool:call(Pool, {erlang, send, [Self, something]}, available_worker, 0) of + R -> + ct:fail("Unexpected ~p", [R]) + catch + _:timeout -> + ok + end, - ct:log("Wait a second and nothing gets here"), - receive - X -> ct:fail("Unexpected ~p", [X]) - after 1000 -> - ok - end, + ct:log("Wait a second and nothing gets here"), + receive + X -> + ct:fail("Unexpected ~p", [X]) + after 1000 -> + ok + end, - {comment, []}. + {comment, []}. -spec queue_type_fifo(config()) -> {comment, []}. queue_type_fifo(_Config) -> - Pool = queue_type_fifo, - Self = self(), - TasksNumber = 10, - Tasks = lists:seq(1, TasksNumber), + Pool = queue_type_fifo, + Self = self(), + TasksNumber = 10, + Tasks = lists:seq(1, TasksNumber), - ct:log("Pretend worker is busy"), - wpool:cast(Pool, {timer, sleep, [timer:seconds(2)]}), + ct:log("Pretend worker is busy"), + wpool:cast(Pool, {timer, sleep, [timer:seconds(2)]}), - ct:log( - "Cast 10 enumerated tasks. Tasks should be queued because worker is busy."), - cast_tasks(Pool, TasksNumber, Self), + ct:log("Cast 10 enumerated tasks. Tasks should be queued because worker is busy."), + cast_tasks(Pool, TasksNumber, Self), - ct:log("Collect task results"), - Result = collect_tasks(TasksNumber), + ct:log("Collect task results"), + Result = collect_tasks(TasksNumber), - ct:log("Check if tasks were performd in FIFO order."), - Result = Tasks, + ct:log("Check if tasks were performd in FIFO order."), + Result = Tasks, - {comment, []}. + {comment, []}. -spec queue_type_lifo(config()) -> {comment, []}. queue_type_lifo(_Config) -> - Pool = queue_type_lifo, - Self = self(), - TasksNumber = 10, - Tasks = lists:seq(1, TasksNumber), + Pool = queue_type_lifo, + Self = self(), + TasksNumber = 10, + Tasks = lists:seq(1, TasksNumber), - ct:log("Pretend worker is busy"), - wpool:cast(Pool, {timer, sleep, [timer:seconds(4)]}), + ct:log("Pretend worker is busy"), + wpool:cast(Pool, {timer, sleep, [timer:seconds(4)]}), - ct:log( - "Cast 10 enumerated tasks. Tasks should be queued because worker is busy."), - cast_tasks(Pool, TasksNumber, Self), + ct:log("Cast 10 enumerated tasks. Tasks should be queued because worker is busy."), + cast_tasks(Pool, TasksNumber, Self), - ct:log("Collect task results"), - Result = collect_tasks(TasksNumber), + ct:log("Collect task results"), + Result = collect_tasks(TasksNumber), - ct:log("Check if tasks were performd in LIFO order."), - Result = lists:reverse(Tasks), + ct:log("Check if tasks were performd in LIFO order."), + Result = lists:reverse(Tasks), - {comment, []}. + {comment, []}. -spec wpool_record(config()) -> {comment, []}. wpool_record(_Config) -> - WPool = wpool_pool:find_wpool(wpool_record), - wpool_record = wpool_pool:wpool_get(name, WPool), - 6 = wpool_pool:wpool_get(size, WPool), - [_, _, _, _] = wpool_pool:wpool_get([next, opts, qmanager, born], WPool), - - WPool2 = wpool_pool:next(3, WPool), - 3 = wpool_pool:wpool_get(next, WPool2), + WPool = wpool_pool:find_wpool(wpool_record), + wpool_record = wpool_pool:wpool_get(name, WPool), + 6 = wpool_pool:wpool_get(size, WPool), + [_, _, _, _] = wpool_pool:wpool_get([next, opts, qmanager, born], WPool), - {comment, []}. + WPool2 = wpool_pool:next(3, WPool), + 3 = wpool_pool:wpool_get(next, WPool2), + {comment, []}. -spec ets_mess_up(config()) -> {comment, []}. ets_mess_up(_Config) -> - Pool = ets_mess_up, - - ct:comment("Mess up with ets table..."), - true = ets:delete(wpool_pool, Pool), - - ct:comment("Rebuild stats"), - 1 = proplists:get_value(next_worker, wpool:stats(Pool)), - - ct:comment("Mess up with ets table again..."), - true = ets:delete(wpool_pool, Pool), - {ok, ok} = wpool:call(Pool, {io, format, ["1!~n"]}, random_worker), - - ct:comment("Mess up with ets table once more..."), - {ok, ok} = wpool:call(Pool, {io, format, ["2!~n"]}, next_worker), - 2 = proplists:get_value(next_worker, wpool:stats(Pool)), - true = ets:delete(wpool_pool, Pool), - {ok, ok} = wpool:call(Pool, {io, format, ["3!~n"]}, next_worker), - 1 = proplists:get_value(next_worker, wpool:stats(Pool)), - - ct:comment("Mess up with ets table one final time..."), - true = ets:delete(wpool_pool, Pool), - _ = wpool_pool:find_wpool(Pool), - - ct:comment("Now, delete the pool"), - Flag = process_flag(trap_exit, true), - exit(whereis(Pool), kill), - ok = - ktn_task:wait_for( - fun() -> - try wpool:call(Pool, {io, format, ["1!~n"]}, random_worker) of - X -> {unexpected, X} - catch - _:no_workers -> ok - end - end, ok), - - true = process_flag(trap_exit, Flag), - - ct:comment("And now delete the ets table altogether"), - true = ets:delete(wpool_pool), - _ = wpool_pool:find_wpool(Pool), - - wpool:stop(), - ok = wpool:start(), - - {comment, []}. + Pool = ets_mess_up, + + ct:comment("Mess up with ets table..."), + true = ets:delete(wpool_pool, Pool), + + ct:comment("Rebuild stats"), + 1 = proplists:get_value(next_worker, wpool:stats(Pool)), + + ct:comment("Mess up with ets table again..."), + true = ets:delete(wpool_pool, Pool), + {ok, ok} = wpool:call(Pool, {io, format, ["1!~n"]}, random_worker), + + ct:comment("Mess up with ets table once more..."), + {ok, ok} = wpool:call(Pool, {io, format, ["2!~n"]}, next_worker), + 2 = proplists:get_value(next_worker, wpool:stats(Pool)), + true = ets:delete(wpool_pool, Pool), + {ok, ok} = wpool:call(Pool, {io, format, ["3!~n"]}, next_worker), + 1 = proplists:get_value(next_worker, wpool:stats(Pool)), + + ct:comment("Mess up with ets table one final time..."), + true = ets:delete(wpool_pool, Pool), + _ = wpool_pool:find_wpool(Pool), + + ct:comment("Now, delete the pool"), + Flag = process_flag(trap_exit, true), + exit(whereis(Pool), kill), + ok = + ktn_task:wait_for(fun() -> + try wpool:call(Pool, {io, format, ["1!~n"]}, random_worker) of + X -> + {unexpected, X} + catch + _:no_workers -> + ok + end + end, + ok), + + true = process_flag(trap_exit, Flag), + + ct:comment("And now delete the ets table altogether"), + true = ets:delete(wpool_pool), + _ = wpool_pool:find_wpool(Pool), + + wpool:stop(), + ok = wpool:start(), + + {comment, []}. cast_tasks(Pool, TasksNumber, ReplyTo) -> - lists:foreach(fun(N) -> - wpool:cast(Pool, {erlang, send, [ReplyTo, {task, N}]}) - end, lists:seq(1, TasksNumber)). + lists:foreach(fun(N) -> wpool:cast(Pool, {erlang, send, [ReplyTo, {task, N}]}) end, + lists:seq(1, TasksNumber)). collect_tasks(TasksNumber) -> - lists:map(fun(_) -> - receive - {task, N} -> N - end - end, lists:seq(1, TasksNumber)). - -collect_results(0, Results) -> Results; + lists:map(fun(_) -> + receive + {task, N} -> + N + end + end, + lists:seq(1, TasksNumber)). + +collect_results(0, Results) -> + Results; collect_results(N, Results) -> - receive {worker, WorkerId} -> collect_results(N-1, [WorkerId | Results]) - after 100 -> timeout - end. + receive + {worker, WorkerId} -> + collect_results(N - 1, [WorkerId | Results]) + after 100 -> + timeout + end. send_io_format(Pool) -> - {ok, ok} = wpool:call(Pool, {io, format, ["ok!~n"]}, available_worker). + {ok, ok} = wpool:call(Pool, {io, format, ["ok!~n"]}, available_worker). worker_msg_queue_lengths(Pool) -> - lists:usort( - [proplists:get_value(message_queue_len, WS) - || {_, WS} <- proplists:get_value(workers, wpool:stats(Pool))]). + lists:usort([proplists:get_value(message_queue_len, WS) + || {_, WS} <- proplists:get_value(workers, wpool:stats(Pool))]). diff --git a/test/wpool_process_SUITE.erl b/test/wpool_process_SUITE.erl index d13209e..e0c066d 100644 --- a/test/wpool_process_SUITE.erl +++ b/test/wpool_process_SUITE.erl @@ -15,308 +15,293 @@ %% @hidden -module(wpool_process_SUITE). --type config() :: [{atom(), term()}]. +-behaviour(ct_suite). --export([ all/0 - ]). --export([ init_per_suite/1 - , end_per_suite/1 - , init_per_testcase/2 - , end_per_testcase/2 - ]). --export([ init/1 - , init_timeout/1 - , info/1 - , cast/1 - , call/1 - , continue/1 - , format_status/1 - , no_format_status/1 - , stop/1 - ]). --export([ pool_restart_crash/1 - , pool_norestart_crash/1 - , complete_coverage/1 - ]). +-type config() :: [{atom(), term()}]. +-export([all/0]). +-export([init_per_suite/1, end_per_suite/1, init_per_testcase/2, end_per_testcase/2]). +-export([init/1, init_timeout/1, info/1, cast/1, call/1, continue/1, format_status/1, + no_format_status/1, stop/1]). +-export([pool_restart_crash/1, pool_norestart_crash/1, complete_coverage/1]). -spec all() -> [atom()]. all() -> - [Fun || {Fun, 1} <- module_info(exports), - not lists:member(Fun, [init_per_suite, end_per_suite, module_info])]. + [Fun + || {Fun, 1} <- module_info(exports), + not lists:member(Fun, [init_per_suite, end_per_suite, module_info])]. -spec init_per_suite(config()) -> config(). init_per_suite(Config) -> - ok = wpool:start(), - Config. + ok = wpool:start(), + Config. -spec end_per_suite(config()) -> config(). end_per_suite(Config) -> - wpool:stop(), - Config. + wpool:stop(), + Config. -spec init_per_testcase(atom(), config()) -> config(). init_per_testcase(_TestCase, Config) -> - process_flag(trap_exit, true), - Config. + process_flag(trap_exit, true), + Config. -spec end_per_testcase(atom(), config()) -> config(). end_per_testcase(_TestCase, Config) -> - process_flag(trap_exit, false), - receive after 0 -> ok end, - Config. + process_flag(trap_exit, false), + receive after 0 -> + ok + end, + Config. -spec init(config()) -> {comment, []}. init(_Config) -> - {error, can_not_ignore} = - wpool_process:start_link(?MODULE, echo_server, ignore, []), - {error, ?MODULE} = - wpool_process:start_link(?MODULE, echo_server, {stop, ?MODULE}, []), - {ok, _Pid} = wpool_process:start_link(?MODULE, echo_server, {ok, state}, []), - wpool_process:cast(?MODULE, {stop, normal, state}), + {error, can_not_ignore} = wpool_process:start_link(?MODULE, echo_server, ignore, []), + {error, ?MODULE} = wpool_process:start_link(?MODULE, echo_server, {stop, ?MODULE}, []), + {ok, _Pid} = wpool_process:start_link(?MODULE, echo_server, {ok, state}, []), + wpool_process:cast(?MODULE, {stop, normal, state}), - {comment, []}. + {comment, []}. -spec init_timeout(config()) -> {comment, []}. init_timeout(_Config) -> - {ok, Pid} = - wpool_process:start_link(?MODULE, echo_server, {ok, state, 0}, []), - timeout = get_state(?MODULE), - Pid ! {stop, normal, state}, - false = ktn_task:wait_for(fun() -> erlang:is_process_alive(Pid) end, false), + {ok, Pid} = wpool_process:start_link(?MODULE, echo_server, {ok, state, 0}, []), + timeout = get_state(?MODULE), + Pid ! {stop, normal, state}, + false = ktn_task:wait_for(fun() -> erlang:is_process_alive(Pid) end, false), - {comment, []}. + {comment, []}. -spec info(config()) -> {comment, []}. info(_Config) -> - {ok, Pid} = wpool_process:start_link(?MODULE, echo_server, {ok, state}, []), - Pid ! {noreply, newstate}, - newstate = get_state(?MODULE), - Pid ! {noreply, newerstate, 1}, - timeout = ktn_task:wait_for(fun() -> get_state(?MODULE) end, timeout), - Pid ! {stop, normal, state}, - false = ktn_task:wait_for(fun() -> erlang:is_process_alive(Pid) end, false), + {ok, Pid} = wpool_process:start_link(?MODULE, echo_server, {ok, state}, []), + Pid ! {noreply, newstate}, + newstate = get_state(?MODULE), + Pid ! {noreply, newerstate, 1}, + timeout = ktn_task:wait_for(fun() -> get_state(?MODULE) end, timeout), + Pid ! {stop, normal, state}, + false = ktn_task:wait_for(fun() -> erlang:is_process_alive(Pid) end, false), - {comment, []}. + {comment, []}. -spec cast(config()) -> {comment, []}. cast(_Config) -> - {ok, Pid} = wpool_process:start_link(?MODULE, echo_server, {ok, state}, []), - wpool_process:cast(Pid, {noreply, newstate}), - newstate = get_state(?MODULE), - wpool_process:cast(Pid, {noreply, newerstate, 0}), - timeout = ktn_task:wait_for(fun() -> get_state(?MODULE) end, timeout), - wpool_process:cast(Pid, {stop, normal, state}), - false = ktn_task:wait_for(fun() -> erlang:is_process_alive(Pid) end, false), + {ok, Pid} = wpool_process:start_link(?MODULE, echo_server, {ok, state}, []), + wpool_process:cast(Pid, {noreply, newstate}), + newstate = get_state(?MODULE), + wpool_process:cast(Pid, {noreply, newerstate, 0}), + timeout = ktn_task:wait_for(fun() -> get_state(?MODULE) end, timeout), + wpool_process:cast(Pid, {stop, normal, state}), + false = ktn_task:wait_for(fun() -> erlang:is_process_alive(Pid) end, false), - {comment, []}. + {comment, []}. -spec continue(config()) -> {comment, []}. continue(_Config) -> - C = fun(ContinueState) -> {noreply, ContinueState} end, - %% init/1 returns {continue, continue_state} - {ok, Pid} = - wpool_process:start_link( - ?MODULE, echo_server, {ok, state, {continue, C(continue_state)}}, []), - continue_state = get_state(Pid), - - %% handle_call/3 returns {continue, ...} - ok = - wpool_process:call( - Pid, {reply, ok, state, {continue, C(continue_state_2)}}, 5000), - continue_state_2 = get_state(Pid), - try wpool_process:call( - Pid, {noreply, state, {continue, C(continue_state_3)}}, 100) of - Result -> ct:fail("Unexpected Result: ~p", [Result]) - catch - _:{timeout, _} -> - continue_state_3 = get_state(Pid) - end, - - %% handle_cast/2 returns {continue, ...} - wpool_process:cast(Pid, {noreply, state, {continue, C(continue_state_4)}}), - continue_state_4 = get_state(Pid), - - %% handle_continue/2 returns {continue, ...} - SecondContinueResponse = C(continue_state_5), - FirstContinueResponse = - {noreply, another_state, {continue, SecondContinueResponse}}, - CastResponse = {noreply, state, {continue, FirstContinueResponse}}, - wpool_process:cast(Pid, CastResponse), - continue_state_5 = get_state(Pid), - - %% handle_info/2 returns {continue, ...} - Pid ! {noreply, state, {continue, C(continue_state_6)}}, - continue_state_6 = get_state(Pid), - - %% handle_continue/2 returns {continue, ...} - SecondContinueResponse = C(continue_state_5), - FirstContinueResponse = - {noreply, another_state, {continue, SecondContinueResponse}}, - CastResponse = {noreply, state, {continue, FirstContinueResponse}}, - wpool_process:cast(Pid, CastResponse), - continue_state_5 = get_state(Pid), - - %% handle_continue/2 returns timeout = 0 - wpool_process:cast( - Pid, {noreply, state, {continue, {noreply, continue_state_7, 0}}}), - timeout = ktn_task:wait_for(fun() -> get_state(?MODULE) end, timeout), - - %% handle_continue/2 returns {stop, normal, state} - wpool_process:cast(Pid, {noreply, state, {continue, {stop, normal, state}}}), - false = ktn_task:wait_for(fun() -> erlang:is_process_alive(Pid) end, false), - - {comment, []}. + C = fun(ContinueState) -> {noreply, ContinueState} end, + %% init/1 returns {continue, continue_state} + {ok, Pid} = + wpool_process:start_link(?MODULE, + echo_server, + {ok, state, {continue, C(continue_state)}}, + []), + continue_state = get_state(Pid), + + %% handle_call/3 returns {continue, ...} + ok = wpool_process:call(Pid, {reply, ok, state, {continue, C(continue_state_b)}}, 5000), + continue_state_b = get_state(Pid), + try wpool_process:call(Pid, {noreply, state, {continue, C(continue_state_c)}}, 100) of + Result -> + ct:fail("Unexpected Result: ~p", [Result]) + catch + _:{timeout, _} -> + continue_state_c = get_state(Pid) + end, + + %% handle_cast/2 returns {continue, ...} + wpool_process:cast(Pid, {noreply, state, {continue, C(continue_state_d)}}), + continue_state_d = get_state(Pid), + + %% handle_continue/2 returns {continue, ...} + SecondContinueResponse = C(continue_state_e), + FirstContinueResponse = {noreply, another_state, {continue, SecondContinueResponse}}, + CastResponse = {noreply, state, {continue, FirstContinueResponse}}, + wpool_process:cast(Pid, CastResponse), + continue_state_e = get_state(Pid), + + %% handle_info/2 returns {continue, ...} + Pid ! {noreply, state, {continue, C(continue_state_f)}}, + continue_state_f = get_state(Pid), + + %% handle_continue/2 returns {continue, ...} + SecondContinueResponse = C(continue_state_e), + FirstContinueResponse = {noreply, another_state, {continue, SecondContinueResponse}}, + CastResponse = {noreply, state, {continue, FirstContinueResponse}}, + wpool_process:cast(Pid, CastResponse), + continue_state_e = get_state(Pid), + + %% handle_continue/2 returns timeout = 0 + wpool_process:cast(Pid, {noreply, state, {continue, {noreply, continue_state_g, 0}}}), + timeout = ktn_task:wait_for(fun() -> get_state(?MODULE) end, timeout), + + %% handle_continue/2 returns {stop, normal, state} + wpool_process:cast(Pid, {noreply, state, {continue, {stop, normal, state}}}), + false = ktn_task:wait_for(fun() -> erlang:is_process_alive(Pid) end, false), + + {comment, []}. -spec format_status(config()) -> {comment, []}. format_status(_Config) -> - %% echo_server implements format_status/2 - {ok, Pid} = wpool_process:start_link(?MODULE, echo_server, {ok, state}, []), - %% therefore it returns {formatted_state, State} as its status - {status, Pid, {module, gen_server}, SItems} = sys:get_status(Pid), - [state] = - [S || SItemList = [_|_] <- SItems, {formatted_state, S} <- SItemList], - %% this code is actually what we use to retrieve the state in other tests - state = get_state(Pid), - {comment, []}. + %% echo_server implements format_status/2 + {ok, Pid} = wpool_process:start_link(?MODULE, echo_server, {ok, state}, []), + %% therefore it returns {formatted_state, State} as its status + {status, Pid, {module, gen_server}, SItems} = sys:get_status(Pid), + [state] = [S || SItemList = [_ | _] <- SItems, {formatted_state, S} <- SItemList], + %% this code is actually what we use to retrieve the state in other tests + state = get_state(Pid), + {comment, []}. -spec no_format_status(config()) -> {comment, []}. no_format_status(_Config) -> - %% crashy_server doesn't implement format_status/2 - {ok, Pid} = wpool_process:start_link(?MODULE, crashy_server, state, []), - %% therefore it uses the default format for the stauts (but with the status of - %% the gen_server, not wpool_process) - {status, Pid, {module, gen_server}, SItems} = sys:get_status(Pid), - [state] = - [S || SItemList = [_|_] <- SItems - , {data, Data} <- SItemList - , {"State", S} <- Data - ], - {comment, []}. + %% crashy_server doesn't implement format_status/2 + {ok, Pid} = wpool_process:start_link(?MODULE, crashy_server, state, []), + %% therefore it uses the default format for the stauts (but with the status of + %% the gen_server, not wpool_process) + {status, Pid, {module, gen_server}, SItems} = sys:get_status(Pid), + [state] = + [S || SItemList = [_ | _] <- SItems, {data, Data} <- SItemList, {"State", S} <- Data], + {comment, []}. -spec call(config()) -> {comment, []}. call(_Config) -> - {ok, Pid} = wpool_process:start_link(?MODULE, echo_server, {ok, state}, []), - ok1 = wpool_process:call(Pid, {reply, ok1, newstate}, 5000), - newstate = get_state(?MODULE), - ok2 = wpool_process:call(Pid, {reply, ok2, newerstate, 1}, 5000), - timeout = ktn_task:wait_for(fun() -> get_state(?MODULE) end, timeout), - ok3 = wpool_process:call(Pid, {stop, normal, ok3, state}, 5000), - false = ktn_task:wait_for(fun() -> erlang:is_process_alive(Pid) end, false), + {ok, Pid} = wpool_process:start_link(?MODULE, echo_server, {ok, state}, []), + ok1 = wpool_process:call(Pid, {reply, ok1, newstate}, 5000), + newstate = get_state(?MODULE), + ok2 = wpool_process:call(Pid, {reply, ok2, newerstate, 1}, 5000), + timeout = ktn_task:wait_for(fun() -> get_state(?MODULE) end, timeout), + ok3 = wpool_process:call(Pid, {stop, normal, ok3, state}, 5000), + false = ktn_task:wait_for(fun() -> erlang:is_process_alive(Pid) end, false), - {comment, []}. + {comment, []}. -spec pool_restart_crash(config()) -> {comment, []}. pool_restart_crash(_Config) -> - Pool = pool_restart_crash, - PoolOptions = [{workers, 2}, {worker, {crashy_server, []}}], - {ok, Pid} = wpool:start_pool(Pool, PoolOptions), - ct:log("Check that the pool is working"), - true = erlang:is_process_alive(Pid), - hello = wpool:call(Pool, hello), + Pool = pool_restart_crash, + PoolOptions = [{workers, 2}, {worker, {crashy_server, []}}], + {ok, Pid} = wpool:start_pool(Pool, PoolOptions), + ct:log("Check that the pool is working"), + true = erlang:is_process_alive(Pid), + hello = wpool:call(Pool, hello), - ct:log("Crash a worker"), - wpool:cast(Pool, crash), + ct:log("Crash a worker"), + wpool:cast(Pool, crash), - ct:log("Check that the pool wouldn't crash"), - wpool:cast(Pool, crash, best_worker), + ct:log("Check that the pool wouldn't crash"), + wpool:cast(Pool, crash, best_worker), - ct:log("Check that the pool didn't die"), - {error, {timeout, {badmatch, true}}} = - ktn_task:wait_for(fun() -> erlang:is_process_alive(Pid) end, false), - hello = wpool:call(Pool, hello), + ct:log("Check that the pool didn't die"), + {error, {timeout, {badmatch, true}}} = + ktn_task:wait_for(fun() -> erlang:is_process_alive(Pid) end, false), + hello = wpool:call(Pool, hello), - {comment, []}. + {comment, []}. -spec pool_norestart_crash(config()) -> {comment, []}. pool_norestart_crash(_Config) -> - Pool = pool_norestart_crash, - PoolOptions = [ {workers, 2} - , {worker, {crashy_server, []}} - , {strategy, {one_for_all, 0, 10}} - , {pool_sup_intensity, 0} - , {pool_sup_period, 10} - ], - {ok, Pid} = wpool:start_pool(Pool, PoolOptions), + Pool = pool_norestart_crash, + PoolOptions = + [{workers, 2}, + {worker, {crashy_server, []}}, + {strategy, {one_for_all, 0, 10}}, + {pool_sup_intensity, 0}, + {pool_sup_period, 10}], + {ok, Pid} = wpool:start_pool(Pool, PoolOptions), - ct:log("Check that the pool is working"), - true = erlang:is_process_alive(Pid), - hello = wpool:call(Pool, hello), + ct:log("Check that the pool is working"), + true = erlang:is_process_alive(Pid), + hello = wpool:call(Pool, hello), - ct:log("Crash a worker"), - wpool:cast(Pool, crash), + ct:log("Crash a worker"), + wpool:cast(Pool, crash), - ct:log("Check that the pool is not working"), - false = ktn_task:wait_for(fun() -> erlang:is_process_alive(Pid) end, false), + ct:log("Check that the pool is not working"), + false = ktn_task:wait_for(fun() -> erlang:is_process_alive(Pid) end, false), - {comment, []}. + {comment, []}. -spec stop(config()) -> {comment, []}. stop(_Config) -> - From = {self(), Ref = make_ref()}, - - ct:comment("cast_call with stop/reply"), - {ok, Pid1} = wpool_process:start_link(stopper, echo_server, {ok, state}, []), - ok = wpool_process:cast_call(stopper, From, {stop, reason, response, state}), - receive - {Ref, response} -> ok - after 5000 -> - ct:fail("no response") - end, - receive - {'EXIT', Pid1, reason} -> ok - after 500 -> - ct:fail("Missing exit signal") - end, - - ct:comment("cast_call with regular stop"), - {ok, Pid2} = wpool_process:start_link(stopper, echo_server, {ok, state}, []), - ok = wpool_process:cast_call(stopper, From, {stop, reason, state}), - receive - {Ref, _} -> ct:fail("unexpected response"); - {'EXIT', Pid2, reason} -> ok - after 500 -> - ct:fail("Missing exit signal") - end, - - ct:comment("call with regular stop"), - {ok, Pid3} = wpool_process:start_link(stopper, echo_server, {ok, state}, []), - try wpool_process:call(stopper, {noreply, state}, 100) of - _ -> ct:fail("unexpected response") - catch - _:{timeout, _} -> ok - end, - receive - {'EXIT', Pid3, _} -> ct:fail("Unexpected process crash") - after 500 -> - ok - end, - - ct:comment("call with timeout stop"), - try wpool_process:call(stopper, {noreply, state, hibernate}, 100) of - _ -> ct:fail("unexpected response") - catch - _:{timeout, _} -> ok - end, - receive - {'EXIT', Pid3, _} -> ct:fail("Unexpected process crash") - after 500 -> - ok - end, - - {comment, []}. - + From = {self(), Ref = make_ref()}, + + ct:comment("cast_call with stop/reply"), + {ok, Pid1} = wpool_process:start_link(stopper, echo_server, {ok, state}, []), + ok = wpool_process:cast_call(stopper, From, {stop, reason, response, state}), + receive + {Ref, response} -> + ok + after 5000 -> + ct:fail("no response") + end, + receive + {'EXIT', Pid1, reason} -> + ok + after 500 -> + ct:fail("Missing exit signal") + end, + + ct:comment("cast_call with regular stop"), + {ok, Pid2} = wpool_process:start_link(stopper, echo_server, {ok, state}, []), + ok = wpool_process:cast_call(stopper, From, {stop, reason, state}), + receive + {Ref, _} -> + ct:fail("unexpected response"); + {'EXIT', Pid2, reason} -> + ok + after 500 -> + ct:fail("Missing exit signal") + end, + + ct:comment("call with regular stop"), + {ok, Pid3} = wpool_process:start_link(stopper, echo_server, {ok, state}, []), + try wpool_process:call(stopper, {noreply, state}, 100) of + _ -> + ct:fail("unexpected response") + catch + _:{timeout, _} -> + ok + end, + receive + {'EXIT', Pid3, _} -> + ct:fail("Unexpected process crash") + after 500 -> + ok + end, + + ct:comment("call with timeout stop"), + try wpool_process:call(stopper, {noreply, state, hibernate}, 100) of + _ -> + ct:fail("unexpected response") + catch + _:{timeout, _} -> + ok + end, + receive + {'EXIT', Pid3, _} -> + ct:fail("Unexpected process crash") + after 500 -> + ok + end, + + {comment, []}. -spec complete_coverage(config()) -> {comment, []}. complete_coverage(_Config) -> - ct:comment("Code Change"), - {ok, State} = - wpool_process:init({complete_coverage, echo_server, {ok, state}, []}), - {ok, _} = wpool_process:code_change("oldvsn", State, {ok, state}), - {error, bad} = wpool_process:code_change("oldvsn", State, bad), - - {comment, []}. + ct:comment("Code Change"), + {ok, State} = wpool_process:init({complete_coverage, echo_server, {ok, state}, []}), + {ok, _} = wpool_process:code_change("oldvsn", State, {ok, state}), + {error, bad} = wpool_process:code_change("oldvsn", State, bad), + {comment, []}. %% @doc We can use this function in tests since echo_server implements %% format_status/2 by returning the state as a tuple {formatted_state, S}. @@ -324,9 +309,8 @@ complete_coverage(_Config) -> %% @see gen_server:format_status/2 %% @see sys:get_status/2 get_state(Atom) when is_atom(Atom) -> - get_state(whereis(Atom)); + get_state(whereis(Atom)); get_state(Pid) -> - {status, Pid, {module, gen_server}, SItems} = sys:get_status(Pid), - [State] = - [S || SItemList = [_|_] <- SItems, {formatted_state, S} <- SItemList], - State. + {status, Pid, {module, gen_server}, SItems} = sys:get_status(Pid), + [State] = [S || SItemList = [_ | _] <- SItems, {formatted_state, S} <- SItemList], + State. diff --git a/test/wpool_process_callbacks_SUITE.erl b/test/wpool_process_callbacks_SUITE.erl index 8a12959..6f0a872 100644 --- a/test/wpool_process_callbacks_SUITE.erl +++ b/test/wpool_process_callbacks_SUITE.erl @@ -1,187 +1,178 @@ -module(wpool_process_callbacks_SUITE). +-behaviour(ct_suite). + -type config() :: [{atom(), term()}]. --export([ all/0 - ]). --export([ init_per_suite/1 - , end_per_suite/1 - ]). --export([ complete_callback_passed_when_starting_pool/1 - , partial_callback_passed_when_starting_pool/1 - , callback_can_be_added_and_removed_after_pool_is_started/1 - , crashing_callback_does_not_affect_others/1 - , non_existsing_module_does_not_affect_others/1 - , complete_coverage/1 - ]). +-export([all/0]). +-export([init_per_suite/1, end_per_suite/1]). +-export([complete_callback_passed_when_starting_pool/1, + partial_callback_passed_when_starting_pool/1, + callback_can_be_added_and_removed_after_pool_is_started/1, + crashing_callback_does_not_affect_others/1, non_existsing_module_does_not_affect_others/1, + complete_coverage/1]). -spec all() -> [atom()]. all() -> - [ complete_callback_passed_when_starting_pool - , partial_callback_passed_when_starting_pool - , callback_can_be_added_and_removed_after_pool_is_started - , crashing_callback_does_not_affect_others - , non_existsing_module_does_not_affect_others - ]. + [complete_callback_passed_when_starting_pool, + partial_callback_passed_when_starting_pool, + callback_can_be_added_and_removed_after_pool_is_started, + crashing_callback_does_not_affect_others, + non_existsing_module_does_not_affect_others]. -spec init_per_suite(config()) -> config(). init_per_suite(Config) -> - ok = wpool:start(), - Config. + ok = wpool:start(), + Config. -spec end_per_suite(config()) -> config(). end_per_suite(Config) -> - wpool:stop(), - Config. - + wpool:stop(), + Config. -spec complete_callback_passed_when_starting_pool(config()) -> ok. complete_callback_passed_when_starting_pool(_Config) -> - Pool = callbacks_test, - WorkersCount = 13, - meck:new(callbacks, [non_strict]), - meck:expect(callbacks, handle_init_start, fun(_AWorkerName) -> ok end), - meck:expect(callbacks, handle_worker_creation, fun(_AWorkerName) -> ok end), - meck:expect(callbacks, handle_worker_death, fun(_AWName, _Reason) -> ok end), - {ok, _Pid} = wpool:start_pool(Pool, [{workers, WorkersCount}, - {enable_callbacks, true}, - {worker, {crashy_server, []}}, - {callbacks, [callbacks]}]), - - WorkersCount = ktn_task:wait_for(function_calls(callbacks, handle_init_start, - ['_']), WorkersCount), - WorkersCount = ktn_task:wait_for(function_calls(callbacks, - handle_worker_creation, - ['_']), WorkersCount), - Worker = wpool_pool:random_worker(Pool), - Worker ! crash, - 1 = ktn_task:wait_for(function_calls(callbacks, handle_worker_death, - ['_', '_']), 1), - wpool:stop_pool(Pool), - meck:unload(callbacks), - - ok. + Pool = callbacks_test, + WorkersCount = 13, + meck:new(callbacks, [non_strict]), + meck:expect(callbacks, handle_init_start, fun(_AWorkerName) -> ok end), + meck:expect(callbacks, handle_worker_creation, fun(_AWorkerName) -> ok end), + meck:expect(callbacks, handle_worker_death, fun(_AWName, _Reason) -> ok end), + {ok, _Pid} = + wpool:start_pool(Pool, + [{workers, WorkersCount}, + {enable_callbacks, true}, + {worker, {crashy_server, []}}, + {callbacks, [callbacks]}]), + + WorkersCount = + ktn_task:wait_for(function_calls(callbacks, handle_init_start, ['_']), WorkersCount), + WorkersCount = + ktn_task:wait_for(function_calls(callbacks, handle_worker_creation, ['_']), WorkersCount), + Worker = wpool_pool:random_worker(Pool), + Worker ! crash, + 1 = ktn_task:wait_for(function_calls(callbacks, handle_worker_death, ['_', '_']), 1), + wpool:stop_pool(Pool), + meck:unload(callbacks), + + ok. -spec partial_callback_passed_when_starting_pool(config) -> ok. partial_callback_passed_when_starting_pool(_Config) -> - Pool = partial_callbacks_test, - WorkersCount = 7, - meck:new(callbacks, [non_strict]), - meck:expect(callbacks, handle_worker_creation, fun(_AWorkerName) -> ok end), - meck:expect(callbacks, handle_worker_death, fun(_AWName, _Reason) -> ok end), - {ok, _Pid} = wpool:start_pool(Pool, [{workers, WorkersCount}, - {enable_callbacks, true}, - {callbacks, [callbacks]}]), - WorkersCount = ktn_task:wait_for(function_calls(callbacks, - handle_worker_creation, - ['_']), WorkersCount), - wpool:stop_pool(Pool), - meck:unload(callbacks), - - ok. + Pool = partial_callbacks_test, + WorkersCount = 7, + meck:new(callbacks, [non_strict]), + meck:expect(callbacks, handle_worker_creation, fun(_AWorkerName) -> ok end), + meck:expect(callbacks, handle_worker_death, fun(_AWName, _Reason) -> ok end), + {ok, _Pid} = + wpool:start_pool(Pool, + [{workers, WorkersCount}, + {enable_callbacks, true}, + {callbacks, [callbacks]}]), + WorkersCount = + ktn_task:wait_for(function_calls(callbacks, handle_worker_creation, ['_']), WorkersCount), + wpool:stop_pool(Pool), + meck:unload(callbacks), + + ok. -spec callback_can_be_added_and_removed_after_pool_is_started(config()) -> ok. callback_can_be_added_and_removed_after_pool_is_started(_Config) -> - Pool = after_start_callbacks_test, - WorkersCount = 3, - meck:new(callbacks, [non_strict]), - meck:expect(callbacks, handle_worker_death, fun(_AWName, _Reason) -> ok end), - meck:new(callbacks2, [non_strict]), - meck:expect(callbacks2, handle_worker_death, fun(_AWName, _Reason) -> ok end), - {ok, _Pid} = wpool:start_pool(Pool, [{workers, WorkersCount}, - {worker, {crashy_server, []}}, - {enable_callbacks, true}]), - %% Now we are adding 2 callback modules - _ = wpool_pool:add_callback_module(Pool, callbacks), - _ = wpool_pool:add_callback_module(Pool, callbacks2), - Worker = wpool_pool:random_worker(Pool), - Worker ! crash, - - %% they both are called - 1 = ktn_task:wait_for(function_calls(callbacks, handle_worker_death, - ['_', '_']), 1), - 1 = ktn_task:wait_for(function_calls(callbacks2, handle_worker_death, - ['_', '_']), 1), - - %% then the first module is removed - _ = wpool_pool:remove_callback_module(Pool, callbacks), - Worker2 = wpool_pool:random_worker(Pool), - Worker2 ! crash, - - %% and only the scond one is called - 1 = ktn_task:wait_for(function_calls(callbacks, handle_worker_death, - ['_', '_']), 1), - 2 = ktn_task:wait_for(function_calls(callbacks2, handle_worker_death, - ['_', '_']), 2), - - wpool:stop_pool(Pool), - meck:unload(callbacks), - meck:unload(callbacks2), - - ok. + Pool = after_start_callbacks_test, + WorkersCount = 3, + meck:new(callbacks, [non_strict]), + meck:expect(callbacks, handle_worker_death, fun(_AWName, _Reason) -> ok end), + meck:new(callbacks2, [non_strict]), + meck:expect(callbacks2, handle_worker_death, fun(_AWName, _Reason) -> ok end), + {ok, _Pid} = + wpool:start_pool(Pool, + [{workers, WorkersCount}, + {worker, {crashy_server, []}}, + {enable_callbacks, true}]), + %% Now we are adding 2 callback modules + _ = wpool_pool:add_callback_module(Pool, callbacks), + _ = wpool_pool:add_callback_module(Pool, callbacks2), + Worker = wpool_pool:random_worker(Pool), + Worker ! crash, + + %% they both are called + 1 = ktn_task:wait_for(function_calls(callbacks, handle_worker_death, ['_', '_']), 1), + 1 = ktn_task:wait_for(function_calls(callbacks2, handle_worker_death, ['_', '_']), 1), + + %% then the first module is removed + _ = wpool_pool:remove_callback_module(Pool, callbacks), + Worker2 = wpool_pool:random_worker(Pool), + Worker2 ! crash, + + %% and only the scond one is called + 1 = ktn_task:wait_for(function_calls(callbacks, handle_worker_death, ['_', '_']), 1), + 2 = ktn_task:wait_for(function_calls(callbacks2, handle_worker_death, ['_', '_']), 2), + + wpool:stop_pool(Pool), + meck:unload(callbacks), + meck:unload(callbacks2), + ok. -spec crashing_callback_does_not_affect_others(config()) -> ok. crashing_callback_does_not_affect_others(_Config) -> - Pool = crashing_callbacks_test, - WorkersCount = 3, - meck:new(callbacks, [non_strict]), - meck:expect(callbacks, handle_worker_creation, fun(_AWorkerName) -> ok end), - meck:new(callbacks2, [non_strict]), - meck:expect(callbacks2, handle_worker_creation, - fun(AWorkerName) -> {not_going_to_work} = AWorkerName end), - {ok, _Pid} = wpool:start_pool(Pool, [{workers, WorkersCount}, - {worker, {crashy_server, []}}, - {enable_callbacks, true}, - {callbacks, [callbacks, callbacks2]}]), - - WorkersCount = ktn_task:wait_for(function_calls(callbacks, - handle_worker_creation, - ['_']), WorkersCount), - WorkersCount = ktn_task:wait_for(function_calls(callbacks2, - handle_worker_creation, - ['_']), WorkersCount), - - wpool:stop_pool(Pool), - meck:unload(callbacks), - meck:unload(callbacks2), - - ok. + Pool = crashing_callbacks_test, + WorkersCount = 3, + meck:new(callbacks, [non_strict]), + meck:expect(callbacks, handle_worker_creation, fun(_AWorkerName) -> ok end), + meck:new(callbacks2, [non_strict]), + meck:expect(callbacks2, + handle_worker_creation, + fun(AWorkerName) -> {not_going_to_work} = AWorkerName end), + {ok, _Pid} = + wpool:start_pool(Pool, + [{workers, WorkersCount}, + {worker, {crashy_server, []}}, + {enable_callbacks, true}, + {callbacks, [callbacks, callbacks2]}]), + + WorkersCount = + ktn_task:wait_for(function_calls(callbacks, handle_worker_creation, ['_']), WorkersCount), + WorkersCount = + ktn_task:wait_for(function_calls(callbacks2, handle_worker_creation, ['_']), + WorkersCount), + + wpool:stop_pool(Pool), + meck:unload(callbacks), + meck:unload(callbacks2), + ok. -spec non_existsing_module_does_not_affect_others(config()) -> ok. non_existsing_module_does_not_affect_others(_Config) -> - Pool = non_existing_callbacks_test, - WorkersCount = 4, - meck:new(callbacks, [non_strict]), - meck:expect(callbacks, handle_worker_creation, fun(_AWorkerName) -> ok end), - {ok, _Pid} = wpool:start_pool(Pool, [{workers, WorkersCount}, - {worker, {crashy_server, []}}, - {enable_callbacks, true}, - {callbacks, [callbacks, non_existing_m]} - ]), - - {error, nofile} = wpool_pool:add_callback_module(Pool, non_existing_m2), - - WorkersCount = ktn_task:wait_for(function_calls(callbacks, - handle_worker_creation, - ['_']), WorkersCount), - - wpool:stop_pool(Pool), - meck:unload(callbacks), - - ok. -function_calls(Module, Function, MeckMatchSpec) -> - fun() -> - meck:num_calls(Module, Function, MeckMatchSpec) - end. + Pool = non_existing_callbacks_test, + WorkersCount = 4, + meck:new(callbacks, [non_strict]), + meck:expect(callbacks, handle_worker_creation, fun(_AWorkerName) -> ok end), + {ok, _Pid} = + wpool:start_pool(Pool, + [{workers, WorkersCount}, + {worker, {crashy_server, []}}, + {enable_callbacks, true}, + {callbacks, [callbacks, non_existing_m]}]), + + {error, nofile} = wpool_pool:add_callback_module(Pool, non_existing_m2), + + WorkersCount = + ktn_task:wait_for(function_calls(callbacks, handle_worker_creation, ['_']), WorkersCount), + + wpool:stop_pool(Pool), + meck:unload(callbacks), + ok. + +function_calls(Module, Function, MeckMatchSpec) -> + fun() -> meck:num_calls(Module, Function, MeckMatchSpec) end. -spec complete_coverage(config()) -> ok. complete_coverage(_Config) -> {ok, EventManager} = gen_event:start_link(), - gen_event:add_handler( - EventManager, {wpool_process_callbacks, ?MODULE}, ?MODULE), + gen_event:add_handler(EventManager, {wpool_process_callbacks, ?MODULE}, ?MODULE), {error, {unexpected_call, call}} = gen_event:call(EventManager, {wpool_process_callbacks, ?MODULE}, call), ok. diff --git a/test/wpool_worker_SUITE.erl b/test/wpool_worker_SUITE.erl index aa65f28..527bf85 100644 --- a/test/wpool_worker_SUITE.erl +++ b/test/wpool_worker_SUITE.erl @@ -15,6 +15,8 @@ %% @hidden -module(wpool_worker_SUITE). +-behaviour(ct_suite). + -type config() :: [{atom(), term()}]. -export([all/0]). @@ -24,72 +26,73 @@ -spec all() -> [atom()]. all() -> - [Fun || {Fun, 1} <- module_info(exports), - not lists:member(Fun, [init_per_suite, end_per_suite, module_info])]. + [Fun + || {Fun, 1} <- module_info(exports), + not lists:member(Fun, [init_per_suite, end_per_suite, module_info])]. -spec init_per_suite(config()) -> config(). init_per_suite(Config) -> - ok = wpool:start(), - Config. + ok = wpool:start(), + Config. -spec end_per_suite(config()) -> config(). end_per_suite(Config) -> - wpool:stop(), - Config. + wpool:stop(), + Config. -spec ok() -> ?MODULE. -ok() -> ?MODULE. +ok() -> + ?MODULE. -spec error() -> no_return(). -error() -> exit(?MODULE). +error() -> + exit(?MODULE). -spec call(config()) -> {comment, []}. call(_Config) -> - start_pool(), - ?MODULE = wpool_worker:call(?MODULE, ?MODULE, ok, []), - try wpool_worker:call(?MODULE, ?MODULE, error, []) of - R -> no_result = R - catch - exit:?MODULE -> ok - end, - {error, invalid_request} = wpool:call(?MODULE, error), - ok = wpool:stop_sup_pool(?MODULE), - - {comment, []}. + start_pool(), + ?MODULE = wpool_worker:call(?MODULE, ?MODULE, ok, []), + try wpool_worker:call(?MODULE, ?MODULE, error, []) of + R -> + no_result = R + catch + exit:?MODULE -> + ok + end, + {error, invalid_request} = wpool:call(?MODULE, error), + ok = wpool:stop_sup_pool(?MODULE), + + {comment, []}. -spec cast(config()) -> {comment, []}. cast(_Config) -> - start_pool(), - ok = wpool_worker:cast(?MODULE, ?MODULE, ok, []), - ok = wpool_worker:cast(?MODULE, ?MODULE, error, []), - ok = wpool:cast(?MODULE, x), - ok = wpool_worker:cast(?MODULE, erlang, send, [self(), {a, message}]), - receive - {a, message} -> ok - after 1000 -> - ct:fail("Timeout while waiting for cast response") - end, - ok = wpool:stop_sup_pool(?MODULE), - - {comment, []}. + start_pool(), + ok = wpool_worker:cast(?MODULE, ?MODULE, ok, []), + ok = wpool_worker:cast(?MODULE, ?MODULE, error, []), + ok = wpool:cast(?MODULE, x), + ok = wpool_worker:cast(?MODULE, erlang, send, [self(), {a, message}]), + receive + {a, message} -> + ok + after 1000 -> + ct:fail("Timeout while waiting for cast response") + end, + ok = wpool:stop_sup_pool(?MODULE), + + {comment, []}. -spec complete_coverage(config()) -> {comment, []}. complete_coverage(_Config) -> - start_pool(), - {ok, AWorker} = wpool:call(?MODULE, {erlang, self, []}), - true = is_process_alive(AWorker), - AWorker ! info, - - true = is_process_alive(AWorker), - - {ok, {state}} = wpool_worker:code_change("oldvsn", {state}, extra), + start_pool(), + {ok, AWorker} = wpool:call(?MODULE, {erlang, self, []}), + true = is_process_alive(AWorker), + AWorker ! info, - ok = wpool_worker:terminate(reason, {state}), + true = is_process_alive(AWorker), - {comment, []}. + {comment, []}. start_pool() -> - {ok, _Pid} = - wpool:start_sup_pool( - ?MODULE, [{workers, 1}, {worker, {wpool_worker, undefined}}]), - started. + {ok, _Pid} = + wpool:start_sup_pool(?MODULE, [{workers, 1}, {worker, {wpool_worker, undefined}}]), + started.