1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2007-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
21%%
22%%----------------------------------------------------------------------
23%% Purpose: Verify the application specifics of the Megaco application
24%%----------------------------------------------------------------------
25-module(megaco_timer_SUITE).
26
27-compile({no_auto_import,[error/1]}).
28
29-export([
30 	 suite/0, all/0, groups/0,
31         init_per_suite/1, end_per_suite/1,
32         init_per_group/2, end_per_group/2,
33         init_per_testcase/2, end_per_testcase/2,
34
35	 simple_init/1,
36	 simple_usage/1,
37	 integer_timer_start_and_expire/1,
38	 integer_timer_start_and_stop/1
39
40	]).
41
42-export([
43	 timeout/3
44	]).
45
46-include("megaco_test_lib.hrl").
47-include_lib("megaco/include/megaco.hrl").
48-include_lib("megaco/include/megaco_message_v1.hrl").
49
50
51-define(TEST_VERBOSITY, info). % silence | info | debug
52
53
54
55%%======================================================================
56%% Common Test interface functions
57%%======================================================================
58
59suite() ->
60    [{ct_hooks, [ts_install_cth]}].
61
62all() ->
63    [{group, simple}, {group, integer_timer}].
64
65groups() ->
66    [
67     {simple,        [], simple_cases()},
68     {integer_timer, [], integer_timer_cases()}
69    ].
70
71simple_cases() ->
72    [
73     simple_init,
74     simple_usage
75    ].
76
77integer_timer_cases() ->
78    [
79     integer_timer_start_and_expire,
80     integer_timer_start_and_stop
81    ].
82
83
84
85%%
86%% -----
87%%
88
89init_per_suite(suite) ->
90    [];
91init_per_suite(doc) ->
92    [];
93init_per_suite(Config0) when is_list(Config0) ->
94
95    ?ANNOUNCE_SUITE_INIT(),
96
97    p("init_per_suite -> entry with"
98      "~n      Config: ~p"
99      "~n      Nodes:  ~p", [Config0, erlang:nodes()]),
100
101    case ?LIB:init_per_suite([{sysmon, false} | Config0]) of
102        {skip, _} = SKIP ->
103            SKIP;
104
105        Config1 when is_list(Config1) ->
106
107            p("init_per_suite -> end when"
108              "~n      Config: ~p"
109              "~n      Nodes:  ~p", [Config1, erlang:nodes()]),
110
111            Config1
112    end.
113
114end_per_suite(suite) -> [];
115end_per_suite(doc) -> [];
116end_per_suite(Config0) when is_list(Config0) ->
117
118    p("end_per_suite -> entry with"
119      "~n      Config: ~p"
120      "~n      Nodes:  ~p", [Config0, erlang:nodes()]),
121
122    Config1 = ?LIB:end_per_suite(Config0),
123
124    p("end_per_suite -> end when"
125      "~n      Nodes:  ~p", [erlang:nodes()]),
126
127    Config1.
128
129
130%%
131%% -----
132%%
133
134init_per_group(_GroupName, Config) ->
135    Config.
136
137end_per_group(_GroupName, Config) ->
138    Config.
139
140
141
142%%
143%% -----
144%%
145
146%% init_per_testcase(multi_user_extreme_load = Case, Config) ->
147%%     C = lists:keydelete(tc_timeout, 1, Config),
148%%     do_init_per_testcase(Case, [{tc_timeout, min(20)}|C]);
149init_per_testcase(Case, Config) ->
150    do_init_per_testcase(Case, Config).
151
152do_init_per_testcase(Case, Config) ->
153    process_flag(trap_exit, true),
154
155    p("init_per_suite -> entry with"
156      "~n      Config: ~p"
157      "~n      Nodes:  ~p", [Config, erlang:nodes()]),
158
159    {ok, _Pid} = megaco_monitor:start_link(),
160    megaco_test_lib:init_per_testcase(Case, [{monitor_running, true}|Config]).
161
162end_per_testcase(Case, Config) ->
163    process_flag(trap_exit, false),
164
165    p("end_per_suite -> entry with"
166      "~n      Config: ~p"
167      "~n      Nodes:  ~p", [Config, erlang:nodes()]),
168
169    case lists:keydelete(monitor_running, 1, Config) of
170	Config ->
171	    megaco_test_lib:end_per_testcase(Case, Config);
172	Config2 ->
173	    megaco_monitor:stop(),
174	    megaco_test_lib:end_per_testcase(Case, Config2)
175    end.
176
177
178
179%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
180
181simple_init(suite) ->
182    [];
183simple_init(doc) ->
184    [];
185simple_init(Config) when is_list(Config) ->
186    put(verbosity, ?TEST_VERBOSITY),
187    put(tc,        si),
188    put(sname,     "TEST"),
189    put(verbosity, info),
190    i("starting"),
191
192    Init =
193	fun(Tmr) ->
194		case (catch megaco_timer:init(Tmr)) of
195		    {WaitFor, {NewTmr, _}} when
196		        (((WaitFor == infinity) or is_integer(WaitFor)) andalso
197			 is_record(NewTmr, megaco_incr_timer) andalso
198			 (is_record(Tmr, megaco_incr_timer) andalso
199			  (Tmr#megaco_incr_timer.max_retries == infinity_restartable))) ->
200			ok;
201		    {WaitFor, NewTmr} when
202			 (((WaitFor == infinity) or is_integer(WaitFor)) andalso
203			  ((NewTmr == timeout) or is_record(NewTmr, megaco_incr_timer))) ->
204			ok;
205		    X ->
206			d("initiation of timer failed: "
207			  "~n   X: ~p", [X]),
208			{error, X}
209		end
210	end,
211    Verify =
212	fun(A, A) ->
213		ok;
214	   (error, {error, Reason}) ->
215		d("Error reason: ~p", [Reason]),
216		ok;
217	   (A, B) ->
218		d("unexpected result: "
219		  "~n   Expected: ~p"
220		  "~n   Actual:   ~p", [A, B]),
221		unexpected_result(A, B)
222	end,
223    VerifyTMR =
224	fun(false, Tmr) ->
225		not megaco_timer:verify(Tmr);
226	   (true, Tmr) ->
227		megaco_timer:verify(Tmr)
228	end,
229
230    d(" 1) verify infinity timer"),
231    TMR01 = infinity,
232    Verify(true,  VerifyTMR(true, TMR01)),
233    Verify(ok,    Init(TMR01)),
234
235    d(" 2) verify integer (2007) timer"),
236    TMR02 = 2007,
237    Verify(true,  VerifyTMR(true, TMR02)),
238    Verify(ok,    Init(TMR02)),
239
240    d(" 3) verify default megaco incr timer timer"),
241    TMR03 = #megaco_incr_timer{},
242    Verify(true,  VerifyTMR(true, TMR03)),
243    Verify(ok,    Init(TMR03)),
244
245    d(" 4) verify megaco incr timer timer"),
246    TMR04 = #megaco_incr_timer{max_retries = infinity_restartable},
247    Verify(true,  VerifyTMR(true, TMR04)),
248    Verify(ok,    Init(TMR04)),
249
250    d(" 5) verify megaco incr timer timer"),
251    TMR05 = #megaco_incr_timer{incr = -1}, %% This is new
252    Verify(true,  VerifyTMR(true, TMR05)),
253    Verify(ok,    Init(TMR05)),
254
255    d(" 6) verify invalid timer"),
256    TMR06 = infinit,
257    Verify(true,  VerifyTMR(false, TMR06)),
258    Verify(error, Init(TMR06)),
259
260    d(" 7) verify invalid timer"),
261    TMR07 = -2007,
262    Verify(true,  VerifyTMR(false, TMR07)),
263    Verify(error, Init(TMR07)),
264
265    d(" 8) verify invalid timer"),
266    TMR08 = 20.33,
267    Verify(true,  VerifyTMR(false, TMR08)),
268    Verify(error, Init(TMR08)),
269
270    d(" 9) verify invalid timer"),
271    TMR09 = -20.33,
272    Verify(true,  VerifyTMR(false, TMR09)),
273    Verify(error, Init(TMR09)),
274
275    d("10) verify invalid timer"),
276    TMR10 = "kalle anka",
277    Verify(true,  VerifyTMR(false, TMR10)),
278    Verify(error, Init(TMR10)),
279
280    d("11) verify invalid timer"),
281    TMR11 = #megaco_incr_timer{wait_for    = 10,
282			       factor      = 1,
283			       incr        = 0,
284			       max_retries = infinit},
285    Verify(true,  VerifyTMR(false, TMR11)),
286    Verify(error, Init(TMR11)),
287
288    i("done", []),
289    ok.
290
291
292
293%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
294
295simple_usage(suite) ->
296    [];
297simple_usage(doc) ->
298    [];
299simple_usage(Config) when is_list(Config) ->
300    put(verbosity, ?TEST_VERBOSITY),
301    put(tc,        su),
302    put(sname,     "TEST"),
303    i("starting"),
304
305    Verify  = fun(Tmr) -> megaco_timer:verify(Tmr)  end,
306    Init    = fun(Tmr) -> megaco_timer:init(Tmr)    end,
307    Restart = fun(Tmr) -> megaco_timer:restart(Tmr) end,
308
309    VerifyRes =
310	fun(A, A) ->
311		ok;
312	   (A, B) ->
313		unexpected_result(A, B)
314	end,
315
316
317    %% Timer 1
318    d(" 1) verify (infinity) timer"),
319    TMR01 = infinity,
320    VerifyRes(true,  Verify(TMR01)),
321    d(" 1) init (infinity) timer"),
322    VerifyRes({TMR01, timeout}, Init(TMR01)),
323
324    %% Timer 2
325    d(" 2) verify (integer) timer"),
326    TMR02 = 1000,
327    VerifyRes(true,  Verify(TMR02)),
328    d(" 2) init (integer) timer"),
329    VerifyRes({TMR02, timeout}, Init(TMR02)),
330
331    %% Timer 3
332    d(" 3) verify (megaco_incr_timer) timer"),
333    TMR03 = #megaco_incr_timer{wait_for    = TMR02,
334			       factor      = 1,
335			       incr        = 0,
336			       max_retries = infinity},
337    VerifyRes(true,  Verify(TMR03)),
338    d(" 3) init (megaco_incr_timer) timer"),
339    {TMR02, NewTMR03_1} = Init(TMR03),
340    d(" 3) restart (megaco_incr_timer) timer"),
341    {TMR02, _}          = Restart(NewTMR03_1),
342
343    %% Timer 4
344    d(" 4) verify (megaco_incr_timer) timer"),
345    TMR04 = #megaco_incr_timer{wait_for    = 1000,
346			       factor      = 1,
347			       incr        = 0,
348			       max_retries = 2},
349    VerifyRes(true,  Verify(TMR04)),
350    d(" 4) init (megaco_incr_timer) timer"),
351    {TMR02, NewTMR04_1} = Init(TMR04),
352    d(" 4) restart (megaco_incr_timer) timer"),
353    {TMR02, NewTMR04_2} = Restart(NewTMR04_1),
354    d(" 4) last restart (megaco_incr_timer) timer"),
355    {TMR02, timeout}    = Restart(NewTMR04_2),
356
357    %% Timer 5
358    d(" 5) verify (megaco_incr_timer) timer"),
359    TMR05 = #megaco_incr_timer{wait_for    = 1000,
360			       factor      = 1,
361			       incr        = -300,
362			       max_retries = infinity},
363    VerifyRes(true,  Verify(TMR05)),
364    d(" 5) init (megaco_incr_timer) timer"),
365    {TMR02, NewTMR05_1}     = Init(TMR05),
366    d(" 5) restart (1) (megaco_incr_timer) timer"),
367    TMR05_1 = TMR02-300,
368    {TMR05_1, NewTMR05_2} = Restart(NewTMR05_1),
369    d(" 5) restart (2) (megaco_incr_timer) timer"),
370    TMR05_2 = TMR05_1-300,
371    {TMR05_2, NewTMR05_3} = Restart(NewTMR05_2),
372    d(" 5) restart (3) (megaco_incr_timer) timer"),
373    TMR05_3 = TMR05_2-300,
374    {TMR05_3, NewTMR05_4} = Restart(NewTMR05_3),
375    d(" 5) restart (4) (megaco_incr_timer) timer"),
376    {0, NewTMR05_5}         = Restart(NewTMR05_4),
377    d(" 5) restart (5) (megaco_incr_timer) timer"),
378    {0, _}                  = Restart(NewTMR05_5),
379
380    i("done", []),
381    ok.
382
383
384
385%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
386
387integer_timer_start_and_expire(suite) ->
388    [];
389integer_timer_start_and_expire(doc) ->
390    [];
391integer_timer_start_and_expire(Config) when is_list(Config) ->
392    put(verbosity, ?TEST_VERBOSITY),
393    put(tc,        itsae),
394    put(sname,     "TEST"),
395    i("starting"),
396
397    Timeout = 5000,
398    Ref = tmr_start(Timeout),
399    receive
400	{timeout, Timeout} ->
401	    ok
402    after Timeout + 500 ->
403	    tmr_stop(Ref),
404	    no_timeout()
405    end,
406
407    i("done", []),
408    ok.
409
410
411%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
412
413integer_timer_start_and_stop(suite) ->
414    [];
415integer_timer_start_and_stop(doc) ->
416    [];
417integer_timer_start_and_stop(Config) when is_list(Config) ->
418    put(verbosity, ?TEST_VERBOSITY),
419    put(tc,        itsas),
420    put(sname,     "TEST"),
421    i("starting"),
422
423    Timeout = 5000,
424    i("try start (~w msec) timer", [Timeout]),
425    Ref     = tmr_start(Timeout),
426    i("timer started "),
427    receive
428	{timeout, Timeout} ->
429            i("unexpected premature timer expire"),
430	    bad_timeout()
431    after Timeout - 100 ->
432            i("try stop timer"),
433	    case tmr_stop(Ref) of
434                {ok, Rem} ->
435                    i("timer stopped with ~w msec remaining", [Rem]),
436                    ok;
437                CancelRes ->
438                    i("failed stop timer: "
439                      "~n   ~p", [CancelRes]),
440                    ?SKIP({cancel_failed, CancelRes}) % Race - not our problem
441            end
442    end,
443
444    %% Make sure it does not reach us after we attempted to stop it.
445    receive
446	{timeout, Timeout} ->
447	    unexpected_timeout()
448    after Timeout ->
449	    ok
450    end,
451
452    i("done", []),
453    ok.
454
455
456%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
457
458tmr_start(Timeout) ->
459    Pid = self(),
460    megaco_monitor:apply_after(?MODULE, timeout,
461			       [Pid, Timeout, get(tc)], Timeout).
462
463tmr_stop(Ref) ->
464    megaco_monitor:cancel_apply_after(Ref).
465
466timeout(Pid, Timeout, Tc) ->
467    put(sname, timer),
468    put(tc, Tc),
469    print("DBG",
470	  "timeout -> entry with"
471	  "~n   Pid:     ~p"
472	  "~n   Timeout: ~p", [Pid, Timeout]),
473    Pid ! {timeout, Timeout}.
474
475
476%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
477
478unexpected_result(A, B) ->
479    error({unexpected_result, A, B}).
480
481no_timeout() ->
482    error(no_timeout).
483
484bad_timeout() ->
485    error(bad_timeout).
486
487unexpected_timeout() ->
488    error(unexpected_timeout).
489
490
491error(Reason) -> throw({error, Reason}).
492
493
494%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
495
496p(F, A) ->
497    io:format("*** [~s] ~p ***"
498	      "~n   " ++ F ++ "~n",
499	      [?FTS(), self() | A]).
500
501i(F) ->
502    i(F, []).
503
504i(F, A) ->
505    print(info, "INF", F, A).
506
507d(F) ->
508    d(F, []).
509
510d(F, A) ->
511    print(debug, "DBG", F, A).
512
513printable(_, debug)   -> true;
514printable(info, info) -> true;
515printable(_,_)        -> false.
516
517
518print(Severity, Prefix, F, A) ->
519    print1(printable(Severity, get(verbosity)), Prefix, F, A).
520
521print1(true, Prefix, F, A) ->
522    print(Prefix, F, A);
523print1(_, _, _, _) ->
524    ok.
525
526print(Prefix, F, A) ->
527    io:format("*** [~s] ~s ~p ~s:~w ***"
528              "~n   " ++ F ++ "~n",
529              [?FTS(), Prefix, self(), get(sname), get(tc) | A]).
530
531
532