1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20-module(gen_server_SUITE).
21
22-include_lib("common_test/include/ct.hrl").
23-include_lib("kernel/include/inet.hrl").
24
25-export([init_per_testcase/2, end_per_testcase/2]).
26
27-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
28	 init_per_group/2,end_per_group/2]).
29-export([start/1, crash/1, call/1, cast/1, cast_fast/1,
30	 continue/1, info/1, abcast/1, multicall/1, multicall_down/1,
31	 call_remote1/1, call_remote2/1, call_remote3/1,
32	 call_remote_n1/1, call_remote_n2/1, call_remote_n3/1, spec_init/1,
33	 spec_init_local_registered_parent/1,
34	 spec_init_global_registered_parent/1,
35	 otp_5854/1, hibernate/1, auto_hibernate/1, otp_7669/1, call_format_status/1,
36	 error_format_status/1, terminate_crash_format/1,
37	 get_state/1, replace_state/1, call_with_huge_message_queue/1,
38	 undef_handle_call/1, undef_handle_cast/1, undef_handle_info/1,
39	 undef_init/1, undef_code_change/1, undef_terminate1/1,
40	 undef_terminate2/1, undef_in_terminate/1, undef_in_handle_info/1,
41	 undef_handle_continue/1
42	]).
43
44-export([stop1/1, stop2/1, stop3/1, stop4/1, stop5/1, stop6/1, stop7/1,
45	 stop8/1, stop9/1, stop10/1]).
46
47%% spawn export
48-export([spec_init_local/2, spec_init_global/2, spec_init_via/2,
49	 spec_init_default_timeout/2, spec_init_global_default_timeout/2,
50         spec_init_anonymous/1,
51	 spec_init_anonymous_default_timeout/1,
52	 spec_init_not_proc_lib/1, cast_fast_messup/0]).
53
54
55%% The gen_server behaviour
56-export([init/1, handle_call/3, handle_cast/2, handle_continue/2,
57	 handle_info/2, code_change/3, terminate/2, format_status/2]).
58
59suite() ->
60    [{ct_hooks,[ts_install_cth]},
61     {timetrap,{minutes,1}}].
62
63all() ->
64    [start, {group,stop}, crash, call, cast, cast_fast, info, abcast,
65     continue, multicall, multicall_down, call_remote1, call_remote2,
66     call_remote3, call_remote_n1, call_remote_n2,
67     call_remote_n3, spec_init,
68     spec_init_local_registered_parent,
69     spec_init_global_registered_parent, otp_5854, hibernate, auto_hibernate,
70     otp_7669,
71     call_format_status, error_format_status, terminate_crash_format,
72     get_state, replace_state,
73     call_with_huge_message_queue, {group, undef_callbacks},
74     undef_in_terminate, undef_in_handle_info].
75
76groups() ->
77    [{stop, [],
78      [stop1, stop2, stop3, stop4, stop5, stop6, stop7, stop8, stop9, stop10]},
79     {undef_callbacks, [],
80      [undef_handle_call, undef_handle_cast, undef_handle_info, undef_handle_continue,
81       undef_init, undef_code_change, undef_terminate1, undef_terminate2]}].
82
83
84init_per_suite(Config) ->
85    Config.
86
87end_per_suite(_Config) ->
88    ok.
89
90init_per_group(undef_callbacks, Config) ->
91    DataDir = ?config(data_dir, Config),
92    Server = filename:join(DataDir, "oc_server.erl"),
93    {ok, oc_server} = compile:file(Server),
94    Config;
95init_per_group(_GroupName, Config) ->
96    Config.
97
98end_per_group(_GroupName, Config) ->
99    Config.
100
101
102init_per_testcase(Case, Config) when Case == call_remote1;
103				     Case == call_remote2;
104				     Case == call_remote3;
105				     Case == call_remote_n1;
106				     Case == call_remote_n2;
107				     Case == call_remote_n3 ->
108    {ok,N} = start_node(hubba),
109    [{node,N} | Config];
110
111init_per_testcase(_Case, Config) ->
112    Config.
113
114end_per_testcase(_Case, Config) ->
115    case proplists:get_value(node, Config) of
116	undefined ->
117	    ok;
118	N ->
119	    test_server:stop_node(N)
120    end,
121    ok.
122
123
124%% --------------------------------------
125%% Start and stop a gen_server.
126%% --------------------------------------
127
128start(Config) when is_list(Config) ->
129    OldFl = process_flag(trap_exit, true),
130
131    %% anonymous
132    {ok, Pid0} = gen_server:start(gen_server_SUITE, [], []),
133    ok = gen_server:call(Pid0, started_p),
134    ok = gen_server:call(Pid0, stop),
135    busy_wait_for_process(Pid0,600),
136    {'EXIT', {noproc,_}} = (catch gen_server:call(Pid0, started_p, 1)),
137
138    %% anonymous with timeout
139    {ok, Pid00} = gen_server:start(gen_server_SUITE, [],
140				   [{timeout,1000}]),
141    ok = gen_server:call(Pid00, started_p),
142    ok = gen_server:call(Pid00, stop),
143    {error, timeout} = gen_server:start(gen_server_SUITE, sleep,
144					[{timeout,100}]),
145
146    %% anonymous with ignore
147    ignore = gen_server:start(gen_server_SUITE, ignore, []),
148
149    %% anonymous with stop
150    {error, stopped} = gen_server:start(gen_server_SUITE, stop, []),
151
152    %% anonymous linked
153    {ok, Pid1} =
154	gen_server:start_link(gen_server_SUITE, [], []),
155    ok = gen_server:call(Pid1, started_p),
156    ok = gen_server:call(Pid1, stop),
157    receive
158	{'EXIT', Pid1, stopped} ->
159	    ok
160    after 5000 ->
161	    ct:fail(not_stopped)
162    end,
163
164    %% local register
165    {ok, Pid2} =
166	gen_server:start({local, my_test_name},
167			 gen_server_SUITE, [], []),
168    ok = gen_server:call(my_test_name, started_p),
169    {error, {already_started, Pid2}} =
170	gen_server:start({local, my_test_name},
171			 gen_server_SUITE, [], []),
172    ok = gen_server:call(my_test_name, stop),
173
174    busy_wait_for_process(Pid2,600),
175
176    {'EXIT', {noproc,_}} = (catch gen_server:call(Pid2, started_p, 10)),
177
178    %% local register linked
179    {ok, Pid3} =
180	gen_server:start_link({local, my_test_name},
181			      gen_server_SUITE, [], []),
182    ok = gen_server:call(my_test_name, started_p),
183    {error, {already_started, Pid3}} =
184	gen_server:start({local, my_test_name},
185			 gen_server_SUITE, [], []),
186    ok = gen_server:call(my_test_name, stop),
187    receive
188	{'EXIT', Pid3, stopped} ->
189	    ok
190    after 5000 ->
191	    ct:fail(not_stopped)
192    end,
193
194    %% global register
195    {ok, Pid4} =
196	gen_server:start({global, my_test_name},
197			 gen_server_SUITE, [], []),
198    ok = gen_server:call({global, my_test_name}, started_p),
199    {error, {already_started, Pid4}} =
200	gen_server:start({global, my_test_name},
201			 gen_server_SUITE, [], []),
202    ok = gen_server:call({global, my_test_name}, stop),
203    busy_wait_for_process(Pid4,600),
204    {'EXIT', {noproc,_}} = (catch gen_server:call(Pid4, started_p, 10)),
205
206    %% global register linked
207    {ok, Pid5} =
208	gen_server:start_link({global, my_test_name},
209			      gen_server_SUITE, [], []),
210    ok = gen_server:call({global, my_test_name}, started_p),
211    {error, {already_started, Pid5}} =
212	gen_server:start({global, my_test_name},
213			 gen_server_SUITE, [], []),
214    ok = gen_server:call({global, my_test_name}, stop),
215    receive
216	{'EXIT', Pid5, stopped} ->
217	    ok
218    after 5000 ->
219	    ct:fail(not_stopped)
220    end,
221
222    %% via register
223    dummy_via:reset(),
224    {ok, Pid6} =
225	gen_server:start({via, dummy_via, my_test_name},
226			 gen_server_SUITE, [], []),
227    ok = gen_server:call({via, dummy_via, my_test_name}, started_p),
228    {error, {already_started, Pid6}} =
229	gen_server:start({via, dummy_via, my_test_name},
230			 gen_server_SUITE, [], []),
231    ok = gen_server:call({via, dummy_via, my_test_name}, stop),
232    busy_wait_for_process(Pid6,600),
233    {'EXIT', {noproc,_}} = (catch gen_server:call(Pid6, started_p, 10)),
234
235    %% via register linked
236    dummy_via:reset(),
237    {ok, Pid7} =
238	gen_server:start_link({via, dummy_via, my_test_name},
239			      gen_server_SUITE, [], []),
240    ok = gen_server:call({via, dummy_via, my_test_name}, started_p),
241    {error, {already_started, Pid7}} =
242	gen_server:start({via, dummy_via, my_test_name},
243			 gen_server_SUITE, [], []),
244    ok = gen_server:call({via, dummy_via, my_test_name}, stop),
245    receive
246	{'EXIT', Pid7, stopped} ->
247	    ok
248    after 5000 ->
249	    ct:fail(not_stopped)
250    end,
251    receive
252	Msg -> ct:fail({unexpected,Msg})
253    after 1 -> ok
254    end,
255
256    process_flag(trap_exit, OldFl),
257    ok.
258
259%% Anonymous, reason 'normal'
260stop1(_Config) ->
261    {ok, Pid} = gen_server:start(?MODULE, [], []),
262    ok = gen_server:stop(Pid),
263    false = erlang:is_process_alive(Pid),
264    {'EXIT',noproc} = (catch gen_server:stop(Pid)),
265    ok.
266
267%% Anonymous, other reason
268stop2(_Config) ->
269    {ok,Pid} = gen_server:start(?MODULE, [], []),
270    ok = gen_server:stop(Pid, other_reason, infinity),
271    false = erlang:is_process_alive(Pid),
272    ok.
273
274%% Anonymous, invalid timeout
275stop3(_Config) ->
276    {ok,Pid} = gen_server:start(?MODULE, [], []),
277    {'EXIT',_} = (catch gen_server:stop(Pid, other_reason, invalid_timeout)),
278    true = erlang:is_process_alive(Pid),
279    ok = gen_server:stop(Pid),
280    false = erlang:is_process_alive(Pid),
281    ok.
282
283%% Registered name
284stop4(_Config) ->
285    {ok,Pid} = gen_server:start({local,to_stop},?MODULE, [], []),
286    ok = gen_server:stop(to_stop),
287    false = erlang:is_process_alive(Pid),
288    {'EXIT',noproc} = (catch gen_server:stop(to_stop)),
289    ok.
290
291%% Registered name and local node
292stop5(_Config) ->
293    {ok,Pid} = gen_server:start({local,to_stop},?MODULE, [], []),
294    ok = gen_server:stop({to_stop,node()}),
295    false = erlang:is_process_alive(Pid),
296    {'EXIT',noproc} = (catch gen_server:stop({to_stop,node()})),
297    ok.
298
299%% Globally registered name
300stop6(_Config) ->
301    {ok, Pid} = gen_server:start({global, to_stop}, ?MODULE, [], []),
302    ok = gen_server:stop({global,to_stop}),
303    false = erlang:is_process_alive(Pid),
304    {'EXIT',noproc} = (catch gen_server:stop({global,to_stop})),
305    ok.
306
307%% 'via' registered name
308stop7(_Config) ->
309    dummy_via:reset(),
310    {ok, Pid} = gen_server:start({via, dummy_via, to_stop},
311				 ?MODULE, [], []),
312    ok = gen_server:stop({via, dummy_via, to_stop}),
313    false = erlang:is_process_alive(Pid),
314    {'EXIT',noproc} = (catch gen_server:stop({via, dummy_via, to_stop})),
315    ok.
316
317%% Anonymous on remote node
318stop8(_Config) ->
319    {ok,Node} = test_server:start_node(gen_server_SUITE_stop8,slave,[]),
320    Dir = filename:dirname(code:which(?MODULE)),
321    rpc:call(Node,code,add_path,[Dir]),
322    {ok, Pid} = rpc:call(Node,gen_server,start,[?MODULE,[],[]]),
323    ok = gen_server:stop(Pid),
324    false = rpc:call(Node,erlang,is_process_alive,[Pid]),
325    {'EXIT',noproc} = (catch gen_server:stop(Pid)),
326    true = test_server:stop_node(Node),
327    {'EXIT',{{nodedown,Node},_}} = (catch gen_server:stop(Pid)),
328    ok.
329
330%% Registered name on remote node
331stop9(_Config) ->
332    {ok,Node} = test_server:start_node(gen_server_SUITE_stop9,slave,[]),
333    Dir = filename:dirname(code:which(?MODULE)),
334    rpc:call(Node,code,add_path,[Dir]),
335    {ok, Pid} = rpc:call(Node,gen_server,start,[{local,to_stop},?MODULE,[],[]]),
336    ok = gen_server:stop({to_stop,Node}),
337    undefined = rpc:call(Node,erlang,whereis,[to_stop]),
338    false = rpc:call(Node,erlang,is_process_alive,[Pid]),
339    {'EXIT',noproc} = (catch gen_server:stop({to_stop,Node})),
340    true = test_server:stop_node(Node),
341    {'EXIT',{{nodedown,Node},_}} = (catch gen_server:stop({to_stop,Node})),
342    ok.
343
344%% Globally registered name on remote node
345stop10(_Config) ->
346    {ok,Node} = test_server:start_node(gen_server_SUITE_stop10,slave,[]),
347    Dir = filename:dirname(code:which(?MODULE)),
348    rpc:call(Node,code,add_path,[Dir]),
349    {ok, Pid} = rpc:call(Node,gen_server,start,[{global,to_stop},?MODULE,[],[]]),
350    ok = global:sync(),
351    ok = gen_server:stop({global,to_stop}),
352    false = rpc:call(Node,erlang,is_process_alive,[Pid]),
353    {'EXIT',noproc} = (catch gen_server:stop({global,to_stop})),
354    true = test_server:stop_node(Node),
355    {'EXIT',noproc} = (catch gen_server:stop({global,to_stop})),
356    ok.
357
358crash(Config) when is_list(Config) ->
359    error_logger_forwarder:register(),
360
361    process_flag(trap_exit, true),
362
363    %% This crash should not generate a crash report.
364    {ok,Pid0} = gen_server:start_link(?MODULE, [], []),
365    {'EXIT',{{shutdown,reason},_}} =
366 	(catch gen_server:call(Pid0, shutdown_reason)),
367    receive {'EXIT',Pid0,{shutdown,reason}} -> ok end,
368
369    %% This crash should not generate a crash report.
370    {ok,Pid1} = gen_server:start_link(?MODULE, {state,state1}, []),
371    {'EXIT',{{shutdown,stop_reason},_}} =
372	(catch gen_server:call(Pid1, stop_shutdown_reason)),
373    receive {'EXIT',Pid1,{shutdown,stop_reason}} -> ok end,
374
375    %% This crash should not generate a crash report.
376    {ok,Pid2} = gen_server:start_link(?MODULE, [], []),
377    {'EXIT',{shutdown,_}} =
378 	(catch gen_server:call(Pid2, exit_shutdown)),
379    receive {'EXIT',Pid2,shutdown} -> ok end,
380
381    %% This crash should not generate a crash report.
382    {ok,Pid3} = gen_server:start_link(?MODULE, {state,state3}, []),
383    {'EXIT',{shutdown,_}} =
384	(catch gen_server:call(Pid3, stop_shutdown)),
385    receive {'EXIT',Pid3,shutdown} -> ok end,
386
387    process_flag(trap_exit, false),
388
389    %% This crash should generate a crash report and a report
390    %% from gen_server.
391    {ok,Pid4} = gen_server:start(?MODULE, {state,state4}, []),
392    {'EXIT',{crashed,_}} = (catch gen_server:call(Pid4, crash)),
393    ClientPid = self(),
394    receive
395	{error,_GroupLeader4,{Pid4,
396			      "** Generic server"++_,
397			      [Pid4,crash,{formatted, state4},
398			       {crashed,[{?MODULE,handle_call,3,_}
399					 |_Stacktrace]},
400			       ClientPid, [_|_] = _ClientStack]}} ->
401	    ok;
402	Other4a ->
403	    io:format("Unexpected: ~p", [Other4a]),
404	    ct:fail(failed)
405    end,
406    receive
407	{error_report,_,{Pid4,crash_report,[List4|_]}} ->
408	    {exit,crashed,[{?MODULE, handle_call, 3, _}|_]} = proplists:get_value(error_info, List4),
409	    Pid4 = proplists:get_value(pid, List4);
410	Other4 ->
411	    io:format("Unexpected: ~p", [Other4]),
412	    ct:fail(failed)
413    end,
414
415    receive
416	Any ->
417	    io:format("Unexpected: ~p", [Any]),
418	    ct:fail(failed)
419    after 500 ->
420	    ok
421    end,
422
423    ok.
424
425%% --------------------------------------
426%% Test gen_server:call and handle_call.
427%% Test all different return values from
428%% handle_call.
429%% --------------------------------------
430
431call(Config) when is_list(Config) ->
432    OldFl = process_flag(trap_exit, true),
433
434    {ok, _Pid} =
435	gen_server:start_link({local, my_test_name},
436			      gen_server_SUITE, [], []),
437
438    ok = gen_server:call(my_test_name, started_p),
439    delayed = gen_server:call(my_test_name, {delayed_answer,1}),
440
441    %% two requests within a specified time.
442    ok = gen_server:call(my_test_name, {call_within, 1000}),
443    timer:sleep(500),
444    ok = gen_server:call(my_test_name, next_call),
445    ok = gen_server:call(my_test_name, {call_within, 1000}),
446    timer:sleep(1500),
447    false = gen_server:call(my_test_name, next_call),
448
449    %% timeout call.
450    delayed = gen_server:call(my_test_name, {delayed_answer,1}, 30),
451    {'EXIT',{timeout,_}} =
452	(catch gen_server:call(my_test_name, {delayed_answer,30}, 1)),
453
454    %% bad return value in the gen_server loop from handle_call.
455    {'EXIT',{{bad_return_value, badreturn},_}} =
456	(catch gen_server:call(my_test_name, badreturn)),
457
458    process_flag(trap_exit, OldFl),
459    ok.
460
461%% --------------------------------------
462%% Test handle_continue.
463%% --------------------------------------
464
465continue(Config) when is_list(Config) ->
466    {ok, Pid} = gen_server:start_link(gen_server_SUITE, {continue, self()}, []),
467    [{Pid, continue}, {Pid, after_continue}] = read_replies(Pid),
468
469    gen_server:call(Pid, {continue_reply, self()}),
470    [{Pid, continue}, {Pid, after_continue}] = read_replies(Pid),
471
472    gen_server:call(Pid, {continue_noreply, self()}),
473    [{Pid, continue}, {Pid, after_continue}] = read_replies(Pid),
474
475    gen_server:cast(Pid, {continue_noreply, self()}),
476    [{Pid, continue}, {Pid, after_continue}] = read_replies(Pid),
477
478    Pid ! {continue_noreply, self()},
479    [{Pid, continue}, {Pid, after_continue}] = read_replies(Pid),
480
481    Pid ! {continue_continue, self()},
482    [{Pid, before_continue}, {Pid, continue}, {Pid, after_continue}] = read_replies(Pid),
483
484    Ref = monitor(process, Pid),
485    Pid ! continue_stop,
486    verify_down_reason(Ref, Pid, normal).
487
488read_replies(Pid) ->
489    receive
490	{Pid, ack} -> read_replies()
491    after
492	1000 -> ct:fail({continue, ack})
493    end.
494
495read_replies() ->
496    receive
497	Msg -> [Msg | read_replies()]
498    after
499	0 -> []
500    end.
501
502%% --------------------------------------
503%% Test call to nonexisting processes on remote nodes
504%% --------------------------------------
505
506start_node(Name) ->
507    Pa = filename:dirname(code:which(?MODULE)),
508    N = test_server:start_node(Name, slave, [{args, " -pa " ++ Pa}]),
509    %% After starting a slave, it takes a little while until global knows
510    %% about it, even if nodes() includes it, so we make sure that global
511    %% knows about it before registering something on all nodes.
512    ok = global:sync(),
513    N.
514
515call_remote1(Config) when is_list(Config) ->
516    N = hubba,
517    Node = proplists:get_value(node,Config),
518    {ok, Pid} = rpc:call(Node, gen_server, start,
519			 [{global, N}, ?MODULE, [], []]),
520    ok = (catch gen_server:call({global, N}, started_p, infinity)),
521    exit(Pid, boom),
522    {'EXIT', {Reason, _}} = (catch gen_server:call({global, N},
523						   started_p, infinity)),
524    true = (Reason == noproc) orelse (Reason == boom),
525    ok.
526
527call_remote2(Config) when is_list(Config) ->
528    N = hubba,
529    Node = proplists:get_value(node,Config),
530
531    {ok, Pid} = rpc:call(Node, gen_server, start,
532			 [{global, N}, ?MODULE, [], []]),
533    ok = (catch gen_server:call(Pid, started_p, infinity)),
534    exit(Pid, boom),
535    {'EXIT', {Reason, _}} = (catch gen_server:call(Pid,
536						   started_p, infinity)),
537    true = (Reason == noproc) orelse (Reason == boom),
538    ok.
539
540call_remote3(Config) when is_list(Config) ->
541    Node = proplists:get_value(node,Config),
542
543    {ok, Pid} = rpc:call(Node, gen_server, start,
544			 [{local, piller}, ?MODULE, [], []]),
545    ok = (catch gen_server:call({piller, Node}, started_p, infinity)),
546    exit(Pid, boom),
547    {'EXIT', {Reason, _}} = (catch gen_server:call({piller, Node},
548						   started_p, infinity)),
549    true = (Reason == noproc) orelse (Reason == boom),
550    ok.
551
552%% --------------------------------------
553%% Test call to nonexisting node
554%% --------------------------------------
555
556call_remote_n1(Config) when is_list(Config) ->
557    N = hubba,
558    Node = proplists:get_value(node,Config),
559    {ok, _Pid} = rpc:call(Node, gen_server, start,
560			  [{global, N}, ?MODULE, [], []]),
561    _ = test_server:stop_node(Node),
562    {'EXIT', {noproc, _}} =
563	(catch gen_server:call({global, N}, started_p, infinity)),
564
565    ok.
566
567call_remote_n2(Config) when is_list(Config) ->
568    N = hubba,
569    Node = proplists:get_value(node,Config),
570
571    {ok, Pid} = rpc:call(Node, gen_server, start,
572			 [{global, N}, ?MODULE, [], []]),
573    _ = test_server:stop_node(Node),
574    {'EXIT', {{nodedown, Node}, _}} = (catch gen_server:call(Pid,
575							     started_p, infinity)),
576
577    ok.
578
579call_remote_n3(Config) when is_list(Config) ->
580    Node = proplists:get_value(node,Config),
581
582    {ok, _Pid} = rpc:call(Node, gen_server, start,
583			  [{local, piller}, ?MODULE, [], []]),
584    _ = test_server:stop_node(Node),
585    {'EXIT', {{nodedown, Node}, _}} = (catch gen_server:call({piller, Node},
586							     started_p, infinity)),
587
588    ok.
589
590%% --------------------------------------
591%% Test gen_server:cast and handle_cast.
592%% Test all different return values from
593%% handle_cast.
594%% --------------------------------------
595
596cast(Config) when is_list(Config) ->
597    {ok, Pid} =
598	gen_server:start({local, my_test_name},
599			 gen_server_SUITE, [], []),
600
601    ok = gen_server:call(my_test_name, started_p),
602
603    ok = gen_server:cast(my_test_name, {self(),handle_cast}),
604    receive
605	{Pid, handled_cast} ->
606	    ok
607    after 1000 ->
608	    ct:fail(handle_cast)
609    end,
610
611    ok = gen_server:cast(my_test_name, {self(),delayed_cast,1}),
612    receive
613	{Pid, delayed} ->
614	    ok
615    after 1000 ->
616	    ct:fail(delayed_cast)
617    end,
618
619    ok = gen_server:cast(my_test_name, {self(),stop}),
620    receive
621	{Pid, stopped} ->
622	    ok
623    after 1000 ->
624	    ct:fail(stop)
625    end,
626    ok.
627
628%% Test that cast really return immediately.
629cast_fast(Config) when is_list(Config) ->
630    {ok,Node} = start_node(hubba),
631    {_,"@"++Host} = lists:splitwith(fun ($@) -> false; (_) -> true end,
632				    atom_to_list(Node)),
633    FalseNode = list_to_atom("hopp@"++Host),
634    true = rpc:cast(Node, ?MODULE, cast_fast_messup, []),
635    ct:sleep(1000),
636    [Node] = nodes(),
637    {Time,ok} = timer:tc(fun() ->
638				 gen_server:cast({hopp,FalseNode}, hopp)
639			 end),
640    true = test_server:stop_node(Node),
641    if Time > 1000000 ->       % Default listen timeout is about 7.0 s
642	    ct:fail(hanging_cast);
643       true ->
644	    ok
645    end.
646
647cast_fast_messup() ->
648    %% Register a false node: hopp@hostname
649    unregister(erl_epmd),
650    {ok, _} = erl_epmd:start_link(),
651    {ok,S} = gen_tcp:listen(0, []),
652    {ok,P} = inet:port(S),
653    {ok,_Creation} = erl_epmd:register_node(hopp, P),
654    receive after infinity -> ok end.
655
656%% --------------------------------------
657%% Test handle_info.
658%% --------------------------------------
659
660info(Config) when is_list(Config) ->
661    {ok, Pid} =
662	gen_server:start({local, my_test_name},
663			 gen_server_SUITE, [], []),
664
665    ok = gen_server:call(my_test_name, started_p),
666
667    Pid ! {self(),handle_info},
668    receive
669	{Pid, handled_info} ->
670	    ok
671    after 1000 ->
672	    ct:fail(handle_info)
673    end,
674
675    Pid ! {self(),delayed_info,1},
676    receive
677	{Pid, delayed_info} ->
678	    ok
679    after 1000 ->
680	    ct:fail(delayed_info)
681    end,
682
683    Pid ! {self(),stop},
684    receive
685	{Pid, stopped_info} ->
686	    ok
687    after 1000 ->
688	    ct:fail(stop_info)
689    end,
690    ok.
691
692hibernate(Config) when is_list(Config) ->
693    OldFl = process_flag(trap_exit, true),
694    {ok, Pid0} =
695	gen_server:start_link({local, my_test_name_hibernate0},
696			      gen_server_SUITE, hibernate, []),
697    is_in_erlang_hibernate(Pid0),
698    ok = gen_server:call(my_test_name_hibernate0, stop),
699    receive
700	{'EXIT', Pid0, stopped} ->
701 	    ok
702    after 5000 ->
703	    ct:fail(gen_server_did_not_die)
704    end,
705
706    {ok, Pid} =
707	gen_server:start_link({local, my_test_name_hibernate},
708			      gen_server_SUITE, [], []),
709
710    ok = gen_server:call(my_test_name_hibernate, started_p),
711    true = gen_server:call(my_test_name_hibernate, hibernate),
712    is_in_erlang_hibernate(Pid),
713    Parent = self(),
714    Fun = fun() ->
715		  receive go -> ok end,
716		  receive after 1000 -> ok end,
717		  X = erlang:process_info(Pid, current_function),
718 		  Pid ! continue,
719 		  Parent ! {result,X}
720 	  end,
721    Pid2 = spawn_link(Fun),
722    true = gen_server:call(my_test_name_hibernate, {hibernate_noreply,Pid2}),
723
724    gen_server:cast(my_test_name_hibernate, hibernate_later),
725    true = ({current_function,{erlang,hibernate,3}} =/=
726		erlang:process_info(Pid, current_function)),
727    is_in_erlang_hibernate(Pid),
728    ok = gen_server:call(my_test_name_hibernate, started_p),
729    true = ({current_function,{erlang,hibernate,3}} =/=
730		erlang:process_info(Pid, current_function)),
731
732    gen_server:cast(my_test_name_hibernate, hibernate_now),
733    is_in_erlang_hibernate(Pid),
734    ok = gen_server:call(my_test_name_hibernate, started_p),
735    true = ({current_function,{erlang,hibernate,3}} =/=
736		erlang:process_info(Pid, current_function)),
737
738    Pid ! hibernate_later,
739    true = ({current_function,{erlang,hibernate,3}} =/=
740		erlang:process_info(Pid, current_function)),
741    is_in_erlang_hibernate(Pid),
742    ok = gen_server:call(my_test_name_hibernate, started_p),
743    true = ({current_function,{erlang,hibernate,3}} =/=
744		erlang:process_info(Pid, current_function)),
745
746    Pid ! hibernate_now,
747    is_in_erlang_hibernate(Pid),
748    ok = gen_server:call(my_test_name_hibernate, started_p),
749    true = ({current_function,{erlang,hibernate,3}} =/=
750		erlang:process_info(Pid, current_function)),
751    receive
752	{result,R} ->
753	    {current_function,{erlang,hibernate,3}} = R
754    end,
755
756    true = gen_server:call(my_test_name_hibernate, hibernate),
757    is_in_erlang_hibernate(Pid),
758    sys:suspend(my_test_name_hibernate),
759    is_in_erlang_hibernate(Pid),
760    sys:resume(my_test_name_hibernate),
761    is_in_erlang_hibernate(Pid),
762    ok = gen_server:call(my_test_name_hibernate, started_p),
763    true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)),
764
765    ok = gen_server:call(my_test_name_hibernate, stop),
766    receive
767	{'EXIT', Pid, stopped} ->
768 	    ok
769    after 5000 ->
770	    ct:fail(gen_server_did_not_die)
771    end,
772    process_flag(trap_exit, OldFl),
773    ok.
774
775auto_hibernate(Config) when is_list(Config) ->
776    OldFl = process_flag(trap_exit, true),
777    HibernateAfterTimeout = 100,
778    State = {auto_hibernate_state},
779    {ok, Pid} =
780        gen_server:start_link({local, my_test_name_auto_hibernate},
781            gen_server_SUITE, {state,State}, [{hibernate_after, HibernateAfterTimeout}]),
782    %% After init test
783    is_not_in_erlang_hibernate(Pid),
784    timer:sleep(HibernateAfterTimeout),
785    is_in_erlang_hibernate(Pid),
786    %% Get state test
787    State = sys:get_state(my_test_name_auto_hibernate),
788    is_in_erlang_hibernate(Pid),
789    %% Call test
790    ok = gen_server:call(my_test_name_auto_hibernate, started_p),
791    is_not_in_erlang_hibernate(Pid),
792    timer:sleep(HibernateAfterTimeout),
793    is_in_erlang_hibernate(Pid),
794    %% Cast test
795    ok = gen_server:cast(my_test_name_auto_hibernate, {self(),handle_cast}),
796    receive
797        {Pid, handled_cast} ->
798            ok
799    after 1000 ->
800        ct:fail(cast)
801    end,
802    is_not_in_erlang_hibernate(Pid),
803    timer:sleep(HibernateAfterTimeout),
804    is_in_erlang_hibernate(Pid),
805    %% Info test
806    Pid ! {self(),handle_info},
807    receive
808        {Pid, handled_info} ->
809            ok
810    after 1000 ->
811        ct:fail(info)
812    end,
813    is_not_in_erlang_hibernate(Pid),
814    timer:sleep(HibernateAfterTimeout),
815    is_in_erlang_hibernate(Pid),
816
817    ok = gen_server:call(my_test_name_auto_hibernate, stop),
818    receive
819        {'EXIT', Pid, stopped} ->
820            ok
821    after 5000 ->
822        ct:fail(gen_server_did_not_die)
823    end,
824    process_flag(trap_exit, OldFl),
825    ok.
826
827is_in_erlang_hibernate(Pid) ->
828    receive after 1 -> ok end,
829    is_in_erlang_hibernate_1(200, Pid).
830
831is_in_erlang_hibernate_1(0, Pid) ->
832    io:format("~p\n", [erlang:process_info(Pid, current_function)]),
833    ct:fail(not_in_erlang_hibernate_3);
834is_in_erlang_hibernate_1(N, Pid) ->
835    {current_function,MFA} = erlang:process_info(Pid, current_function),
836    case MFA of
837	{erlang,hibernate,3} ->
838	    ok;
839	_ ->
840	    receive after 10 -> ok end,
841	    is_in_erlang_hibernate_1(N-1, Pid)
842    end.
843
844is_not_in_erlang_hibernate(Pid) ->
845    receive after 1 -> ok end,
846    is_not_in_erlang_hibernate_1(200, Pid).
847
848is_not_in_erlang_hibernate_1(0, Pid) ->
849    io:format("~p\n", [erlang:process_info(Pid, current_function)]),
850    ct:fail(not_in_erlang_hibernate_3);
851is_not_in_erlang_hibernate_1(N, Pid) ->
852    {current_function,MFA} = erlang:process_info(Pid, current_function),
853    case MFA of
854        {erlang,hibernate,3} ->
855            receive after 10 -> ok end,
856            is_not_in_erlang_hibernate_1(N-1, Pid);
857        _ ->
858            ok
859    end.
860
861%% --------------------------------------
862%% Test gen_server:abcast and handle_cast.
863%% Test all different return values from
864%% handle_cast.
865%% --------------------------------------
866
867abcast(Config) when is_list(Config) ->
868    {ok, Pid} =
869	gen_server:start({local, my_test_name},
870			 gen_server_SUITE, [], []),
871
872    ok = gen_server:call(my_test_name, started_p),
873
874    abcast = gen_server:abcast(my_test_name, {self(),handle_cast}),
875    receive
876	{Pid, handled_cast} ->
877	    ok
878    after 1000 ->
879	    ct:fail(abcast)
880    end,
881
882    abcast = gen_server:abcast([node()], my_test_name,
883			       {self(),delayed_cast,1}),
884    receive
885	{Pid, delayed} ->
886	    ok
887    after 1000 ->
888	    ct:fail(delayed_abcast)
889    end,
890
891    abcast = gen_server:abcast(my_test_name, {self(),stop}),
892    receive
893	{Pid, stopped} ->
894	    ok
895    after 1000 ->
896	    ct:fail(abcast_stop)
897    end,
898    ok.
899
900%% --------------------------------------
901%% Test gen_server:multicall and handle_call.
902%% Test all different return values from
903%% handle_call.
904%% --------------------------------------
905
906multicall(Config) when is_list(Config) ->
907    OldFl = process_flag(trap_exit, true),
908
909    {ok, Pid} =
910	gen_server:start_link({local, my_test_name},
911			      gen_server_SUITE, [], []),
912
913    ok = gen_server:call(my_test_name, started_p),
914    Nodes = nodes(),
915    Node = node(),
916    {[{Node,delayed}],Nodes} =
917	gen_server:multi_call(my_test_name, {delayed_answer,1}),
918
919    %% two requests within a specified time.
920    {[{Node,ok}],[]} =
921	gen_server:multi_call([Node], my_test_name, {call_within, 1000}),
922    timer:sleep(500),
923    {[{Node,ok}],[]} =
924	gen_server:multi_call([Node], my_test_name, next_call),
925    {[{Node,ok}],[]} =
926	gen_server:multi_call([Node], my_test_name, {call_within, 1000}),
927    timer:sleep(1500),
928    {[{Node,false}],[]} =
929	gen_server:multi_call([Node],my_test_name, next_call),
930
931    %% Stop the server.
932    {[{Node,ok}],[]} =
933	gen_server:multi_call([Node],my_test_name, stop),
934    receive
935	{'EXIT', Pid, stopped} -> ok
936    after 1000 ->
937	    ct:fail(multicall_stop)
938    end,
939
940    process_flag(trap_exit, OldFl),
941
942    ok.
943
944%% OTP-3587
945multicall_down(Config) when is_list(Config) ->
946    %% We need a named host which is inaccessible.
947    Name = node@test01,
948
949    %% We use 'global' as a gen_server to call.
950    {Good, Bad} = gen_server:multi_call([Name, node()],
951					global_name_server,
952					info,
953					3000),
954    io:format("good = ~p, bad = ~p~n", [Good, Bad]),
955    [Name] = Bad,
956    ok.
957
958busy_wait_for_process(Pid,N) ->
959    case erlang:is_process_alive(Pid) of
960	true ->
961	    receive
962	    after 100 ->
963		    ok
964	    end,
965	    busy_wait_for_process(Pid,N-1);
966	_ ->
967	    ok
968    end.
969%%--------------------------------------------------------------
970%% Test gen_server:enter_loop/[3,4,5]. Used when you want to write
971%% your own special init-phase.
972spec_init(Config) when is_list(Config) ->
973
974    OldFlag = process_flag(trap_exit, true),
975
976    {ok, Pid0} = start_link(spec_init_local, [{ok, my_server}, []]),
977    ok = gen_server:call(Pid0, started_p),
978    ok = gen_server:call(Pid0, stop),
979    receive
980	{'EXIT', Pid0, stopped} ->
981 	    ok
982    after 5000 ->
983	    ct:fail(gen_server_did_not_die)
984    end,
985
986    {ok, Pid01} = start_link(spec_init_local, [{not_ok, my_server}, []]),
987    receive
988 	{'EXIT', Pid01, process_not_registered} ->
989 	    ok
990    after 5000 ->
991	    ct:fail(gen_server_did_not_die)
992    end,
993
994    {ok, Pid1} = start_link(spec_init_global, [{ok, my_server}, []]),
995    ok = gen_server:call(Pid1, started_p),
996    ok = gen_server:call(Pid1, stop),
997    receive
998	{'EXIT', Pid1, stopped} ->
999 	    ok
1000    after 5000 ->
1001	    ct:fail(gen_server_did_not_die)
1002    end,
1003
1004    {ok, Pid11} =
1005	start_link(spec_init_global, [{not_ok, my_server}, []]),
1006
1007    receive
1008	{'EXIT', Pid11, process_not_registered_globally} ->
1009 	    ok
1010    after 5000 ->
1011	    ct:fail(gen_server_did_not_die)
1012    end,
1013
1014    {ok, Pid2} = start_link(spec_init_anonymous, [[]]),
1015    ok = gen_server:call(Pid2, started_p),
1016    ok = gen_server:call(Pid2, stop),
1017    receive
1018	{'EXIT', Pid2, stopped} ->
1019 	    ok
1020    after 5000 ->
1021	    ct:fail(gen_server_did_not_die)
1022    end,
1023
1024    {ok, Pid3} = start_link(spec_init_anonymous_default_timeout, [[]]),
1025    ok = gen_server:call(Pid3, started_p),
1026    ok = gen_server:call(Pid3, stop),
1027    receive
1028	{'EXIT', Pid3, stopped} ->
1029 	    ok
1030    after 5000 ->
1031	    ct:fail(gen_server_did_not_die)
1032    end,
1033
1034    {ok, Pid4} =
1035	start_link(spec_init_default_timeout, [{ok, my_server}, []]),
1036    ok = gen_server:call(Pid4, started_p),
1037    ok = gen_server:call(Pid4, stop),
1038    receive
1039	{'EXIT', Pid4, stopped} ->
1040 	    ok
1041    after 5000 ->
1042	    ct:fail(gen_server_did_not_die)
1043    end,
1044
1045    %% Before the OTP-10130 fix this failed because a timeout message
1046    %% was generated as the spawned process crashed because a {global, Name}
1047    %% was matched as a timeout value instead of matching on scope.
1048    {ok, _PidHurra} =
1049	start_link(spec_init_global_default_timeout, [{ok, hurra}, []]),
1050    timer:sleep(1000),
1051    ok = gen_server:call(_PidHurra, started_p),
1052
1053    Pid5 =
1054	erlang:spawn_link(?MODULE, spec_init_not_proc_lib, [[]]),
1055    receive
1056	{'EXIT', Pid5, process_was_not_started_by_proc_lib} ->
1057 	    ok
1058    after 5000 ->
1059	    ct:fail(gen_server_did_not_die)
1060    end,
1061    process_flag(trap_exit, OldFlag),
1062    ok.
1063
1064%%--------------------------------------------------------------
1065%% OTP-4820. Test that terminate is run when the parent is a locally
1066%% registered process.
1067spec_init_local_registered_parent(Config) when is_list(Config) ->
1068
1069    register(foobar, self()),
1070    process_flag(trap_exit, true),
1071
1072    {ok, Pid} = start_link(spec_init_local, [{ok, my_server}, []]),
1073
1074    ok = gen_server:cast(my_server, {self(),stop}),
1075    receive
1076	{Pid, stopped} ->
1077	    ok
1078    after 1000 ->
1079	    ct:fail(stop)
1080    end,
1081    unregister(foobar),
1082    ok.
1083
1084%%--------------------------------------------------------------
1085%% OTP-4820. Test that terminate is run when the parent is a global registered
1086%% process.
1087spec_init_global_registered_parent(Config) when is_list(Config) ->
1088
1089    global:register_name(foobar, self()),
1090    process_flag(trap_exit, true),
1091
1092    {ok, Pid} = start_link(spec_init_global, [{ok, my_server}, []]),
1093
1094    ok = gen_server:call(Pid, started_p),
1095    ok = gen_server:cast(Pid, {self(),stop}),
1096
1097    receive
1098	{Pid, stopped} ->
1099	    ok
1100    after 1000 ->
1101	    ct:fail(stop)
1102    end,
1103    global:unregister_name(foobar),
1104    ok.
1105
1106%%--------------------------------------------------------------
1107
1108%% Test check for registered name in enter_loop/3,4,5.
1109otp_5854(Config) when is_list(Config) ->
1110    OldFlag = process_flag(trap_exit, true),
1111
1112    dummy_via:reset(),
1113
1114    %% Make sure gen_server:enter_loop does not accept {local,Name}
1115    %% when it's another process than the calling one which is
1116    %% registered under that name
1117    register(armitage, self()),
1118    {ok, Pid1} =
1119	start_link(spec_init_local, [{not_ok, armitage}, []]),
1120    receive
1121	{'EXIT', Pid1, process_not_registered} ->
1122	    ok
1123    after 1000 ->
1124	    ct:fail(gen_server_started)
1125    end,
1126    unregister(armitage),
1127
1128    %% Make sure gen_server:enter_loop does not accept {global,Name}
1129    %% when it's another process than the calling one which is
1130    %% registered under that name
1131    global:register_name(armitage, self()),
1132    {ok, Pid2} =
1133	start_link(spec_init_global, [{not_ok, armitage}, []]),
1134    receive
1135	{'EXIT', Pid2, process_not_registered_globally} ->
1136	    ok
1137    after 1000 ->
1138	    ct:fail(gen_server_started)
1139    end,
1140    global:unregister_name(armitage),
1141
1142    %% (same for {via, Mod, Name})
1143    dummy_via:register_name(armitage, self()),
1144    {ok, Pid3} =
1145	start_link(spec_init_via, [{not_ok, armitage}, []]),
1146    receive
1147	{'EXIT', Pid3, {process_not_registered_via, dummy_via}} ->
1148	    ok
1149    after 1000 ->
1150	    ct:fail(gen_server_started)
1151    end,
1152    dummy_via:unregister_name(armitage),
1153
1154    process_flag(trap_exit, OldFlag),
1155    ok.
1156
1157%% If initialization fails (with ignore or {stop,Reason}),
1158%% make sure that the process is not registered when gen_server:start()
1159%% returns.
1160
1161otp_7669(Config) when is_list(Config) ->
1162    do_times(100, fun do_otp_7669_local_ignore/0),
1163    do_times(100, fun do_otp_7669_global_ignore/0),
1164    do_times(10, fun do_otp_7669_stop/0),
1165    ok.
1166
1167do_times(0, _) ->
1168    ok;
1169do_times(N, Fun) ->
1170    Fun(),
1171    do_times(N-1, Fun).
1172
1173do_otp_7669_local_ignore() ->
1174    %% The name should never be registered after the return
1175    %% from gen_server:start/3.
1176    ignore = gen_server:start({local,?MODULE}, ?MODULE, ignore, []),
1177    undefined = whereis(?MODULE),
1178    ignore = gen_server:start({local,?MODULE}, ?MODULE, ignore, []),
1179    undefined = whereis(?MODULE),
1180    ignore = gen_server:start_link({local,?MODULE}, ?MODULE, ignore, []),
1181    undefined = whereis(?MODULE).
1182
1183do_otp_7669_global_ignore() ->
1184    ignore = gen_server:start({global,?MODULE}, ?MODULE, ignore, []),
1185    undefined = global:whereis_name(?MODULE),
1186    ignore = gen_server:start_link({global,?MODULE}, ?MODULE, ignore, []),
1187    undefined = global:whereis_name(?MODULE).
1188
1189do_otp_7669_stop() ->
1190    %% The name should never be registered after the return
1191    %% from gen_server:start/3.
1192    {error,stopped} = gen_server:start({local,?MODULE},
1193				       ?MODULE, stop, []),
1194    undefined = whereis(?MODULE),
1195
1196    {error,stopped} = gen_server:start({global,?MODULE},
1197				       ?MODULE, stop, []),
1198    undefined = global:whereis_name(?MODULE).
1199
1200%% Verify that sys:get_status correctly calls our format_status/2 fun.
1201call_format_status(Config) when is_list(Config) ->
1202    {ok, Pid} = gen_server:start_link({local, call_format_status},
1203				      ?MODULE, [], []),
1204    Status1 = sys:get_status(call_format_status),
1205    {status, Pid, _Mod, [_PDict, running, _Parent, _, Data1]} = Status1,
1206    [format_status_called | _] = lists:reverse(Data1),
1207    Status2 = sys:get_status(call_format_status, 5000),
1208    {status, Pid, _Mod, [_PDict, running, _Parent, _, Data2]} = Status2,
1209    [format_status_called | _] = lists:reverse(Data2),
1210
1211    %% check that format_status can handle a name being a pid (atom is
1212    %% already checked by the previous test)
1213    {ok, Pid3} = gen_server:start_link(gen_server_SUITE, [], []),
1214    Status3 = sys:get_status(Pid3),
1215    {status, Pid3, _Mod, [_PDict3, running, _Parent, _, Data3]} = Status3,
1216    [format_status_called | _] = lists:reverse(Data3),
1217
1218    %% check that format_status can handle a name being a term other than a
1219    %% pid or atom
1220    GlobalName1 = {global, "CallFormatStatus"},
1221    {ok, Pid4} = gen_server:start_link(GlobalName1,
1222				       gen_server_SUITE, [], []),
1223    Status4 = sys:get_status(Pid4),
1224    {status, Pid4, _Mod, [_PDict4, running, _Parent, _, Data4]} = Status4,
1225    [format_status_called | _] = lists:reverse(Data4),
1226    GlobalName2 = {global, {name, "term"}},
1227    {ok, Pid5} = gen_server:start_link(GlobalName2,
1228				       gen_server_SUITE, [], []),
1229    Status5 = sys:get_status(GlobalName2),
1230    {status, Pid5, _Mod, [_PDict5, running, _Parent, _, Data5]} = Status5,
1231    [format_status_called | _] = lists:reverse(Data5),
1232    ok.
1233
1234%% Verify that error termination correctly calls our format_status/2 fun.
1235error_format_status(Config) when is_list(Config) ->
1236    error_logger_forwarder:register(),
1237    OldFl = process_flag(trap_exit, true),
1238    State = "called format_status",
1239    {ok, Pid} = gen_server:start_link(?MODULE, {state, State}, []),
1240    {'EXIT',{crashed,_}} = (catch gen_server:call(Pid, crash)),
1241    receive
1242	{'EXIT', Pid, crashed} ->
1243	    ok
1244    end,
1245    ClientPid = self(),
1246    receive
1247	{error,_GroupLeader,{Pid,
1248			     "** Generic server"++_,
1249			     [Pid,crash,{formatted, State},
1250			      {crashed,[{?MODULE,handle_call,3,_}
1251					|_Stacktrace]},
1252			       ClientPid, [_|_] = _ClientStack]}} ->
1253	    ok;
1254	Other ->
1255	    io:format("Unexpected: ~p", [Other]),
1256	    ct:fail(failed)
1257    end,
1258    process_flag(trap_exit, OldFl),
1259    ok.
1260
1261%% Verify that error when terminating correctly calls our format_status/2 fun
1262%%
1263terminate_crash_format(Config) when is_list(Config) ->
1264    error_logger_forwarder:register(),
1265    OldFl = process_flag(trap_exit, true),
1266    State = crash_terminate,
1267    {ok, Pid} = gen_server:start_link(?MODULE, {state, State}, []),
1268    gen_server:call(Pid, stop),
1269    receive {'EXIT', Pid, {crash, terminate}} -> ok end,
1270    ClientPid = self(),
1271    receive
1272	{error,_GroupLeader,{Pid,
1273			     "** Generic server"++_,
1274			     [Pid,stop, {formatted, State},
1275			      {{crash, terminate},
1276			       [{?MODULE,terminate,2,_}|_Stacktrace]},
1277			       ClientPid, [_|_] = _ClientStack]}} ->
1278	    ok;
1279	Other ->
1280	    io:format("Unexpected: ~p", [Other]),
1281	    ct:fail(failed)
1282    after 5000 ->
1283	    io:format("Timeout: expected error logger msg", []),
1284	    ct:fail(failed)
1285    end,
1286    process_flag(trap_exit, OldFl),
1287    ok.
1288
1289%% Verify that sys:get_state correctly returns gen_server state
1290get_state(Config) when is_list(Config) ->
1291    State = self(),
1292    {ok, _Pid} = gen_server:start_link({local, get_state},
1293				       ?MODULE, {state,State}, []),
1294    State = sys:get_state(get_state),
1295    State = sys:get_state(get_state, 5000),
1296    {ok, Pid} = gen_server:start_link(?MODULE, {state,State}, []),
1297    State = sys:get_state(Pid),
1298    State = sys:get_state(Pid, 5000),
1299    ok = sys:suspend(Pid),
1300    State = sys:get_state(Pid),
1301    ok = sys:resume(Pid),
1302    ok.
1303
1304%% Verify that sys:replace_state correctly replaces gen_server state
1305replace_state(Config) when is_list(Config) ->
1306    State = self(),
1307    {ok, _Pid} = gen_server:start_link({local, replace_state},
1308				       ?MODULE, {state,State}, []),
1309    State = sys:get_state(replace_state),
1310    NState1 = "replaced",
1311    Replace1 = fun(_) -> NState1 end,
1312    NState1 = sys:replace_state(replace_state, Replace1),
1313    NState1 = sys:get_state(replace_state),
1314    {ok, Pid} = gen_server:start_link(?MODULE, {state,NState1}, []),
1315    NState1 = sys:get_state(Pid),
1316    Suffix = " again",
1317    NState2 = NState1 ++ Suffix,
1318    Replace2 = fun(S) -> S ++ Suffix end,
1319    NState2 = sys:replace_state(Pid, Replace2, 5000),
1320    NState2 = sys:get_state(Pid, 5000),
1321    %% verify no change in state if replace function crashes
1322    Replace3 = fun(_) -> throw(fail) end,
1323    {'EXIT',{{callback_failed,
1324	      {gen_server,system_replace_state},{throw,fail}},_}} =
1325	(catch sys:replace_state(Pid, Replace3)),
1326    NState2 = sys:get_state(Pid, 5000),
1327    %% verify state replaced if process sys suspended
1328    ok = sys:suspend(Pid),
1329    Suffix2 = " and again",
1330    NState3 = NState2 ++ Suffix2,
1331    Replace4 = fun(S) -> S ++ Suffix2 end,
1332    NState3 = sys:replace_state(Pid, Replace4),
1333    ok = sys:resume(Pid),
1334    NState3 = sys:get_state(Pid, 5000),
1335    ok.
1336
1337%% Test that the time for a huge message queue is not
1338%% significantly slower than with an empty message queue.
1339call_with_huge_message_queue(Config) when is_list(Config) ->
1340    case test_server:is_native(gen) of
1341	true ->
1342	    {skip,
1343	     "gen is native - huge message queue optimization "
1344	     "is not implemented"};
1345	false ->
1346	    do_call_with_huge_message_queue()
1347    end.
1348
1349do_call_with_huge_message_queue() ->
1350    Pid = spawn_link(fun echo_loop/0),
1351
1352    {Time,ok} = tc(fun() -> calls(10000, Pid) end),
1353
1354    _ = [self() ! {msg,N} || N <- lists:seq(1, 500000)],
1355    erlang:garbage_collect(),
1356    {NewTime,ok} = tc(fun() -> calls(10000, Pid) end),
1357    io:format("Time for empty message queue: ~p", [Time]),
1358    io:format("Time for huge message queue: ~p", [NewTime]),
1359
1360    IsCover = test_server:is_cover(),
1361    case (NewTime+1) / (Time+1) of
1362	Q when Q < 10; IsCover ->
1363	    ok;
1364	Q ->
1365	    io:format("Q = ~p", [Q]),
1366	    ct:fail(failed)
1367    end,
1368    ok.
1369
1370calls(0, _) -> ok;
1371calls(N, Pid) ->
1372    {ultimate_answer,42} = call(Pid, {ultimate_answer,42}),
1373    calls(N-1, Pid).
1374
1375call(Pid, Msg) ->
1376    gen_server:call(Pid, Msg, infinity).
1377
1378tc(Fun) ->
1379    timer:tc(erlang, apply, [Fun,[]]).
1380
1381echo_loop() ->
1382    receive
1383	{'$gen_call',{Pid,Ref},Msg} ->
1384	    Pid ! {Ref,Msg},
1385	    echo_loop()
1386    end.
1387
1388%% Test the default implementation of terminate if the callback module
1389%% does not export it
1390undef_terminate1(Config) when is_list(Config) ->
1391    {ok, Server} = oc_server:start(),
1392    MRef = monitor(process, Server),
1393    ok = gen_server:stop(Server),
1394    ok = verify_down_reason(MRef, Server, normal).
1395
1396%% Test the default implementation of terminate if the callback module
1397%% does not export it
1398undef_terminate2(Config) when is_list(Config) ->
1399    {ok, Server} = oc_server:start(),
1400    MRef = monitor(process, Server),
1401    ok = gen_server:stop(Server, {error, test}, infinity),
1402    ok = verify_down_reason(MRef, Server, {error, test}).
1403
1404%% Start should return an undef error if init isn't implemented
1405undef_init(_Config) ->
1406    {error, {undef, [{oc_init_server, init, [_], _}|_]}} =
1407        gen_server:start(oc_init_server, [], []),
1408    process_flag(trap_exit, true),
1409    {error, {undef, [{oc_init_server, init, [_], _}|_]}} =
1410        (catch gen_server:start_link(oc_init_server, [], [])),
1411    receive
1412        {'EXIT', Server,
1413         {undef, [{oc_init_server, init, [_], _}|_]}} when is_pid(Server) ->
1414            ok
1415    after 1000 ->
1416        ct:fail(expected_exit_msg)
1417    end.
1418
1419%% The upgrade should fail if code_change is expected in the callback module
1420%% but not exported, but the server should continue with the old code
1421undef_code_change(Config) when is_list(Config) ->
1422    {ok, Server} = oc_server:start(),
1423    {error, {'EXIT', {undef, [{oc_server, code_change, [_, _, _], _}|_]}}}
1424        = fake_upgrade(Server, ?MODULE),
1425    true = is_process_alive(Server).
1426
1427%% The server should crash if the handle_call callback is
1428%% not exported in the callback module
1429undef_handle_call(_Config) ->
1430    {ok, Server} = oc_server:start(),
1431    try
1432        gen_server:call(Server, call_msg),
1433        ct:fail(should_crash)
1434    catch exit:{{undef, [{oc_server, handle_call, _, _}|_]},
1435                {gen_server, call, _}} ->
1436        ok
1437    end.
1438
1439%% The server should crash if the handle_cast callback is
1440%% not exported in the callback module
1441undef_handle_cast(_Config) ->
1442    {ok, Server} = oc_server:start(),
1443    MRef = monitor(process, Server),
1444    gen_server:cast(Server, cast_msg),
1445    verify_undef_down(MRef, Server, oc_server, handle_cast),
1446    ok.
1447
1448%% The server should crash if the handle_continue callback is
1449%% not exported in the callback module
1450undef_handle_continue(_Config) ->
1451    {ok, Server} = oc_server:start(continue),
1452    MRef = monitor(process, Server),
1453    verify_undef_down(MRef, Server, oc_server, handle_continue),
1454    ok.
1455
1456%% The server should log but not crash if the handle_info callback is
1457%% calling an undefined function
1458undef_handle_info(Config) when is_list(Config) ->
1459    error_logger_forwarder:register(),
1460    {ok, Server} = oc_server:start(),
1461    Server ! hej,
1462    wait_until_processed(Server, hej, 10),
1463    true = is_process_alive(Server),
1464    receive
1465        {warning_msg, _GroupLeader,
1466         {Server, "** Undefined handle_info in " ++ _, [oc_server, hej]}} ->
1467            ok;
1468        Other ->
1469            io:format("Unexpected: ~p", [Other]),
1470            ct:fail(failed)
1471    end.
1472
1473%% Test that the default implementation of terminate isn't catching the
1474%% wrong undef error
1475undef_in_terminate(Config) when is_list(Config) ->
1476    State = {undef_in_terminate, {oc_server, terminate}},
1477    {ok, Server} = gen_server:start(?MODULE, {state, State}, []),
1478    try
1479        ok = gen_server:stop(Server),
1480        ct:fail(failed)
1481    catch
1482        exit:{undef, [{oc_server, terminate, [], _}|_]} ->
1483            ok
1484    end.
1485
1486%% Test that the default implementation of handle_info isn't catching the
1487%% wrong undef error
1488undef_in_handle_info(Config) when is_list(Config) ->
1489     {ok, Server} = gen_server:start(?MODULE, [], []),
1490     MRef = monitor(process, Server),
1491     Server ! {call_undef_fun, ?MODULE, handle_info},
1492     verify_undef_down(MRef, Server, ?MODULE, handle_info),
1493     ok.
1494
1495verify_down_reason(MRef, Server, Reason) ->
1496    receive
1497        {'DOWN', MRef, process, Server, Reason} ->
1498            ok
1499    after 5000 ->
1500        ct:fail(failed)
1501    end.
1502
1503verify_undef_down(MRef, Pid, Mod, Fun) ->
1504    ok = receive
1505        {'DOWN', MRef, process, Pid,
1506         {undef, [{Mod, Fun, _, _}|_]}} ->
1507            ok
1508    after 5000 ->
1509        ct:fail(should_crash)
1510    end.
1511
1512fake_upgrade(Pid, Mod) ->
1513    sys:suspend(Pid),
1514    sys:replace_state(Pid, fun(State) -> {new, State} end),
1515    Ret = sys:change_code(Pid, Mod, old_vsn, []),
1516    ok = sys:resume(Pid),
1517    Ret.
1518
1519wait_until_processed(_Pid, _Message, 0) ->
1520    ct:fail(not_processed);
1521wait_until_processed(Pid, Message, N) ->
1522    {messages, Messages} = erlang:process_info(Pid, messages),
1523    case lists:member(Message, Messages) of
1524        true ->
1525            timer:sleep(100),
1526            wait_until_processed(Pid, Message, N-1);
1527        false ->
1528            ok
1529    end.
1530
1531%%--------------------------------------------------------------
1532%% Help functions to spec_init_*
1533start_link(Init, Options) ->
1534    proc_lib:start_link(?MODULE, Init, Options).
1535
1536spec_init_local({ok, Name}, Options) ->
1537    process_flag(trap_exit, true),
1538    register(Name, self()),
1539    proc_lib:init_ack({ok, self()}),
1540    %% Supervised init can occur here  ...
1541    gen_server:enter_loop(?MODULE, Options, {}, {local, Name}, infinity);
1542
1543spec_init_local({not_ok, Name}, Options) ->
1544    process_flag(trap_exit, true),
1545    proc_lib:init_ack({ok, self()}),
1546    %% Supervised init can occur here  ...
1547    gen_server:enter_loop(?MODULE, Options, {}, {local, Name}, infinity).
1548
1549spec_init_global({ok, Name}, Options) ->
1550    process_flag(trap_exit, true),
1551    global:register_name(Name, self()),
1552    proc_lib:init_ack({ok, self()}),
1553    %% Supervised init can occur here  ...
1554    gen_server:enter_loop(?MODULE, Options, {}, {global, Name}, infinity);
1555
1556spec_init_global({not_ok, Name}, Options) ->
1557    process_flag(trap_exit, true),
1558    proc_lib:init_ack({ok, self()}),
1559    %% Supervised init can occur here  ...
1560    gen_server:enter_loop(?MODULE, Options, {}, {global, Name}, infinity).
1561
1562spec_init_via({ok, Name}, Options) ->
1563    process_flag(trap_exit, true),
1564    dummy_via:register_name(Name, self()),
1565    proc_lib:init_ack({ok, self()}),
1566    %% Supervised init can occur here  ...
1567    gen_server:enter_loop(?MODULE, Options, {},
1568			  {via, dummy_via, Name}, infinity);
1569
1570spec_init_via({not_ok, Name}, Options) ->
1571    process_flag(trap_exit, true),
1572    proc_lib:init_ack({ok, self()}),
1573    %% Supervised init can occur here  ...
1574    gen_server:enter_loop(?MODULE, Options, {},
1575			  {via, dummy_via, Name}, infinity).
1576
1577spec_init_default_timeout({ok, Name}, Options) ->
1578    process_flag(trap_exit, true),
1579    register(Name, self()),
1580    proc_lib:init_ack({ok, self()}),
1581    %% Supervised init can occur here  ...
1582    gen_server:enter_loop(?MODULE, Options, {}, {local, Name}).
1583
1584%% OTP-10130, A bug was introduced where global scope was not matched when
1585%% enter_loop/4 was called (no timeout).
1586spec_init_global_default_timeout({ok, Name}, Options) ->
1587    process_flag(trap_exit, true),
1588    global:register_name(Name, self()),
1589    proc_lib:init_ack({ok, self()}),
1590    %% Supervised init can occur here  ...
1591    gen_server:enter_loop(?MODULE, Options, {}, {global, Name}).
1592
1593spec_init_anonymous(Options) ->
1594    process_flag(trap_exit, true),
1595    proc_lib:init_ack({ok, self()}),
1596    %% Supervised init can occur here  ...
1597    gen_server:enter_loop(?MODULE, Options, {}, infinity).
1598
1599spec_init_anonymous_default_timeout(Options) ->
1600    process_flag(trap_exit, true),
1601    proc_lib:init_ack({ok, self()}),
1602    %% Supervised init can occur here  ...
1603    gen_server:enter_loop(?MODULE, Options, {}).
1604
1605spec_init_not_proc_lib(Options) ->
1606    gen_server:enter_loop(?MODULE, Options, {}, infinity).
1607
1608%%% --------------------------------------------------------
1609%%% Here is the tested gen_server behaviour.
1610%%% --------------------------------------------------------
1611
1612init([]) ->
1613    {ok, []};
1614init(ignore) ->
1615    ignore;
1616init(stop) ->
1617    {stop, stopped};
1618init(hibernate) ->
1619    {ok,[],hibernate};
1620init(sleep) ->
1621    ct:sleep(1000),
1622    {ok, []};
1623init({continue, Pid}) ->
1624    self() ! {after_continue, Pid},
1625    {ok, [], {continue, {message, Pid}}};
1626init({state,State}) ->
1627    {ok,State}.
1628
1629handle_call(started_p, _From, State) ->
1630    io:format("FROZ"),
1631    {reply,ok,State};
1632handle_call({delayed_answer, T}, From, _State) ->
1633    {noreply,{reply_to,From},T};
1634handle_call({call_within, T}, _From, _) ->
1635    {reply,ok,call_within,T};
1636handle_call(next_call, _From, call_within) ->
1637    {reply,ok,[]};
1638handle_call(next_call, _From, State) ->
1639    {reply,false,State};
1640handle_call(badreturn, _From, _State) ->
1641    badreturn;
1642handle_call(hibernate, _From, _State) ->
1643    {reply,true,[],hibernate};
1644handle_call({hibernate_noreply,Pid}, From, _State) ->
1645    Pid ! go,
1646    {noreply,From,hibernate};
1647handle_call(stop, _From, State) ->
1648    {stop,stopped,ok,State};
1649handle_call(crash, _From, _State) ->
1650    exit(crashed);
1651handle_call(exit_shutdown, _From, _State) ->
1652    exit(shutdown);
1653handle_call(stop_shutdown, _From, State) ->
1654    {stop,shutdown,State};
1655handle_call(shutdown_reason, _From, _State) ->
1656    exit({shutdown,reason});
1657handle_call({call_undef_fun, Mod, Fun}, _From, State) ->
1658    Mod:Fun(),
1659    {reply, ok, State};
1660handle_call({continue_reply, Pid}, _From, State) ->
1661    self() ! {after_continue, Pid},
1662    {reply, ok, State, {continue, {message, Pid}}};
1663handle_call({continue_noreply, Pid}, From, State) ->
1664    self() ! {after_continue, Pid},
1665    {noreply, State, {continue, {message, Pid, From}}};
1666handle_call(stop_shutdown_reason, _From, State) ->
1667    {stop,{shutdown,stop_reason},State}.
1668
1669handle_cast({From,handle_cast}, State) ->
1670    From ! {self(), handled_cast},
1671    {noreply, State};
1672handle_cast({From,delayed_cast,T}, _State) ->
1673    {noreply, {delayed_cast,From}, T};
1674handle_cast(hibernate_now, _State) ->
1675    {noreply, [], hibernate};
1676handle_cast(hibernate_later, _State) ->
1677    {ok, _} = timer:send_after(1000,self(),hibernate_now),
1678    {noreply, []};
1679handle_cast({call_undef_fun, Mod, Fun}, State) ->
1680    Mod:Fun(),
1681    {noreply, State};
1682handle_cast({continue_noreply, Pid}, State) ->
1683    self() ! {after_continue, Pid},
1684    {noreply, State, {continue, {message, Pid}}};
1685handle_cast({From, stop}, State) ->
1686    io:format("BAZ"),
1687    {stop, {From,stopped}, State}.
1688
1689handle_info(timeout, {reply_to, From}) ->
1690    gen_server:reply(From, delayed),
1691    {noreply, []};
1692handle_info(timeout, hibernate_me) -> % Arrive here from
1693						% handle_info(hibernate_later,...)
1694    {noreply, [], hibernate};
1695handle_info(hibernate_now, _State) ->  % Arrive here from
1696						% handle_cast({_,hibernate_later},...)
1697						% and by direct ! from testcase
1698    {noreply, [], hibernate};
1699handle_info(hibernate_later, _State) ->
1700    {noreply, hibernate_me, 1000};
1701handle_info(timeout, call_within) ->
1702    {noreply, []};
1703handle_info(timeout, {delayed_cast, From}) ->
1704    From ! {self(), delayed},
1705    {noreply, []};
1706handle_info(timeout, {delayed_info, From}) ->
1707    From ! {self(), delayed_info},
1708    {noreply, []};
1709handle_info({call_undef_fun, Mod, Fun}, State) ->
1710    Mod:Fun(),
1711    {noreply, State};
1712handle_info({From, handle_info}, _State) ->
1713    From ! {self(), handled_info},
1714    {noreply, []};
1715handle_info({From, delayed_info, T}, _State) ->
1716    {noreply, {delayed_info, From}, T};
1717handle_info(continue, From) ->
1718    gen_server:reply(From,true),
1719    {noreply, []};
1720handle_info({From, stop}, State) ->
1721    {stop, {From,stopped_info}, State};
1722handle_info({after_continue, Pid}, State) ->
1723    Pid ! {self(), after_continue},
1724    Pid ! {self(), ack},
1725    {noreply, State};
1726handle_info({continue_noreply, Pid}, State) ->
1727    self() ! {after_continue, Pid},
1728    {noreply, State, {continue, {message, Pid}}};
1729handle_info({continue_continue, Pid}, State) ->
1730    {noreply, State, {continue, {continue, Pid}}};
1731handle_info(continue_stop, State) ->
1732    {noreply, State, {continue, stop}};
1733handle_info(_Info, State) ->
1734    {noreply, State}.
1735
1736handle_continue({continue, Pid}, State) ->
1737    Pid ! {self(), before_continue},
1738    self() ! {after_continue, Pid},
1739    {noreply, State, {continue, {message, Pid}}};
1740handle_continue(stop, State) ->
1741    {stop, normal, State};
1742handle_continue({message, Pid}, State) ->
1743    Pid ! {self(), continue},
1744    {noreply, State};
1745handle_continue({message, Pid, From}, State) ->
1746    Pid ! {self(), continue},
1747    gen_server:reply(From, ok),
1748    {noreply, State}.
1749
1750code_change(_OldVsn,
1751            {new, {undef_in_code_change, {Mod, Fun}}} = State,
1752            _Extra) ->
1753    Mod:Fun(),
1754    {ok, State}.
1755
1756terminate({From, stopped}, _State) ->
1757    io:format("FOOBAR"),
1758    From ! {self(), stopped},
1759    ok;
1760terminate({From, stopped_info}, _State) ->
1761    From ! {self(), stopped_info},
1762    ok;
1763terminate(_, crash_terminate) ->
1764    exit({crash, terminate});
1765terminate(_, {undef_in_terminate, {Mod, Fun}}) ->
1766    Mod:Fun(),
1767    ok;
1768terminate(_Reason, _State) ->
1769    ok.
1770
1771format_status(terminate, [_PDict, State]) ->
1772    {formatted, State};
1773format_status(normal, [_PDict, _State]) ->
1774    format_status_called.
1775