File 2346-stdlib-Make-gen_server-callbacks-optional.patch of Package erlang
From 8ca53b0f993ffbf2991e3068b76ec15b8f5eca51 Mon Sep 17 00:00:00 2001
From: Zandra Norman <zandra@erlang.org>
Date: Mon, 23 Jan 2017 11:49:32 +0100
Subject: [PATCH 1/4] stdlib: Make gen_server callbacks optional
---
.../results/gen_server_incorrect_args | 3 -
.../results/gen_server_missing_callbacks | 1 -
.../behaviour_SUITE_data/results/vars_in_beh_spec | 2 -
lib/stdlib/doc/src/gen_server.xml | 18 +++
lib/stdlib/src/gen_server.erl | 42 +++--
lib/stdlib/test/erl_internal_SUITE.erl | 2 +-
lib/stdlib/test/erl_lint_SUITE.erl | 10 +-
lib/stdlib/test/gen_server_SUITE.erl | 175 ++++++++++++++++++++-
.../test/gen_server_SUITE_data/oc_server.erl | 37 +++++
9 files changed, 258 insertions(+), 32 deletions(-)
create mode 100644 lib/stdlib/test/gen_server_SUITE_data/oc_server.erl
diff --git a/lib/dialyzer/test/behaviour_SUITE_data/results/gen_server_incorrect_args b/lib/dialyzer/test/behaviour_SUITE_data/results/gen_server_incorrect_args
index 3e98da785..2f504d3c7 100644
--- a/lib/dialyzer/test/behaviour_SUITE_data/results/gen_server_incorrect_args
+++ b/lib/dialyzer/test/behaviour_SUITE_data/results/gen_server_incorrect_args
@@ -1,8 +1,5 @@
-gen_server_incorrect_args.erl:3: Undefined callback function code_change/3 (behaviour 'gen_server')
gen_server_incorrect_args.erl:3: Undefined callback function handle_cast/2 (behaviour 'gen_server')
-gen_server_incorrect_args.erl:3: Undefined callback function handle_info/2 (behaviour 'gen_server')
gen_server_incorrect_args.erl:3: Undefined callback function init/1 (behaviour 'gen_server')
-gen_server_incorrect_args.erl:3: Undefined callback function terminate/2 (behaviour 'gen_server')
gen_server_incorrect_args.erl:7: The inferred return type of handle_call/3 ({'no'} | {'ok'}) has nothing in common with {'noreply',_} | {'noreply',_,'hibernate' | 'infinity' | non_neg_integer()} | {'reply',_,_} | {'stop',_,_} | {'reply',_,_,'hibernate' | 'infinity' | non_neg_integer()} | {'stop',_,_,_}, which is the expected return type for the callback of gen_server behaviour
gen_server_incorrect_args.erl:7: The inferred type for the 2nd argument of handle_call/3 ('boo' | 'foo') is not a supertype of {pid(),_}, which is expected type for this argument in the callback of the gen_server behaviour
diff --git a/lib/dialyzer/test/behaviour_SUITE_data/results/gen_server_missing_callbacks b/lib/dialyzer/test/behaviour_SUITE_data/results/gen_server_missing_callbacks
index 5e0ed5fd2..0a7642a9b 100644
--- a/lib/dialyzer/test/behaviour_SUITE_data/results/gen_server_missing_callbacks
+++ b/lib/dialyzer/test/behaviour_SUITE_data/results/gen_server_missing_callbacks
@@ -1,3 +1,2 @@
gen_server_missing_callbacks.erl:3: Undefined callback function handle_cast/2 (behaviour 'gen_server')
-gen_server_missing_callbacks.erl:3: Undefined callback function handle_info/2 (behaviour 'gen_server')
diff --git a/lib/dialyzer/test/behaviour_SUITE_data/results/vars_in_beh_spec b/lib/dialyzer/test/behaviour_SUITE_data/results/vars_in_beh_spec
index 5284e412f..512dcdd75 100644
--- a/lib/dialyzer/test/behaviour_SUITE_data/results/vars_in_beh_spec
+++ b/lib/dialyzer/test/behaviour_SUITE_data/results/vars_in_beh_spec
@@ -1,6 +1,4 @@
vars_in_beh_spec.erl:3: Undefined callback function handle_call/3 (behaviour 'gen_server')
vars_in_beh_spec.erl:3: Undefined callback function handle_cast/2 (behaviour 'gen_server')
-vars_in_beh_spec.erl:3: Undefined callback function handle_info/2 (behaviour 'gen_server')
vars_in_beh_spec.erl:3: Undefined callback function init/1 (behaviour 'gen_server')
-vars_in_beh_spec.erl:3: Undefined callback function terminate/2 (behaviour 'gen_server')
diff --git a/lib/stdlib/doc/src/gen_server.xml b/lib/stdlib/doc/src/gen_server.xml
index 662076b5f..454044979 100644
--- a/lib/stdlib/doc/src/gen_server.xml
+++ b/lib/stdlib/doc/src/gen_server.xml
@@ -504,6 +504,13 @@ gen_server:abcast -----> Module:handle_cast/2
<v>Reason = term()</v>
</type>
<desc>
+ <note>
+ <p>This callback is optional, so callback modules need not export it.
+ If a release upgrade/downgrade with <c>Change={advanced,Extra}</c>
+ specified in the <c>appup</c> file is made when <c>code_change/3</c>
+ isn't implemented the process will crash with an <c>undef</c> exit
+ reason.</p>
+ </note>
<p>This function is called by a <c>gen_server</c> process when it is
to update its internal state during a release upgrade/downgrade,
that is, when the instruction <c>{update,Module,Change,...}</c>,
@@ -690,6 +697,12 @@ gen_server:abcast -----> Module:handle_cast/2
<v> Reason = normal | term()</v>
</type>
<desc>
+ <note>
+ <p>This callback is optional, so callback modules need not
+ export it. The <c>gen_server</c> module provides a default
+ implementation of this function that logs about the unexpected
+ <c>Info</c> message, drops it and returns <c>{noreply, State}</c>.</p>
+ </note>
<p>This function is called by a <c>gen_server</c> process when a
time-out occurs or when it receives any other message than a
synchronous or asynchronous request (or a system message).</p>
@@ -750,6 +763,11 @@ gen_server:abcast -----> Module:handle_cast/2
<v>State = term()</v>
</type>
<desc>
+ <note>
+ <p>This callback is optional, so callback modules need not
+ export it. The <c>gen_server</c> module provides a default
+ implementation without cleanup.</p>
+ </note>
<p>This function is called by a <c>gen_server</c> process when it is
about to terminate. It is to be the opposite of
<seealso marker="#Module:init/1"><c>Module:init/1</c></seealso>
diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl
index 284810c97..8504af86f 100644
--- a/lib/stdlib/src/gen_server.erl
+++ b/lib/stdlib/src/gen_server.erl
@@ -146,8 +146,8 @@
State :: term(),
Status :: term().
--optional_callbacks([format_status/2]).
-
+-optional_callbacks(
+ [handle_info/2, terminate/2, code_change/3, format_status/2]).
%%% -----------------------------------------------------------------
%%% Starts a generic server.
@@ -602,6 +602,17 @@ try_dispatch(Mod, Func, Msg, State) ->
catch
throw:R ->
{ok, R};
+ error:undef = R when Func == handle_info ->
+ case erlang:function_exported(Mod, handle_info, 2) of
+ false ->
+ error_logger:warning_msg("** Undefined handle_info in ~p~n"
+ "** Unhandled message: ~p~n",
+ [Mod, Msg]),
+ {ok, {noreply, State}};
+ true ->
+ Stacktrace = erlang:get_stacktrace(),
+ {'EXIT', {R, Stacktrace}, {R, Stacktrace}}
+ end;
error:R ->
Stacktrace = erlang:get_stacktrace(),
{'EXIT', {R, Stacktrace}, {R, Stacktrace}};
@@ -625,17 +636,22 @@ try_handle_call(Mod, Msg, From, State) ->
end.
try_terminate(Mod, Reason, State) ->
- try
- {ok, Mod:terminate(Reason, State)}
- catch
- throw:R ->
- {ok, R};
- error:R ->
- Stacktrace = erlang:get_stacktrace(),
- {'EXIT', {R, Stacktrace}, {R, Stacktrace}};
- exit:R ->
- Stacktrace = erlang:get_stacktrace(),
- {'EXIT', R, {R, Stacktrace}}
+ case erlang:function_exported(Mod, terminate, 2) of
+ true ->
+ try
+ {ok, Mod:terminate(Reason, State)}
+ catch
+ throw:R ->
+ {ok, R};
+ error:R ->
+ Stacktrace = erlang:get_stacktrace(),
+ {'EXIT', {R, Stacktrace}, {R, Stacktrace}};
+ exit:R ->
+ Stacktrace = erlang:get_stacktrace(),
+ {'EXIT', R, {R, Stacktrace}}
+ end;
+ false ->
+ {ok, ok}
end.
diff --git a/lib/stdlib/test/erl_internal_SUITE.erl b/lib/stdlib/test/erl_internal_SUITE.erl
index bfa48de6b..23d011e27 100644
--- a/lib/stdlib/test/erl_internal_SUITE.erl
+++ b/lib/stdlib/test/erl_internal_SUITE.erl
@@ -97,7 +97,7 @@ callbacks(supervisor) ->
optional_callbacks(application) ->
[];
optional_callbacks(gen_server) ->
- [{format_status,2}];
+ [{handle_info, 2}, {terminate, 2}, {code_change, 3}, {format_status, 2}];
optional_callbacks(gen_fsm) ->
[{format_status,2}];
optional_callbacks(gen_event) ->
diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl
index c7dcd9ae1..ef4d363d2 100644
--- a/lib/stdlib/test/erl_lint_SUITE.erl
+++ b/lib/stdlib/test/erl_lint_SUITE.erl
@@ -3057,10 +3057,7 @@ behaviour_multiple(Config) when is_list(Config) ->
handle_info(_, _) -> ok.
">>,
[],
- {warnings,[{1,erl_lint,
- {undefined_behaviour_func,{code_change,3},gen_server}},
- {1,erl_lint,{undefined_behaviour_func,{init,1},gen_server}},
- {1,erl_lint,{undefined_behaviour_func,{terminate,2},gen_server}},
+ {warnings,[{1,erl_lint,{undefined_behaviour_func,{init,1},gen_server}},
{2,erl_lint,{undefined_behaviour_func,{init,1},supervisor}},
{2,
erl_lint,
@@ -3074,10 +3071,7 @@ behaviour_multiple(Config) when is_list(Config) ->
handle_info(_, _) -> ok.
">>,
[],
- {warnings,[{1,erl_lint,
- {undefined_behaviour_func,{code_change,3},gen_server}},
- {1,erl_lint,{undefined_behaviour_func,{init,1},gen_server}},
- {1,erl_lint,{undefined_behaviour_func,{terminate,2},gen_server}},
+ {warnings,[{1,erl_lint,{undefined_behaviour_func,{init,1},gen_server}},
{2,erl_lint,{undefined_behaviour_func,{init,1},supervisor}},
{2,
erl_lint,
diff --git a/lib/stdlib/test/gen_server_SUITE.erl b/lib/stdlib/test/gen_server_SUITE.erl
index 6888cb8c5..3fb9b3627 100644
--- a/lib/stdlib/test/gen_server_SUITE.erl
+++ b/lib/stdlib/test/gen_server_SUITE.erl
@@ -34,7 +34,10 @@
spec_init_global_registered_parent/1,
otp_5854/1, hibernate/1, otp_7669/1, call_format_status/1,
error_format_status/1, terminate_crash_format/1,
- get_state/1, replace_state/1, call_with_huge_message_queue/1
+ get_state/1, replace_state/1, call_with_huge_message_queue/1,
+ undef_handle_call/1, undef_handle_cast/1, undef_handle_info/1,
+ undef_init/1, undef_code_change/1, undef_terminate1/1,
+ undef_terminate2/1, undef_in_terminate/1, undef_in_handle_info/1
]).
-export([stop1/1, stop2/1, stop3/1, stop4/1, stop5/1, stop6/1, stop7/1,
@@ -50,7 +53,7 @@
%% The gen_server behaviour
-export([init/1, handle_call/3, handle_cast/2,
- handle_info/2, terminate/2, format_status/2]).
+ handle_info/2, code_change/3, terminate/2, format_status/2]).
suite() ->
[{ct_hooks,[ts_install_cth]},
@@ -66,11 +69,16 @@ all() ->
otp_7669,
call_format_status, error_format_status, terminate_crash_format,
get_state, replace_state,
- call_with_huge_message_queue].
+ call_with_huge_message_queue, {group, undef_callbacks},
+ undef_in_terminate, undef_in_handle_info].
groups() ->
[{stop, [],
- [stop1, stop2, stop3, stop4, stop5, stop6, stop7, stop8, stop9, stop10]}].
+ [stop1, stop2, stop3, stop4, stop5, stop6, stop7, stop8, stop9, stop10]},
+ {undef_callbacks, [],
+ [undef_handle_call, undef_handle_cast, undef_handle_info,
+ undef_init, undef_code_change, undef_terminate1, undef_terminate2]}].
+
init_per_suite(Config) ->
Config.
@@ -78,6 +86,11 @@ init_per_suite(Config) ->
end_per_suite(_Config) ->
ok.
+init_per_group(undef_callbacks, Config) ->
+ DataDir = ?config(data_dir, Config),
+ Server = filename:join(DataDir, "oc_server.erl"),
+ {ok, oc_server} = compile:file(Server),
+ Config;
init_per_group(_GroupName, Config) ->
Config.
@@ -93,6 +106,7 @@ init_per_testcase(Case, Config) when Case == call_remote1;
Case == call_remote_n3 ->
{ok,N} = start_node(hubba),
[{node,N} | Config];
+
init_per_testcase(_Case, Config) ->
Config.
@@ -1260,6 +1274,141 @@ echo_loop() ->
echo_loop()
end.
+%% Test the default implementation of terminate if the callback module
+%% does not export it
+undef_terminate1(Config) when is_list(Config) ->
+ {ok, Server} = gen_server:start(oc_server, [], []),
+ MRef = monitor(process, Server),
+ ok = gen_server:stop(Server),
+ ok = verify_down_reason(MRef, Server, normal).
+
+%% Test the default implementation of terminate if the callback module
+%% does not export it
+undef_terminate2(Config) when is_list(Config) ->
+ {ok, Server} = gen_server:start(oc_server, [], []),
+ MRef = monitor(process, Server),
+ ok = gen_server:stop(Server, {error, test}, infinity),
+ ok = verify_down_reason(MRef, Server, {error, test}).
+
+%% Start should return an undef error if init isn't implemented
+undef_init(_Config) ->
+ {error, {undef, [{oc_init_server, init, [_], _}|_]}} =
+ gen_server:start(oc_init_server, [], []),
+ process_flag(trap_exit, true),
+ {error, {undef, [{oc_init_server, init, [_], _}|_]}} =
+ (catch gen_server:start_link(oc_init_server, [], [])),
+ receive
+ {'EXIT', Server,
+ {undef, [{oc_init_server, init, [_], _}|_]}} when is_pid(Server) ->
+ ok
+ after 1000 ->
+ ct:fail(expected_exit_msg)
+ end.
+
+%% The upgrade should fail if code_change is expected in the callback module
+%% but not exported, but the server should continue with the old code
+undef_code_change(Config) when is_list(Config) ->
+ {ok, Server} = gen_server:start(oc_server, [], []),
+ {error, {'EXIT', {undef, [{oc_server, code_change, [_, _, _], _}|_]}}}
+ = fake_upgrade(Server, ?MODULE),
+ true = is_process_alive(Server).
+
+%% The server should crash if the handle_call callback is
+%% not exported in the callback module
+undef_handle_call(_Config) ->
+ {ok, Server} = gen_server:start(oc_server, [], []),
+ try
+ gen_server:call(Server, call_msg),
+ ct:fail(should_crash)
+ catch exit:{{undef, [{oc_server, handle_call, _, _}|_]},
+ {gen_server, call, _}} ->
+ ok
+ end.
+
+%% The server should crash if the handle_cast callback is
+%% not exported in the callback module
+undef_handle_cast(_Config) ->
+ {ok, Server} = gen_server:start(oc_server, [], []),
+ MRef = monitor(process, Server),
+ gen_server:cast(Server, cast_msg),
+ verify_undef_down(MRef, Server, oc_server, handle_cast),
+ ok.
+
+%% The server should log but not crash if the handle_info callback is
+%% calling an undefined function
+undef_handle_info(Config) when is_list(Config) ->
+ error_logger_forwarder:register(),
+ {ok, Server} = gen_server:start(oc_server, [], []),
+ Server ! hej,
+ wait_until_processed(Server, hej, 10),
+ true = is_process_alive(Server),
+ receive
+ {warning_msg, _GroupLeader,
+ {Server, "** Undefined handle_info in " ++ _, [oc_server, hej]}} ->
+ ok;
+ Other ->
+ io:format("Unexpected: ~p", [Other]),
+ ct:fail(failed)
+ end.
+
+%% Test that the default implementation of terminate isn't catching the
+%% wrong undef error
+undef_in_terminate(Config) when is_list(Config) ->
+ State = {undef_in_terminate, {oc_server, terminate}},
+ {ok, Server} = gen_server:start(?MODULE, {state, State}, []),
+ try
+ gen_server:stop(Server),
+ ct:fail(failed)
+ catch
+ exit:{undef, [{oc_server, terminate, [], _}|_]} ->
+ ok
+ end.
+
+%% Test that the default implementation of handle_info isn't catching the
+%% wrong undef error
+undef_in_handle_info(Config) when is_list(Config) ->
+ {ok, Server} = gen_server:start(?MODULE, [], []),
+ MRef = monitor(process, Server),
+ Server ! {call_undef_fun, ?MODULE, handle_info},
+ verify_undef_down(MRef, Server, ?MODULE, handle_info),
+ ok.
+
+verify_down_reason(MRef, Server, Reason) ->
+ receive
+ {'DOWN', MRef, process, Server, Reason} ->
+ ok
+ after 5000 ->
+ ct:fail(failed)
+ end.
+
+verify_undef_down(MRef, Pid, Mod, Fun) ->
+ ok = receive
+ {'DOWN', MRef, process, Pid,
+ {undef, [{Mod, Fun, _, _}|_]}} ->
+ ok
+ after 5000 ->
+ ct:fail(should_crash)
+ end.
+
+fake_upgrade(Pid, Mod) ->
+ sys:suspend(Pid),
+ sys:replace_state(Pid, fun(State) -> {new, State} end),
+ Ret = sys:change_code(Pid, Mod, old_vsn, []),
+ ok = sys:resume(Pid),
+ Ret.
+
+wait_until_processed(_Pid, _Message, 0) ->
+ ct:fail(not_processed);
+wait_until_processed(Pid, Message, N) ->
+ {messages, Messages} = erlang:process_info(Pid, messages),
+ case lists:member(Message, Messages) of
+ true ->
+ timer:sleep(100),
+ wait_until_processed(Pid, Message, N-1);
+ false ->
+ ok
+ end.
+
%%--------------------------------------------------------------
%% Help functions to spec_init_*
start_link(Init, Options) ->
@@ -1383,6 +1532,9 @@ handle_call(stop_shutdown, _From, State) ->
{stop,shutdown,State};
handle_call(shutdown_reason, _From, _State) ->
exit({shutdown,reason});
+handle_call({call_undef_fun, Mod, Fun}, _From, State) ->
+ Mod:Fun(),
+ {reply, ok, State};
handle_call(stop_shutdown_reason, _From, State) ->
{stop,{shutdown,stop_reason},State}.
@@ -1396,6 +1548,9 @@ handle_cast(hibernate_now, _State) ->
handle_cast(hibernate_later, _State) ->
timer:send_after(1000,self(),hibernate_now),
{noreply, []};
+handle_cast({call_undef_fun, Mod, Fun}, State) ->
+ Mod:Fun(),
+ {noreply, State};
handle_cast({From, stop}, State) ->
io:format("BAZ"),
{stop, {From,stopped}, State}.
@@ -1420,6 +1575,9 @@ handle_info(timeout, {delayed_cast, From}) ->
handle_info(timeout, {delayed_info, From}) ->
From ! {self(), delayed_info},
{noreply, []};
+handle_info({call_undef_fun, Mod, Fun}, State) ->
+ Mod:Fun(),
+ {noreply, State};
handle_info({From, handle_info}, _State) ->
From ! {self(), handled_info},
{noreply, []};
@@ -1433,6 +1591,12 @@ handle_info({From, stop}, State) ->
handle_info(_Info, State) ->
{noreply, State}.
+code_change(_OldVsn,
+ {new, {undef_in_code_change, {Mod, Fun}}} = State,
+ _Extra) ->
+ Mod:Fun(),
+ {ok, State}.
+
terminate({From, stopped}, _State) ->
io:format("FOOBAR"),
From ! {self(), stopped},
@@ -1442,6 +1606,9 @@ terminate({From, stopped_info}, _State) ->
ok;
terminate(_, crash_terminate) ->
exit({crash, terminate});
+terminate(_, {undef_in_terminate, {Mod, Fun}}) ->
+ Mod:Fun(),
+ ok;
terminate(_Reason, _State) ->
ok.
diff --git a/lib/stdlib/test/gen_server_SUITE_data/oc_server.erl b/lib/stdlib/test/gen_server_SUITE_data/oc_server.erl
new file mode 100644
index 000000000..4ba37987f
--- /dev/null
+++ b/lib/stdlib/test/gen_server_SUITE_data/oc_server.erl
@@ -0,0 +1,37 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(oc_server).
+
+-behaviour(gen_server).
+
+%% API
+-export([start/0]).
+
+%% gen_server callbacks
+-export([init/1]).
+
+-record(state, {}).
+
+start() ->
+ gen_server:start({local, ?MODULE}, ?MODULE, [], []).
+
+init([]) ->
+ {ok, #state{}}.
+
--
2.12.2
