1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1996-2019. 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_fsm_SUITE).
21
22-include_lib("common_test/include/ct.hrl").
23
24%% Test cases
25-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
26	 init_per_group/2,end_per_group/2]).
27
28-export([start1/1, start2/1, start3/1, start4/1, start5/1, start6/1,
29	 start7/1, start8/1, start9/1, start10/1, start11/1, start12/1]).
30
31-export([stop1/1, stop2/1, stop3/1, stop4/1, stop5/1, stop6/1, stop7/1,
32	 stop8/1, stop9/1, stop10/1]).
33
34-export([ abnormal1/1, abnormal2/1]).
35
36-export([shutdown/1]).
37
38-export([ sys1/1,
39	  call_format_status/1, error_format_status/1, terminate_crash_format/1,
40	  get_state/1, replace_state/1]).
41
42-export([undef_handle_event/1, undef_handle_sync_event/1, undef_handle_info/1,
43         undef_init/1, undef_code_change/1, undef_terminate1/1, undef_terminate2/1]).
44
45-export([undef_in_handle_info/1, undef_in_terminate/1]).
46
47-export([hibernate/1,auto_hibernate/1,hiber_idle/3,hiber_wakeup/3,hiber_idle/2,hiber_wakeup/2]).
48
49-export([format_log_1/1, format_log_2/1]).
50
51-export([reply_by_alias_with_payload/1]).
52
53-export([enter_loop/1]).
54
55%% Exports for apply
56-export([enter_loop/2]).
57
58%% The gen_fsm behaviour
59-export([init/1, handle_event/3, handle_sync_event/4, terminate/3,
60	 handle_info/3, format_status/2, code_change/4]).
61-export([idle/2,	idle/3,
62	 timeout/2,
63	 wfor_conf/2,	wfor_conf/3,
64	 connected/2,	connected/3]).
65-export([state0/3]).
66
67
68%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
69
70
71suite() -> [{ct_hooks,[ts_install_cth]}].
72
73all() ->
74    [{group, start}, {group, abnormal}, shutdown,
75     {group, sys}, hibernate, auto_hibernate, enter_loop, {group, undef_callbacks},
76     undef_in_handle_info, undef_in_terminate,{group,format_log},
77     reply_by_alias_with_payload].
78
79groups() ->
80    [{start, [],
81      [start1, start2, start3, start4, start5, start6, start7,
82       start8, start9, start10, start11, start12]},
83     {stop, [],
84      [stop1, stop2, stop3, stop4, stop5, stop6, stop7, stop8, stop9, stop10]},
85     {abnormal, [], [abnormal1, abnormal2]},
86     {sys, [],
87      [sys1, call_format_status, error_format_status, terminate_crash_format,
88       get_state, replace_state]},
89     {undef_callbacks, [],
90      [undef_handle_event, undef_handle_sync_event, undef_handle_info,
91       undef_init, undef_code_change, undef_terminate1, undef_terminate2]},
92     {format_log, [], [format_log_1, format_log_2]}].
93
94init_per_suite(Config) ->
95    Config.
96
97end_per_suite(_Config) ->
98    ok.
99
100init_per_group(undef_callbacks, Config) ->
101    DataDir = ?config(data_dir, Config),
102    Server = filename:join(DataDir, "oc_fsm.erl"),
103    {ok, oc_fsm} = compile:file(Server),
104    Config;
105init_per_group(_GroupName, Config) ->
106    Config.
107
108end_per_group(_GroupName, Config) ->
109    Config.
110
111%% anonymous
112start1(Config) when is_list(Config) ->
113    %%OldFl = process_flag(trap_exit, true),
114
115    {ok, Pid0} = gen_fsm:start_link(gen_fsm_SUITE, [], []),
116    ok = do_func_test(Pid0),
117    ok = do_sync_func_test(Pid0),
118    stop_it(Pid0),
119    %%    stopped = gen_fsm:sync_send_all_state_event(Pid0, stop),
120    %%    {'EXIT', {timeout,_}} =
121    %%	(catch gen_fsm:sync_send_event(Pid0, hej)),
122
123    [] = get_messages(),
124    %%process_flag(trap_exit, OldFl),
125    ok.
126
127%% anonymous w. shutdown
128start2(Config) when is_list(Config) ->
129    %% Dont link when shutdown
130    {ok, Pid0} = gen_fsm:start(gen_fsm_SUITE, [], []),
131    ok = do_func_test(Pid0),
132    ok = do_sync_func_test(Pid0),
133    MRef = monitor(process,Pid0),
134    shutdown_stopped =
135	gen_fsm:sync_send_all_state_event(Pid0, stop_shutdown),
136    receive {'DOWN',MRef,_,_,shutdown} -> ok end,
137    {'EXIT', {noproc,_}} =
138	(catch gen_fsm:sync_send_event(Pid0, hej)),
139
140    [] = get_messages(),
141    ok.
142
143%% anonymous with timeout
144start3(Config) when is_list(Config) ->
145    %%OldFl = process_flag(trap_exit, true),
146
147    {ok, Pid0} = gen_fsm:start(gen_fsm_SUITE, [], [{timeout,5}]),
148    ok = do_func_test(Pid0),
149    ok = do_sync_func_test(Pid0),
150    stop_it(Pid0),
151
152    {error, timeout} = gen_fsm:start(gen_fsm_SUITE, sleep,
153				     [{timeout,5}]),
154
155    [] = get_messages(),
156    %%process_flag(trap_exit, OldFl),
157    ok.
158
159%% anonymous with ignore
160start4(Config) when is_list(Config) ->
161    OldFl = process_flag(trap_exit, true),
162
163    ignore = gen_fsm:start(gen_fsm_SUITE, ignore, []),
164
165    [] = get_messages(),
166    process_flag(trap_exit, OldFl),
167    ok.
168
169%% anonymous with stop
170start5(Config) when is_list(Config) ->
171    OldFl = process_flag(trap_exit, true),
172
173    {error, stopped} = gen_fsm:start(gen_fsm_SUITE, stop, []),
174
175    [] = get_messages(),
176    process_flag(trap_exit, OldFl),
177    ok.
178
179%% anonymous linked
180start6(Config) when is_list(Config) ->
181    {ok, Pid} = gen_fsm:start_link(gen_fsm_SUITE, [], []),
182    ok = do_func_test(Pid),
183    ok = do_sync_func_test(Pid),
184    stop_it(Pid),
185
186    [] = get_messages(),
187
188    ok.
189
190%% global register linked
191start7(Config) when is_list(Config) ->
192    {ok, Pid} =
193	gen_fsm:start_link({global, my_fsm}, gen_fsm_SUITE, [], []),
194    {error, {already_started, Pid}} =
195	gen_fsm:start_link({global, my_fsm}, gen_fsm_SUITE, [], []),
196    {error, {already_started, Pid}} =
197	gen_fsm:start({global, my_fsm}, gen_fsm_SUITE, [], []),
198
199    ok = do_func_test(Pid),
200    ok = do_sync_func_test(Pid),
201    ok = do_func_test({global, my_fsm}),
202    ok = do_sync_func_test({global, my_fsm}),
203    stop_it({global, my_fsm}),
204
205    [] = get_messages(),
206    ok.
207
208
209%% local register
210start8(Config) when is_list(Config) ->
211    %%OldFl = process_flag(trap_exit, true),
212
213    {ok, Pid} =
214	gen_fsm:start({local, my_fsm}, gen_fsm_SUITE, [], []),
215    {error, {already_started, Pid}} =
216	gen_fsm:start({local, my_fsm}, gen_fsm_SUITE, [], []),
217
218    ok = do_func_test(Pid),
219    ok = do_sync_func_test(Pid),
220    ok = do_func_test(my_fsm),
221    ok = do_sync_func_test(my_fsm),
222    stop_it(Pid),
223
224    [] = get_messages(),
225    %%process_flag(trap_exit, OldFl),
226    ok.
227
228%% local register linked
229start9(Config) when is_list(Config) ->
230    %%OldFl = process_flag(trap_exit, true),
231
232    {ok, Pid} =
233	gen_fsm:start_link({local, my_fsm}, gen_fsm_SUITE, [], []),
234    {error, {already_started, Pid}} =
235	gen_fsm:start({local, my_fsm}, gen_fsm_SUITE, [], []),
236
237    ok = do_func_test(Pid),
238    ok = do_sync_func_test(Pid),
239    ok = do_func_test(my_fsm),
240    ok = do_sync_func_test(my_fsm),
241    stop_it(Pid),
242
243    [] = get_messages(),
244    %%process_flag(trap_exit, OldFl),
245    ok.
246
247%% global register
248start10(Config) when is_list(Config) ->
249    {ok, Pid} =
250	gen_fsm:start({global, my_fsm}, gen_fsm_SUITE, [], []),
251    {error, {already_started, Pid}} =
252	gen_fsm:start({global, my_fsm}, gen_fsm_SUITE, [], []),
253    {error, {already_started, Pid}} =
254	gen_fsm:start_link({global, my_fsm}, gen_fsm_SUITE, [], []),
255
256    ok = do_func_test(Pid),
257    ok = do_sync_func_test(Pid),
258    ok = do_func_test({global, my_fsm}),
259    ok = do_sync_func_test({global, my_fsm}),
260    stop_it({global, my_fsm}),
261
262    [] = get_messages(),
263    ok.
264
265
266%% Stop registered processes
267start11(Config) when is_list(Config) ->
268    {ok, Pid} =
269	gen_fsm:start_link({local, my_fsm}, gen_fsm_SUITE, [], []),
270    stop_it(Pid),
271
272    {ok, _Pid1} =
273	gen_fsm:start_link({local, my_fsm}, gen_fsm_SUITE, [], []),
274    stop_it(my_fsm),
275
276    {ok, Pid2} =
277	gen_fsm:start({global, my_fsm}, gen_fsm_SUITE, [], []),
278    stop_it(Pid2),
279    receive after 1 -> true end,
280    Result =
281	gen_fsm:start({global, my_fsm}, gen_fsm_SUITE, [], []),
282    io:format("Result = ~p~n",[Result]),
283    {ok, _Pid3} = Result,
284    stop_it({global, my_fsm}),
285
286    [] = get_messages(),
287    ok.
288
289%% Via register linked
290start12(Config) when is_list(Config) ->
291    dummy_via:reset(),
292    {ok, Pid} =
293	gen_fsm:start_link({via, dummy_via, my_fsm}, gen_fsm_SUITE, [], []),
294    {error, {already_started, Pid}} =
295	gen_fsm:start_link({via, dummy_via, my_fsm}, gen_fsm_SUITE, [], []),
296    {error, {already_started, Pid}} =
297	gen_fsm:start({via, dummy_via, my_fsm}, gen_fsm_SUITE, [], []),
298
299    ok = do_func_test(Pid),
300    ok = do_sync_func_test(Pid),
301    ok = do_func_test({via, dummy_via, my_fsm}),
302    ok = do_sync_func_test({via, dummy_via, my_fsm}),
303    stop_it({via, dummy_via, my_fsm}),
304
305    [] = get_messages(),
306    ok.
307
308
309%% Anonymous, reason 'normal'
310stop1(_Config) ->
311    {ok, Pid} = gen_fsm:start(?MODULE, [], []),
312    ok = gen_fsm:stop(Pid),
313    false = erlang:is_process_alive(Pid),
314    {'EXIT',noproc} = (catch gen_fsm:stop(Pid)),
315    ok.
316
317%% Anonymous, other reason
318stop2(_Config) ->
319    {ok,Pid} = gen_fsm:start(?MODULE, [], []),
320    ok = gen_fsm:stop(Pid, other_reason, infinity),
321    false = erlang:is_process_alive(Pid),
322    ok.
323
324%% Anonymous, invalid timeout
325stop3(_Config) ->
326    {ok,Pid} = gen_fsm:start(?MODULE, [], []),
327    {'EXIT',_} = (catch gen_fsm:stop(Pid, other_reason, invalid_timeout)),
328    true = erlang:is_process_alive(Pid),
329    ok = gen_fsm:stop(Pid),
330    false = erlang:is_process_alive(Pid),
331    ok.
332
333%% Registered name
334stop4(_Config) ->
335    {ok,Pid} = gen_fsm:start({local,to_stop},?MODULE, [], []),
336    ok = gen_fsm:stop(to_stop),
337    false = erlang:is_process_alive(Pid),
338    {'EXIT',noproc} = (catch gen_fsm:stop(to_stop)),
339    ok.
340
341%% Registered name and local node
342stop5(_Config) ->
343    {ok,Pid} = gen_fsm:start({local,to_stop},?MODULE, [], []),
344    ok = gen_fsm:stop({to_stop,node()}),
345    false = erlang:is_process_alive(Pid),
346    {'EXIT',noproc} = (catch gen_fsm:stop({to_stop,node()})),
347    ok.
348
349%% Globally registered name
350stop6(_Config) ->
351    {ok, Pid} = gen_fsm:start({global, to_stop}, ?MODULE, [], []),
352    ok = gen_fsm:stop({global,to_stop}),
353    false = erlang:is_process_alive(Pid),
354    {'EXIT',noproc} = (catch gen_fsm:stop({global,to_stop})),
355    ok.
356
357%% 'via' registered name
358stop7(_Config) ->
359    dummy_via:reset(),
360    {ok, Pid} = gen_fsm:start({via, dummy_via, to_stop},
361			      ?MODULE, [], []),
362    ok = gen_fsm:stop({via, dummy_via, to_stop}),
363    false = erlang:is_process_alive(Pid),
364    {'EXIT',noproc} = (catch gen_fsm:stop({via, dummy_via, to_stop})),
365    ok.
366
367%% Anonymous on remote node
368stop8(_Config) ->
369    {ok,Node} = test_server:start_node(gen_fsm_SUITE_stop8,slave,[]),
370    Dir = filename:dirname(code:which(?MODULE)),
371    rpc:call(Node,code,add_path,[Dir]),
372    {ok, Pid} = rpc:call(Node,gen_fsm,start,[?MODULE,[],[]]),
373    ok = gen_fsm:stop(Pid),
374    false = rpc:call(Node,erlang,is_process_alive,[Pid]),
375    {'EXIT',noproc} = (catch gen_fsm:stop(Pid)),
376    true = test_server:stop_node(Node),
377    {'EXIT',{{nodedown,Node},_}} = (catch gen_fsm:stop(Pid)),
378    ok.
379
380%% Registered name on remote node
381stop9(_Config) ->
382    {ok,Node} = test_server:start_node(gen_fsm_SUITE_stop9,slave,[]),
383    Dir = filename:dirname(code:which(?MODULE)),
384    rpc:call(Node,code,add_path,[Dir]),
385    {ok, Pid} = rpc:call(Node,gen_fsm,start,[{local,to_stop},?MODULE,[],[]]),
386    ok = gen_fsm:stop({to_stop,Node}),
387    undefined = rpc:call(Node,erlang,whereis,[to_stop]),
388    false = rpc:call(Node,erlang,is_process_alive,[Pid]),
389    {'EXIT',noproc} = (catch gen_fsm:stop({to_stop,Node})),
390    true = test_server:stop_node(Node),
391    {'EXIT',{{nodedown,Node},_}} = (catch gen_fsm:stop({to_stop,Node})),
392    ok.
393
394%% Globally registered name on remote node
395stop10(_Config) ->
396    {ok,Node} = test_server:start_node(gen_fsm_SUITE_stop10,slave,[]),
397    Dir = filename:dirname(code:which(?MODULE)),
398    rpc:call(Node,code,add_path,[Dir]),
399    {ok, Pid} = rpc:call(Node,gen_fsm,start,[{global,to_stop},?MODULE,[],[]]),
400    ok = global:sync(),
401    ok = gen_fsm:stop({global,to_stop}),
402    false = rpc:call(Node,erlang,is_process_alive,[Pid]),
403    {'EXIT',noproc} = (catch gen_fsm:stop({global,to_stop})),
404    true = test_server:stop_node(Node),
405    {'EXIT',noproc} = (catch gen_fsm:stop({global,to_stop})),
406    ok.
407
408%% Check that time outs in calls work
409abnormal1(Config) when is_list(Config) ->
410    {ok, _Pid} = gen_fsm:start({local, my_fsm}, gen_fsm_SUITE, [], []),
411
412    %% timeout call.
413    delayed = gen_fsm:sync_send_event(my_fsm, {delayed_answer,1}, 100),
414    {'EXIT',{timeout,_}} =
415	(catch gen_fsm:sync_send_event(my_fsm, {delayed_answer,10}, 1)),
416
417    [] = get_messages(),
418    ok.
419
420%% Check that bad return values makes the fsm crash. Note that we must
421%% trap exit since we must link to get the real bad_return_ error
422abnormal2(Config) when is_list(Config) ->
423    OldFl = process_flag(trap_exit, true),
424    {ok, Pid} =
425	gen_fsm:start_link(gen_fsm_SUITE, [], []),
426
427    %% bad return value in the gen_fsm loop
428    {'EXIT',{{bad_return_value, badreturn},_}} =
429	(catch gen_fsm:sync_send_event(Pid, badreturn)),
430
431    [{'EXIT',Pid,{bad_return_value,badreturn}}] = get_messages(),
432    process_flag(trap_exit, OldFl),
433    ok.
434
435shutdown(Config) when is_list(Config) ->
436    error_logger_forwarder:register(),
437
438    process_flag(trap_exit, true),
439
440    {ok,Pid0} = gen_fsm:start_link(gen_fsm_SUITE, [], []),
441    ok = do_func_test(Pid0),
442    ok = do_sync_func_test(Pid0),
443    {shutdown,reason} =
444	gen_fsm:sync_send_all_state_event(Pid0, stop_shutdown_reason),
445    receive {'EXIT',Pid0,{shutdown,reason}} -> ok end,
446    process_flag(trap_exit, false),
447
448    {'EXIT', {noproc,_}} =
449	(catch gen_fsm:sync_send_event(Pid0, hej)),
450
451    receive
452	Any ->
453	    io:format("Unexpected: ~p", [Any]),
454	    ct:fail(failed)
455    after 500 ->
456	    ok
457    end,
458
459    ok.
460
461
462
463sys1(Config) when is_list(Config) ->
464    {ok, Pid} =
465	gen_fsm:start(gen_fsm_SUITE, [], []),
466    {status, Pid, {module,gen_fsm}, _} = sys:get_status(Pid),
467    sys:suspend(Pid),
468    {'EXIT', {timeout,_}} =
469	(catch gen_fsm:sync_send_event(Pid, hej)),
470    sys:resume(Pid),
471    stop_it(Pid).
472
473call_format_status(Config) when is_list(Config) ->
474    {ok, Pid} = gen_fsm:start(gen_fsm_SUITE, [], []),
475    Status = sys:get_status(Pid),
476    {status, Pid, Mod, [_PDict, running, _, _, Data]} = Status,
477    [format_status_called | _] = lists:reverse(Data),
478    stop_it(Pid),
479
480    %% check that format_status can handle a name being an atom (pid is
481    %% already checked by the previous test)
482    {ok, Pid2} = gen_fsm:start({local, gfsm}, gen_fsm_SUITE, [], []),
483    Status2 = sys:get_status(gfsm),
484    {status, Pid2, Mod, [_PDict2, running, _, _, Data2]} = Status2,
485    [format_status_called | _] = lists:reverse(Data2),
486    stop_it(Pid2),
487
488    %% check that format_status can handle a name being a term other than a
489    %% pid or atom
490    GlobalName1 = {global, "CallFormatStatus"},
491    {ok, Pid3} = gen_fsm:start(GlobalName1, gen_fsm_SUITE, [], []),
492    Status3 = sys:get_status(GlobalName1),
493    {status, Pid3, Mod, [_PDict3, running, _, _, Data3]} = Status3,
494    [format_status_called | _] = lists:reverse(Data3),
495    stop_it(Pid3),
496    GlobalName2 = {global, {name, "term"}},
497    {ok, Pid4} = gen_fsm:start(GlobalName2, gen_fsm_SUITE, [], []),
498    Status4 = sys:get_status(GlobalName2),
499    {status, Pid4, Mod, [_PDict4, running, _, _, Data4]} = Status4,
500    [format_status_called | _] = lists:reverse(Data4),
501    stop_it(Pid4),
502
503    %% check that format_status can handle a name being a term other than a
504    %% pid or atom
505    dummy_via:reset(),
506    ViaName1 = {via, dummy_via, "CallFormatStatus"},
507    {ok, Pid5} = gen_fsm:start(ViaName1, gen_fsm_SUITE, [], []),
508    Status5 = sys:get_status(ViaName1),
509    {status, Pid5, Mod, [_PDict5, running, _, _, Data5]} = Status5,
510    [format_status_called | _] = lists:reverse(Data5),
511    stop_it(Pid5),
512    ViaName2 = {via, dummy_via, {name, "term"}},
513    {ok, Pid6} = gen_fsm:start(ViaName2, gen_fsm_SUITE, [], []),
514    Status6 = sys:get_status(ViaName2),
515    {status, Pid6, Mod, [_PDict6, running, _, _, Data6]} = Status6,
516    [format_status_called | _] = lists:reverse(Data6),
517    stop_it(Pid6).
518
519
520
521error_format_status(Config) when is_list(Config) ->
522    error_logger_forwarder:register(),
523    OldFl = process_flag(trap_exit, true),
524    StateData = "called format_status",
525    Parent = self(),
526    {ok, Pid} = gen_fsm:start(gen_fsm_SUITE, {state_data, StateData}, []),
527    %% bad return value in the gen_fsm loop
528    {'EXIT',{{bad_return_value, badreturn},_}} =
529	(catch gen_fsm:sync_send_event(Pid, badreturn)),
530    receive
531	{error,_GroupLeader,{Pid,
532			     "** State machine "++_,
533			     [Pid,badreturn,Parent,idle,{formatted,StateData},
534                              {bad_return_value,badreturn}|_]}} ->
535	    ok;
536	Other ->
537	    io:format("Unexpected: ~p", [Other]),
538	    ct:fail(failed)
539    end,
540    process_flag(trap_exit, OldFl),
541    ok.
542
543terminate_crash_format(Config) when is_list(Config) ->
544    error_logger_forwarder:register(),
545    OldFl = process_flag(trap_exit, true),
546    StateData = crash_terminate,
547    Parent = self(),
548    {ok, Pid} = gen_fsm:start(gen_fsm_SUITE, {state_data, StateData}, []),
549    stop_it(Pid),
550    receive
551	{error,_GroupLeader,{Pid,
552			     "** State machine "++_,
553			     [Pid,stop,Parent,idle,{formatted, StateData},
554                              {crash,terminate}|_]}} ->
555	    ok;
556	Other ->
557	    io:format("Unexpected: ~p", [Other]),
558	    ct:fail(failed)
559    after 5000 ->
560	    io:format("Timeout: expected error logger msg", []),
561	    ct:fail(failed)
562    end,
563    process_flag(trap_exit, OldFl),
564    ok.
565
566
567get_state(Config) when is_list(Config) ->
568    State = self(),
569    {ok, Pid} = gen_fsm:start(?MODULE, {state_data, State}, []),
570    {idle, State} = sys:get_state(Pid),
571    {idle, State} = sys:get_state(Pid, 5000),
572    stop_it(Pid),
573
574    %% check that get_state can handle a name being an atom (pid is
575    %% already checked by the previous test)
576    {ok, Pid2} = gen_fsm:start({local, gfsm}, gen_fsm_SUITE, {state_data, State}, []),
577    {idle, State} = sys:get_state(gfsm),
578    {idle, State} = sys:get_state(gfsm, 5000),
579    stop_it(Pid2),
580
581    %% check that get_state works when pid is sys suspended
582    {ok, Pid3} = gen_fsm:start(gen_fsm_SUITE, {state_data, State}, []),
583    {idle, State} = sys:get_state(Pid3),
584    ok = sys:suspend(Pid3),
585    {idle, State} = sys:get_state(Pid3, 5000),
586    ok = sys:resume(Pid3),
587    stop_it(Pid3),
588    ok.
589
590replace_state(Config) when is_list(Config) ->
591    State = self(),
592    {ok, Pid} = gen_fsm:start(?MODULE, {state_data, State}, []),
593    {idle, State} = sys:get_state(Pid),
594    NState1 = "replaced",
595    Replace1 = fun({StateName, _}) -> {StateName, NState1} end,
596    {idle, NState1} = sys:replace_state(Pid, Replace1),
597    {idle, NState1} = sys:get_state(Pid),
598    NState2 = "replaced again",
599    Replace2 = fun({idle, _}) -> {state0, NState2} end,
600    {state0, NState2} = sys:replace_state(Pid, Replace2, 5000),
601    {state0, NState2} = sys:get_state(Pid),
602    %% verify no change in state if replace function crashes
603    Replace3 = fun(_) -> error(fail) end,
604    {'EXIT',{{callback_failed,
605	      {gen_fsm,system_replace_state},{error,fail}},_}} =
606	(catch sys:replace_state(Pid, Replace3)),
607    {state0, NState2} = sys:get_state(Pid),
608    %% verify state replaced if process sys suspended
609    ok = sys:suspend(Pid),
610    Suffix2 = " and again",
611    NState3 = NState2 ++ Suffix2,
612    Replace4 = fun({StateName, _}) -> {StateName, NState3} end,
613    {state0, NState3} = sys:replace_state(Pid, Replace4),
614    ok = sys:resume(Pid),
615    {state0, NState3} = sys:get_state(Pid, 5000),
616    stop_it(Pid),
617    ok.
618
619%% Hibernation
620hibernate(Config) when is_list(Config) ->
621    OldFl = process_flag(trap_exit, true),
622
623    {ok, Pid0} = gen_fsm:start_link(?MODULE, hiber_now, []),
624    is_in_erlang_hibernate(Pid0),
625    stop_it(Pid0),
626    receive
627	{'EXIT',Pid0,normal} -> ok
628    end,
629
630    {ok, Pid} = gen_fsm:start_link(?MODULE, hiber, []),
631    true = ({current_function,{erlang,hibernate,3}} =/=
632		erlang:process_info(Pid,current_function)),
633    hibernating = gen_fsm:sync_send_event(Pid, hibernate_sync),
634    is_in_erlang_hibernate(Pid),
635    good_morning = gen_fsm:sync_send_event(Pid, wakeup_sync),
636    is_not_in_erlang_hibernate(Pid),
637    hibernating = gen_fsm:sync_send_event(Pid, hibernate_sync),
638    is_in_erlang_hibernate(Pid),
639    five_more = gen_fsm:sync_send_event(Pid, snooze_sync),
640    is_in_erlang_hibernate(Pid),
641    good_morning = gen_fsm:sync_send_event(Pid, wakeup_sync),
642    is_not_in_erlang_hibernate(Pid),
643    ok = gen_fsm:send_event(Pid, hibernate_async),
644    is_in_erlang_hibernate(Pid),
645    ok = gen_fsm:send_event(Pid, wakeup_async),
646    is_not_in_erlang_hibernate(Pid),
647    ok = gen_fsm:send_event(Pid, hibernate_async),
648    is_in_erlang_hibernate(Pid),
649    ok = gen_fsm:send_event(Pid, snooze_async),
650    is_in_erlang_hibernate(Pid),
651    ok = gen_fsm:send_event(Pid, wakeup_async),
652    is_not_in_erlang_hibernate(Pid),
653
654    Pid ! hibernate_later,
655    true = ({current_function,{erlang,hibernate,3}} =/=
656		erlang:process_info(Pid, current_function)),
657    is_in_erlang_hibernate(Pid),
658
659    'alive!' = gen_fsm:sync_send_event(Pid,'alive?'),
660    true = ({current_function,{erlang,hibernate,3}} =/=
661		erlang:process_info(Pid, current_function)),
662    Pid ! hibernate_now,
663    is_in_erlang_hibernate(Pid),
664
665    'alive!' = gen_fsm:sync_send_event(Pid,'alive?'),
666    true = ({current_function,{erlang,hibernate,3}} =/=
667		erlang:process_info(Pid, current_function)),
668
669    hibernating = gen_fsm:sync_send_all_state_event(Pid, hibernate_sync),
670    is_in_erlang_hibernate(Pid),
671    good_morning = gen_fsm:sync_send_all_state_event(Pid, wakeup_sync),
672    is_not_in_erlang_hibernate(Pid),
673    hibernating = gen_fsm:sync_send_all_state_event(Pid, hibernate_sync),
674    is_in_erlang_hibernate(Pid),
675    five_more = gen_fsm:sync_send_all_state_event(Pid, snooze_sync),
676    is_in_erlang_hibernate(Pid),
677    good_morning = gen_fsm:sync_send_all_state_event(Pid, wakeup_sync),
678    is_not_in_erlang_hibernate(Pid),
679    ok = gen_fsm:send_all_state_event(Pid, hibernate_async),
680    is_in_erlang_hibernate(Pid),
681    ok  = gen_fsm:send_all_state_event(Pid, wakeup_async),
682    is_not_in_erlang_hibernate(Pid),
683    ok = gen_fsm:send_all_state_event(Pid, hibernate_async),
684    is_in_erlang_hibernate(Pid),
685    ok = gen_fsm:send_all_state_event(Pid, snooze_async),
686    is_in_erlang_hibernate(Pid),
687    ok = gen_fsm:send_all_state_event(Pid, wakeup_async),
688    is_not_in_erlang_hibernate(Pid),
689
690    hibernating = gen_fsm:sync_send_all_state_event(Pid, hibernate_sync),
691    is_in_erlang_hibernate(Pid),
692    sys:suspend(Pid),
693    is_in_erlang_hibernate(Pid),
694    sys:resume(Pid),
695    is_in_erlang_hibernate(Pid),
696    receive after 1000 -> ok end,
697    is_in_erlang_hibernate(Pid),
698
699    good_morning  = gen_fsm:sync_send_all_state_event(Pid, wakeup_sync),
700    is_not_in_erlang_hibernate(Pid),
701    stop_it(Pid),
702    receive
703	{'EXIT',Pid,normal} -> ok
704    end,
705
706    [] = get_messages(),
707    process_flag(trap_exit, OldFl),
708    ok.
709
710%% Auto hibernation
711auto_hibernate(Config) when is_list(Config) ->
712    OldFl = process_flag(trap_exit, true),
713    HibernateAfterTimeout = 100,
714    State = {auto_hibernate_state},
715    {ok, Pid} = gen_fsm:start_link({local, my_test_name_auto_hibernate}, ?MODULE, {state_data, State}, [{hibernate_after, HibernateAfterTimeout}]),
716    %% After init test
717    is_not_in_erlang_hibernate(Pid),
718    timer:sleep(HibernateAfterTimeout),
719    is_in_erlang_hibernate(Pid),
720    %% Get state test
721    {_, State} = sys:get_state(my_test_name_auto_hibernate),
722    is_in_erlang_hibernate(Pid),
723    %% Sync send event test
724    'alive!' = gen_fsm:sync_send_event(Pid,'alive?'),
725    is_not_in_erlang_hibernate(Pid),
726    timer:sleep(HibernateAfterTimeout),
727    is_in_erlang_hibernate(Pid),
728    %% Send event test
729    ok = gen_fsm:send_all_state_event(Pid,{'alive?', self()}),
730    wfor(yes),
731    is_not_in_erlang_hibernate(Pid),
732    timer:sleep(HibernateAfterTimeout),
733    is_in_erlang_hibernate(Pid),
734    %% Info test
735    Pid ! {self(), handle_info},
736    wfor({Pid, handled_info}),
737    is_not_in_erlang_hibernate(Pid),
738    timer:sleep(HibernateAfterTimeout),
739    is_in_erlang_hibernate(Pid),
740    stop_it(Pid),
741    receive
742        {'EXIT',Pid,normal} -> ok
743    end,
744    process_flag(trap_exit, OldFl),
745    ok.
746
747is_in_erlang_hibernate(Pid) ->
748    receive after 1 -> ok end,
749    is_in_erlang_hibernate_1(200, Pid).
750
751is_in_erlang_hibernate_1(0, Pid) ->
752    io:format("~p\n", [erlang:process_info(Pid, current_function)]),
753    ct:fail(not_in_erlang_hibernate_3);
754is_in_erlang_hibernate_1(N, Pid) ->
755    {current_function,MFA} = erlang:process_info(Pid, current_function),
756    case MFA of
757	{erlang,hibernate,3} ->
758	    ok;
759	_ ->
760	    receive after 10 -> ok end,
761	    is_in_erlang_hibernate_1(N-1, Pid)
762    end.
763
764is_not_in_erlang_hibernate(Pid) ->
765    receive after 1 -> ok end,
766    is_not_in_erlang_hibernate_1(200, Pid).
767
768is_not_in_erlang_hibernate_1(0, Pid) ->
769    io:format("~p\n", [erlang:process_info(Pid, current_function)]),
770    ct:fail(not_in_erlang_hibernate_3);
771is_not_in_erlang_hibernate_1(N, Pid) ->
772    {current_function,MFA} = erlang:process_info(Pid, current_function),
773    case MFA of
774	{erlang,hibernate,3} ->
775	    receive after 10 -> ok end,
776	    is_not_in_erlang_hibernate_1(N-1, Pid);
777	_ ->
778	    ok
779    end.
780
781%% Test gen_fsm:enter_loop/4,5,6.
782enter_loop(Config) when is_list(Config) ->
783    OldFlag = process_flag(trap_exit, true),
784
785    dummy_via:reset(),
786
787    %% Locally registered process + {local, Name}
788    {ok, Pid1a} =
789	proc_lib:start_link(?MODULE, enter_loop, [local, local]),
790    yes = gen_fsm:sync_send_event(Pid1a, 'alive?'),
791    stopped = gen_fsm:sync_send_event(Pid1a, stop),
792    receive
793	{'EXIT', Pid1a, normal} ->
794	    ok
795    after 5000 ->
796	    ct:fail(gen_fsm_did_not_die)
797    end,
798
799    %% Unregistered process + {local, Name}
800    {ok, Pid1b} =
801	proc_lib:start_link(?MODULE, enter_loop, [anon, local]),
802    receive
803	{'EXIT', Pid1b, process_not_registered} ->
804	    ok
805    after 5000 ->
806	    ct:fail(gen_fsm_did_not_die)
807    end,
808
809    %% Globally registered process + {global, Name}
810    {ok, Pid2a} =
811	proc_lib:start_link(?MODULE, enter_loop, [global, global]),
812    yes = gen_fsm:sync_send_event(Pid2a, 'alive?'),
813    stopped = gen_fsm:sync_send_event(Pid2a, stop),
814    receive
815	{'EXIT', Pid2a, normal} ->
816	    ok
817    after 5000 ->
818	    ct:fail(gen_fsm_did_not_die)
819    end,
820
821    %% Unregistered process + {global, Name}
822    {ok, Pid2b} =
823	proc_lib:start_link(?MODULE, enter_loop, [anon, global]),
824    receive
825	{'EXIT', Pid2b, process_not_registered_globally} ->
826	    ok
827    after 5000 ->
828	    ct:fail(gen_fsm_did_not_die)
829    end,
830
831    %% Unregistered process + no name
832    {ok, Pid3} =
833	proc_lib:start_link(?MODULE, enter_loop, [anon, anon]),
834    yes = gen_fsm:sync_send_event(Pid3, 'alive?'),
835    stopped = gen_fsm:sync_send_event(Pid3, stop),
836    receive
837	{'EXIT', Pid3, normal} ->
838	    ok
839    after 5000 ->
840	    ct:fail(gen_fsm_did_not_die)
841    end,
842
843    %% Process not started using proc_lib
844    Pid4 =
845	spawn_link(gen_fsm, enter_loop, [?MODULE, [], state0, []]),
846    receive
847	{'EXIT', Pid4, process_was_not_started_by_proc_lib} ->
848	    ok
849    after 5000 ->
850	    ct:fail(gen_fsm_did_not_die)
851    end,
852
853    %% Make sure I am the parent, ie that ordering a shutdown will
854    %% result in the process terminating with Reason==shutdown
855    {ok, Pid5} =
856	proc_lib:start_link(?MODULE, enter_loop, [anon, anon]),
857    yes = gen_fsm:sync_send_event(Pid5, 'alive?'),
858    exit(Pid5, shutdown),
859    receive
860	{'EXIT', Pid5, shutdown} ->
861	    ok
862    after 5000 ->
863	    ct:fail(gen_fsm_did_not_die)
864    end,
865
866    %% Make sure gen_fsm:enter_loop does not accept {local,Name}
867    %% when it's another process than the calling one which is
868    %% registered under that name
869    register(armitage, self()),
870    {ok, Pid6a} =
871	proc_lib:start_link(?MODULE, enter_loop, [anon, local]),
872    receive
873	{'EXIT', Pid6a, process_not_registered} ->
874	    ok
875    after 1000 ->
876	    ct:fail(gen_fsm_started)
877    end,
878    unregister(armitage),
879
880    %% Make sure gen_fsm:enter_loop does not accept {global,Name}
881    %% when it's another process than the calling one which is
882    %% registered under that name
883    global:register_name(armitage, self()),
884    {ok, Pid6b} =
885	proc_lib:start_link(?MODULE, enter_loop, [anon, global]),
886    receive
887	{'EXIT', Pid6b, process_not_registered_globally} ->
888	    ok
889    after 1000 ->
890	    ct:fail(gen_fsm_started)
891    end,
892    global:unregister_name(armitage),
893
894    dummy_via:register_name(armitage, self()),
895    {ok, Pid6c} =
896	proc_lib:start_link(?MODULE, enter_loop, [anon, via]),
897    receive
898	{'EXIT', Pid6c, {process_not_registered_via, dummy_via}} ->
899	    ok
900    after 1000 ->
901	    ct:fail({gen_fsm_started, process_info(self(), messages)})
902    end,
903    dummy_via:unregister_name(armitage),
904
905    process_flag(trap_exit, OldFlag),
906    ok.
907
908enter_loop(Reg1, Reg2) ->
909    process_flag(trap_exit, true),
910    case Reg1 of
911	local -> register(armitage, self());
912	global -> global:register_name(armitage, self());
913	via -> dummy_via:register_name(armitage, self());
914	anon -> ignore
915    end,
916    proc_lib:init_ack({ok, self()}),
917    case Reg2 of
918	local ->
919	    gen_fsm:enter_loop(?MODULE, [], state0, [], {local,armitage});
920	global ->
921	    gen_fsm:enter_loop(?MODULE, [], state0, [], {global,armitage});
922	via ->
923	    gen_fsm:enter_loop(?MODULE, [], state0, [],
924			       {via, dummy_via, armitage});
925	anon ->
926	    gen_fsm:enter_loop(?MODULE, [], state0, [])
927    end.
928
929%% Start should return an undef error if init isn't implemented
930undef_init(Config) when is_list(Config) ->
931    {error, {undef, [{oc_init_fsm, init, [[]], []}|_]}}
932        =  gen_fsm:start(oc_init_fsm, [], []),
933    ok.
934
935%% Test that the server crashes correctly if the handle_event callback is
936%% not exported in the callback module
937undef_handle_event(Config) when is_list(Config) ->
938    {ok, FSM} = gen_fsm:start(oc_fsm, [], []),
939    MRef = monitor(process, FSM),
940    gen_fsm:send_all_state_event(FSM, state_name),
941    ok = verify_undef_down(MRef, FSM, oc_fsm, handle_event).
942
943%% Test that the server crashes correctly if the handle_sync_event callback is
944%% not exported in the callback module
945undef_handle_sync_event(Config) when is_list(Config) ->
946    {ok, FSM} = gen_fsm:start(oc_fsm, [], []),
947    try
948        gen_fsm:sync_send_all_state_event(FSM, state_name),
949        ct:fail(should_crash)
950    catch exit:{{undef, [{oc_fsm, handle_sync_event, _, _}|_]},_} ->
951        ok
952    end.
953
954%% The fsm should log but not crash if the handle_info callback is
955%% calling an undefined function
956undef_handle_info(Config) when is_list(Config) ->
957    error_logger_forwarder:register(),
958    {ok, FSM} = gen_fsm:start(oc_fsm, [], []),
959    MRef = monitor(process, FSM),
960    FSM ! hej,
961    receive
962        {'DOWN', MRef, process, FSM, _} ->
963            ct:fail(should_not_crash)
964    after 500 ->
965        ok
966    end,
967    receive
968        {warning_msg, _GroupLeader,
969         {FSM, "** Undefined handle_info in " ++ _, [oc_fsm, hej]}} ->
970            ok;
971        Other ->
972            io:format("Unexpected: ~p", [Other]),
973            ct:fail(failed)
974    end.
975
976%% The upgrade should fail if code_change is expected in the callback module
977%% but not exported, but the fsm should continue with the old code
978undef_code_change(Config) when is_list(Config) ->
979    {ok, FSM} = gen_fsm:start(oc_fsm, [], []),
980    {error, {'EXIT', {undef, [{oc_fsm, code_change, [_, _, _, _], _}|_]}}}
981        = fake_upgrade(FSM, oc_fsm),
982    ok.
983
984%% Test the default implementation of terminate with normal reason if the
985%% callback module does not export it
986undef_terminate1(Config) when is_list(Config) ->
987    {ok, FSM} = gen_fsm:start(oc_fsm, [], []),
988    MRef = monitor(process, FSM),
989    ok = gen_fsm:stop(FSM),
990    ok = verify_down_reason(MRef, FSM, normal).
991
992%% Test the default implementation of terminate with error reason if the
993%% callback module does not export it
994undef_terminate2(Config) when is_list(Config) ->
995    {ok, FSM} = gen_fsm:start(oc_fsm, [], []),
996    MRef = monitor(process, FSM),
997    ok = gen_fsm:stop(FSM, {error, test}, infinity),
998    ok = verify_down_reason(MRef, FSM, {error, test}).
999
1000%% Test that the server crashes correctly if the handle_info callback is
1001%% calling an undefined function
1002undef_in_handle_info(Config) when is_list(Config) ->
1003    {ok, FSM} = gen_fsm:start(?MODULE, [], []),
1004    MRef = monitor(process, FSM),
1005    FSM ! {call_undef_fun, {?MODULE, handle_info}},
1006    verify_undef_down(MRef, FSM, ?MODULE, handle_info),
1007    ok.
1008
1009%% Test that the server crashes correctly if the terminate callback is
1010%% calling an undefined function
1011undef_in_terminate(Config) when is_list(Config) ->
1012    State = {undef_in_terminate, {?MODULE, terminate}},
1013    {ok, FSM} = gen_fsm:start(?MODULE, {state_data, State}, []),
1014    try
1015        ok = gen_fsm:stop(FSM),
1016        ct:fail(failed)
1017    catch
1018        exit:{undef, [{?MODULE, terminate, _, _}|_]} ->
1019            ok
1020    end.
1021
1022%% Test report callback for Logger handler error_logger
1023format_log_1(_Config) ->
1024    FD = application:get_env(kernel, error_logger_format_depth),
1025    application:unset_env(kernel, error_logger_format_depth),
1026    Term = lists:seq(1, 15),
1027    Name = self(),
1028    Report = #{label=>{gen_fsm,terminate},
1029               name=>Name,
1030               last_message=>Term,
1031               state_name=>Name,
1032               state_data=>Term,
1033               log=>[Term],
1034               reason=>Term,
1035               client_info=>{self(),{clientname,[]}}},
1036    {F1,A1} = gen_fsm:format_log(Report),
1037    FExpected1 = "** State machine ~tp terminating \n"
1038        "** Last message in was ~tp~n"
1039        "** When State == ~tp~n"
1040        "**      Data  == ~tp~n"
1041        "** Reason for termination ==~n** ~tp~n"
1042        "** Log ==~n**~tp~n"
1043        "** Client ~tp stacktrace~n** ~tp~n",
1044    ct:log("F1: ~ts~nA1: ~tp", [F1,A1]),
1045    FExpected1=F1,
1046
1047    [Name,Term,Name,Term,Term,[Term],clientname,[]] = A1,
1048
1049    Warning = #{label=>{gen_fsm,no_handle_info},
1050                module=>?MODULE,
1051                message=>Term},
1052    {WF1,WA1} = gen_fsm:format_log(Warning),
1053    WFExpected1 = "** Undefined handle_info in ~p~n"
1054        "** Unhandled message: ~tp~n",
1055    ct:log("WF1: ~ts~nWA1: ~tp", [WF1,WA1]),
1056    WFExpected1=WF1,
1057    [?MODULE,Term] = WA1,
1058
1059    Depth = 10,
1060    ok = application:set_env(kernel, error_logger_format_depth, Depth),
1061    Limited = [1,2,3,4,5,6,7,8,9,'...'],
1062    {F2,A2} = gen_fsm:format_log(#{label=>{gen_fsm,terminate},
1063                                   name=>Name,
1064                                   last_message=>Term,
1065                                   state_name=>Name,
1066                                   state_data=>Term,
1067                                   log=>[Term],
1068                                   reason=>Term,
1069                                   client_info=>{self(),{clientname,[]}}}),
1070    FExpected2 =  "** State machine ~tP terminating \n"
1071        "** Last message in was ~tP~n"
1072        "** When State == ~tP~n"
1073        "**      Data  == ~tP~n"
1074        "** Reason for termination ==~n** ~tP~n"
1075        "** Log ==~n**~tP~n"
1076        "** Client ~tP stacktrace~n** ~tP~n",
1077    ct:log("F2: ~ts~nA2: ~tp", [F2,A2]),
1078    FExpected2=F2,
1079
1080    [Name,Depth,Limited,Depth,Name,Depth,Limited,Depth,Limited,
1081     Depth,[Limited],Depth,clientname,Depth,[],Depth] = A2,
1082
1083    {WF2,WA2} = gen_fsm:format_log(Warning),
1084    WFExpected2 = "** Undefined handle_info in ~p~n"
1085        "** Unhandled message: ~tP~n",
1086    ct:log("WF2: ~ts~nWA2: ~tp", [WF2,WA2]),
1087    WFExpected2=WF2,
1088    [?MODULE,Limited,Depth] = WA2,
1089
1090    case FD of
1091        undefined ->
1092            application:unset_env(kernel, error_logger_format_depth);
1093        _ ->
1094            application:set_env(kernel, error_logger_format_depth, FD)
1095    end,
1096    ok.
1097
1098%% Test report callback for any Logger handler
1099format_log_2(_Config) ->
1100    Term = lists:seq(1, 15),
1101    Name = self(),
1102    NameStr = pid_to_list(Name),
1103    Report = #{label=>{gen_fsm,terminate},
1104               name=>Name,
1105               last_message=>Term,
1106               state_name=>Name,
1107               state_data=>Term,
1108               log=>[Term],
1109               reason=>Term,
1110               client_info=>{self(),{clientname,[]}}},
1111    FormatOpts1 = #{},
1112    Str1 = flatten_format_log(Report, FormatOpts1),
1113    L1 = length(Str1),
1114    Expected1 = "** State machine "++NameStr++" terminating \n"
1115        "** Last message in was [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]\n"
1116        "** When State == "++NameStr++"\n"
1117        "**      Data  == [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]\n"
1118        "** Reason for termination ==\n"
1119        "** [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]\n"
1120        "** Log ==\n"
1121        "**[[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]]\n"
1122        "** Client clientname stacktrace\n"
1123        "** []\n",
1124    ct:log("Str1: ~ts", [Str1]),
1125    ct:log("length(Str1): ~p", [L1]),
1126    true = Expected1 =:= Str1,
1127
1128    Warning = #{label=>{gen_fsm,no_handle_info},
1129                module=>?MODULE,
1130                message=>Term},
1131    WStr1 = flatten_format_log(Warning, FormatOpts1),
1132    WL1 = length(WStr1),
1133    WExpected1 = "** Undefined handle_info in gen_fsm_SUITE\n"
1134        "** Unhandled message: [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]\n",
1135    ct:log("WStr1: ~ts", [WStr1]),
1136    ct:log("length(WStr1): ~p", [WL1]),
1137    true = WExpected1 =:= WStr1,
1138
1139    Depth = 10,
1140    FormatOpts2 = #{depth=>Depth},
1141    Str2 = flatten_format_log(Report, FormatOpts2),
1142    L2 = length(Str2),
1143    Expected2 = "** State machine "++NameStr++" terminating \n"
1144        "** Last message in was [1,2,3,4,5,6,7,8,9|...]\n"
1145        "** When State == "++NameStr++"\n"
1146        "**      Data  == [1,2,3,4,5,6,7,8,9|...]\n"
1147        "** Reason for termination ==\n"
1148        "** [1,2,3,4,5,6,7,8,9|...]\n"
1149        "** Log ==\n"
1150        "**[[1,2,3,4,5,6,7,8|...]]\n"
1151        "** Client clientname stacktrace\n"
1152        "** []\n",
1153    ct:log("Str2: ~ts", [Str2]),
1154    ct:log("length(Str2): ~p", [L2]),
1155    true = Expected2 =:= Str2,
1156
1157    WStr2 = flatten_format_log(Warning, FormatOpts2),
1158    WL2 = length(WStr2),
1159    WExpected2 = "** Undefined handle_info in gen_fsm_SUITE\n"
1160        "** Unhandled message: [1,2,3,4,5,6,7,8,9|...]\n",
1161    ct:log("WStr2: ~ts", [WStr2]),
1162    ct:log("length(WStr2): ~p", [WL2]),
1163    true = WExpected2 =:= WStr2,
1164
1165    FormatOpts3 = #{chars_limit=>200},
1166    Str3 = flatten_format_log(Report, FormatOpts3),
1167    L3 = length(Str3),
1168    Expected3 = "** State machine "++NameStr++" terminating \n"
1169        "** Last ",
1170    ct:log("Str3: ~ts", [Str3]),
1171    ct:log("length(Str3): ~p", [L3]),
1172    true = lists:prefix(Expected3, Str3),
1173    true = L3 < L1,
1174
1175    WFormatOpts3 = #{chars_limit=>80},
1176    WStr3 = flatten_format_log(Warning, WFormatOpts3),
1177    WL3 = length(WStr3),
1178    WExpected3 = "** Undefined handle_info in gen_fsm_SUITE",
1179    ct:log("WStr3: ~ts", [WStr3]),
1180    ct:log("length(WStr3): ~p", [WL3]),
1181    true = lists:prefix(WExpected3, WStr3),
1182    true = WL3 < WL1,
1183
1184    FormatOpts4 = #{single_line=>true},
1185    Str4 = flatten_format_log(Report, FormatOpts4),
1186    L4 = length(Str4),
1187    Expected4 = "State machine "++NameStr++" terminating. "
1188        "Reason: [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]. "
1189        "Last event: [[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]]. "
1190        "State: "++NameStr++". "
1191        "Data: [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]. "
1192        "Log: [[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]]. "
1193        "Client clientname stacktrace: [].",
1194    ct:log("Str4: ~ts", [Str4]),
1195    ct:log("length(Str4): ~p", [L4]),
1196    true = Expected4 =:= Str4,
1197
1198    WStr4 = flatten_format_log(Warning, FormatOpts4),
1199    WL4 = length(WStr4),
1200    WExpected4 = "Undefined handle_info in gen_fsm_SUITE. "
1201        "Unhandled message: [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15].",
1202    ct:log("WStr4: ~ts", [WStr4]),
1203    ct:log("length(WStr4): ~p", [WL4]),
1204    true = WExpected4 =:= WStr4,
1205
1206    FormatOpts5 = #{single_line=>true, depth=>Depth},
1207    Str5 = flatten_format_log(Report, FormatOpts5),
1208    L5 = length(Str5),
1209    Expected5 = "State machine "++NameStr++" terminating. "
1210        "Reason: [1,2,3,4,5,6,7,8,9|...]. "
1211        "Last event: [[1,2,3,4,5,6,7,8|...]]. "
1212        "State: "++NameStr++". "
1213        "Data: [1,2,3,4,5,6,7,8,9|...]. "
1214        "Log: [[1,2,3,4,5,6,7,8|...]]. "
1215        "Client clientname stacktrace: [].",
1216    ct:log("Str5: ~ts", [Str5]),
1217    ct:log("length(Str5): ~p", [L5]),
1218    true = Expected5 =:= Str5,
1219
1220    WStr5 = flatten_format_log(Warning, FormatOpts5),
1221    WL5 = length(WStr5),
1222    WExpected5 = "Undefined handle_info in gen_fsm_SUITE. "
1223        "Unhandled message: [1,2,3,4,5,6,7,8,9|...].",
1224    ct:log("WStr5: ~ts", [WStr5]),
1225    ct:log("length(WStr5): ~p", [WL5]),
1226    true = WExpected5 =:= WStr5,
1227
1228    FormatOpts6 = #{single_line=>true, chars_limit=>200},
1229    Str6 = flatten_format_log(Report, FormatOpts6),
1230    L6 = length(Str6),
1231    Expected6 = "State machine "++NameStr++" terminating. Reason: ",
1232    ct:log("Str6: ~ts", [Str6]),
1233    ct:log("length(Str6): ~p", [L6]),
1234    true = lists:prefix(Expected6, Str6),
1235    true = L6 < L4,
1236
1237    WFormatOpts6 = #{single_line=>true, chars_limit=>80},
1238    WStr6 = flatten_format_log(Warning, WFormatOpts6),
1239    WL6 = length(WStr6),
1240    WExpected6 = "Undefined handle_info in gen_fsm_SUITE. "
1241        "Unhandled message: ",
1242    ct:log("WStr6: ~ts", [WStr6]),
1243    ct:log("length(WStr6): ~p", [WL6]),
1244    true = lists:prefix(WExpected6, WStr6),
1245    true = WL6 < WL4,
1246
1247    ok.
1248
1249flatten_format_log(Report, Format) ->
1250    lists:flatten(gen_fsm:format_log(Report, Format)).
1251
1252reply_by_alias_with_payload(Config) when is_list(Config) ->
1253    %% "Payload" version of tag not used yet, but make sure
1254    %% gen_server:reply/2 works with it...
1255    %%
1256    %% Whitebox...
1257    Reply = make_ref(),
1258    Alias = alias(),
1259    Tag = [[alias|Alias], "payload"],
1260    spawn_link(fun () ->
1261                       gen_fsm:reply({undefined, Tag},
1262                                     Reply)
1263               end),
1264    receive
1265        {[[alias|Alias]|_] = Tag, Reply} ->
1266            ok
1267    end.
1268
1269%%
1270%% Functionality check
1271%%
1272
1273wfor(Msg) ->
1274    receive
1275	Msg -> ok
1276    after 5000 ->
1277	    throw(timeout)
1278    end.
1279
1280
1281stop_it(FSM) ->
1282    stopped = gen_fsm:sync_send_all_state_event(FSM, stop),
1283    {'EXIT',_} = 	(catch gen_fsm:sync_send_event(FSM, hej)),
1284    ok.
1285
1286
1287
1288do_func_test(FSM) ->
1289    ok = gen_fsm:send_all_state_event(FSM, {'alive?', self()}),
1290    wfor(yes),
1291    ok = do_connect(FSM),
1292    ok = gen_fsm:send_all_state_event(FSM, {'alive?', self()}),
1293    wfor(yes),
1294    _ = [do_msg(FSM) || _ <- lists:seq(1, 3)],
1295    ok = gen_fsm:send_all_state_event(FSM, {'alive?', self()}),
1296    wfor(yes),
1297    ok = do_disconnect(FSM),
1298    ok = gen_fsm:send_all_state_event(FSM, {'alive?', self()}),
1299    wfor(yes),
1300    ok.
1301
1302
1303do_connect(FSM) ->
1304    check_state(FSM, idle),
1305    gen_fsm:send_event(FSM, {connect, self()}),
1306    wfor(accept),
1307    check_state(FSM, wfor_conf),
1308    gen_fsm:send_event(FSM, confirmation),
1309    check_state(FSM, connected),
1310    ok.
1311
1312do_msg(FSM) ->
1313    check_state(FSM, connected),
1314    R = make_ref(),
1315    ok = gen_fsm:send_event(FSM, {msg, R, self(), hej_pa_dig_quasimodo}),
1316    wfor({ak, R}).
1317
1318
1319do_disconnect(FSM) ->
1320    ok = gen_fsm:send_event(FSM, disconnect),
1321    check_state(FSM, idle).
1322
1323check_state(FSM, State) ->
1324    case gen_fsm:sync_send_all_state_event(FSM, {get, self()}) of
1325	{state, State, _} -> ok
1326    end.
1327
1328do_sync_func_test(FSM) ->
1329    yes = gen_fsm:sync_send_all_state_event(FSM, 'alive?'),
1330    ok = do_sync_connect(FSM),
1331    yes = gen_fsm:sync_send_all_state_event(FSM, 'alive?'),
1332    _ = [do_sync_msg(FSM) || _ <- lists:seq(1, 3)],
1333    yes = gen_fsm:sync_send_all_state_event(FSM, 'alive?'),
1334    ok = do_sync_disconnect(FSM),
1335    yes = gen_fsm:sync_send_all_state_event(FSM, 'alive?'),
1336    check_state(FSM, idle),
1337    ok = gen_fsm:sync_send_event(FSM, {timeout,200}),
1338    yes = gen_fsm:sync_send_all_state_event(FSM, 'alive?'),
1339    check_state(FSM, idle),
1340    ok.
1341
1342
1343do_sync_connect(FSM) ->
1344    check_state(FSM, idle),
1345    accept = gen_fsm:sync_send_event(FSM, {connect, self()}),
1346    check_state(FSM, wfor_conf),
1347    yes = gen_fsm:sync_send_event(FSM, confirmation),
1348    check_state(FSM, connected),
1349    ok.
1350
1351do_sync_msg(FSM) ->
1352    check_state(FSM, connected),
1353    R = make_ref(),
1354    Res = gen_fsm:sync_send_event(FSM, {msg, R, self(), hej_pa_dig_quasimodo}),
1355    if  Res == {ak, R} ->
1356	    ok
1357    end.
1358
1359do_sync_disconnect(FSM) ->
1360    yes = gen_fsm:sync_send_event(FSM, disconnect),
1361    check_state(FSM, idle).
1362
1363verify_down_reason(MRef, Pid, Reason) ->
1364    receive
1365        {'DOWN', MRef, process, Pid, Reason} ->
1366            ok;
1367        {'DOWN', MRef, process, Pid, Other}->
1368            ct:fail({wrong_down_reason, Other})
1369    after 5000 ->
1370        ct:fail(should_shutdown)
1371    end.
1372
1373verify_undef_down(MRef, Pid, Mod, Fun) ->
1374    ok = receive
1375        {'DOWN', MRef, process, Pid,
1376         {undef, [{Mod, Fun, _, _}|_]}} ->
1377            ok
1378    after 5000 ->
1379        ct:fail(should_crash)
1380    end.
1381
1382fake_upgrade(Pid, Mod) ->
1383    sys:suspend(Pid),
1384    sys:replace_state(Pid, fun(State) -> {new, State} end),
1385    Ret = sys:change_code(Pid, Mod, old_vsn, []),
1386    ok = sys:resume(Pid),
1387    Ret.
1388
1389%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1390%%
1391%% The Finite State Machine
1392%%
1393%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1394
1395init(ignore) ->
1396    ignore;
1397init(stop) ->
1398    {stop, stopped};
1399init(stop_shutdown) ->
1400    {stop, shutdown};
1401init(sleep) ->
1402    timer:sleep(1000),
1403    {ok, idle, data};
1404init({timeout, T}) ->
1405    {ok, idle, state, T};
1406init(hiber) ->
1407    {ok, hiber_idle, []};
1408init(hiber_now) ->
1409    {ok, hiber_idle, [], hibernate};
1410init({state_data, StateData}) ->
1411    {ok, idle, StateData};
1412init(_) ->
1413    {ok, idle, state_data}.
1414
1415terminate(_, _State, crash_terminate) ->
1416    exit({crash, terminate});
1417terminate(_, _, {undef_in_terminate, {Mod, Fun}}) ->
1418    Mod:Fun(),
1419    ok;
1420terminate({From, stopped}, State, _Data) ->
1421    From ! {self(), {stopped, State}},
1422    ok;
1423terminate(_Reason, _State, _Data) ->
1424    ok.
1425
1426
1427idle({connect, Pid}, Data) ->
1428    Pid ! accept,
1429    {next_state, wfor_conf, Data};
1430idle(badreturn, _Data) ->
1431    badreturn;
1432idle(_, Data) ->
1433    {next_state, idle, Data}.
1434
1435idle({connect, _Pid}, _From, Data) ->
1436    {reply, accept, wfor_conf, Data};
1437idle({delayed_answer, T}, _From, Data) ->
1438    timer:sleep(T),
1439    {reply, delayed, idle, Data};
1440idle(badreturn, _From, _Data) ->
1441    badreturn;
1442idle({timeout,Time}, From, _Data) ->
1443    gen_fsm:send_event_after(Time, {timeout,Time}),
1444    {next_state, timeout, From};
1445idle('alive?', _From, Data) ->
1446    {reply, 'alive!', idle, Data};
1447idle(_, _From, Data) ->
1448    {reply, 'eh?', idle, Data}.
1449
1450timeout({timeout,Time}, From) ->
1451    Ref = gen_fsm:start_timer(Time, {timeout,Time}),
1452    {next_state, timeout, {From,Ref}};
1453timeout({timeout,Ref,{timeout,Time}}, {From,Ref}) ->
1454    Ref2 = gen_fsm:start_timer(Time, ok),
1455    Cref = gen_fsm:start_timer(Time, cancel),
1456    Time4 = Time*4,
1457    receive after Time4 -> ok end,
1458    _= gen_fsm:cancel_timer(Cref),
1459    {next_state, timeout, {From,Ref2}};
1460timeout({timeout,Ref2,ok},{From,Ref2}) ->
1461    gen_fsm:reply(From, ok),
1462    {next_state, idle, state}.
1463
1464wfor_conf(confirmation, Data) ->
1465    {next_state, connected, Data};
1466wfor_conf(_, Data) ->
1467    {next_state, idle, Data}.
1468
1469wfor_conf(confirmation, _From, Data) ->
1470    {reply, yes, connected, Data};
1471wfor_conf(_, _From, Data) ->
1472    {reply, 'eh?', idle, Data}.
1473
1474connected({msg, Ref, From, _Msg}, Data) ->
1475    From ! {ak, Ref},
1476    {next_state, connected, Data};
1477connected(disconnect, Data) ->
1478    {next_state, idle, Data};
1479connected(_, Data) ->
1480    {next_state, connected, Data}.
1481
1482connected({msg, Ref, _From, _Msg}, _, Data) ->
1483    {reply, {ak, Ref}, connected, Data};
1484connected(disconnect, _From, Data) ->
1485    {reply, yes, idle, Data};
1486connected(_, _, Data) ->
1487    {reply, 'eh?', connected, Data}.
1488
1489state0('alive?', _From, Data) ->
1490    {reply, yes, state0, Data};
1491state0(stop, _From, Data) ->
1492    {stop, normal, stopped, Data}.
1493
1494hiber_idle('alive?', _From, Data) ->
1495    {reply, 'alive!', hiber_idle, Data};
1496hiber_idle(hibernate_sync, _From, Data) ->
1497    {reply, hibernating, hiber_wakeup, Data,hibernate}.
1498hiber_idle(timeout, hibernate_me) ->
1499    %% Arrive here from handle_info(hibernate_later,...)
1500    {next_state, hiber_idle, [], hibernate};
1501hiber_idle(hibernate_async, Data) ->
1502    {next_state,hiber_wakeup, Data, hibernate}.
1503
1504hiber_wakeup(wakeup_sync,_From,Data) ->
1505    {reply,good_morning,hiber_idle,Data};
1506hiber_wakeup(snooze_sync,_From,Data) ->
1507    {reply,five_more,hiber_wakeup,Data,hibernate}.
1508hiber_wakeup(wakeup_async,Data) ->
1509    {next_state,hiber_idle,Data};
1510hiber_wakeup(snooze_async,Data) ->
1511    {next_state,hiber_wakeup,Data,hibernate}.
1512
1513
1514handle_info(hibernate_now, _SName, _State) ->
1515    %% Arrive here from by direct ! from testcase
1516    {next_state, hiber_idle, [], hibernate};
1517handle_info(hibernate_later, _SName, _State) ->
1518    {next_state, hiber_idle, hibernate_me, 1000};
1519handle_info({call_undef_fun, {Mod, Fun}}, State, Data) ->
1520    Mod:Fun(),
1521    {next_state, State, Data};
1522handle_info({From, handle_info}, SName, State) ->
1523    From ! {self(), handled_info},
1524    {next_state, SName, State};
1525handle_info(Info, _State, Data) ->
1526    {stop, {unexpected,Info}, Data}.
1527
1528handle_event(hibernate_async, hiber_idle, Data) ->
1529    {next_state,hiber_wakeup, Data, hibernate};
1530handle_event(wakeup_async,hiber_wakeup,Data) ->
1531    {next_state,hiber_idle,Data};
1532handle_event(snooze_async,hiber_wakeup,Data) ->
1533    {next_state,hiber_wakeup,Data,hibernate};
1534handle_event({get, Pid}, State, Data) ->
1535    Pid ! {state, State, Data},
1536    {next_state, State, Data};
1537handle_event(stop, _State, Data) ->
1538    {stop, normal, Data};
1539handle_event(stop_shutdown, _State, Data) ->
1540    {stop, shutdown, Data};
1541handle_event(stop_shutdown_reason, _State, Data) ->
1542    {stop, shutdown, Data};
1543handle_event({'alive?', Pid}, State, Data) ->
1544    Pid ! yes,
1545    {next_state, State, Data}.
1546
1547handle_sync_event(hibernate_sync, _From, hiber_idle, Data) ->
1548    {reply, hibernating, hiber_wakeup, Data, hibernate};
1549handle_sync_event(wakeup_sync,_From,hiber_wakeup, Data) ->
1550    {reply,good_morning,hiber_idle,Data};
1551handle_sync_event(snooze_sync,_From,hiber_wakeup,Data) ->
1552    {reply,five_more,hiber_wakeup,Data,hibernate};
1553handle_sync_event('alive?', _From, State, Data) ->
1554    {reply, yes, State, Data};
1555handle_sync_event(stop, _From, _State, Data) ->
1556    {stop, normal, stopped, Data};
1557handle_sync_event(stop_shutdown, _From, _State, Data) ->
1558    {stop, shutdown, shutdown_stopped, Data};
1559handle_sync_event(stop_shutdown_reason, _From, _State, Data) ->
1560    {stop, {shutdown,reason}, {shutdown,reason}, Data};
1561handle_sync_event({get, _Pid}, _From, State, Data) ->
1562    {reply, {state, State, Data}, State, Data}.
1563
1564format_status(terminate, [_Pdict, StateData]) ->
1565    {formatted, StateData};
1566format_status(normal, [_Pdict, _StateData]) ->
1567    [format_status_called].
1568
1569code_change(_OldVsn, State,
1570            {idle, {undef_in_code_change, {Mod, Fun}}} = Data, _Extra) ->
1571    Mod:Fun(),
1572    {ok, State, Data};
1573code_change(_OldVsn, State, Data, _Extra) ->
1574    {ok, State, Data}.
1575
1576get_messages() ->
1577    receive
1578	Msg -> [Msg|get_messages()]
1579    after 1 -> []
1580    end.
1581