1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2010-2016. 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(timetrap_5_SUITE).
21
22-compile(export_all).
23
24-include_lib("common_test/include/ct.hrl").
25
26-define(TO, 1).
27
28%%--------------------------------------------------------------------
29%% Function: suite() -> Info
30%% Info = [tuple()]
31%%--------------------------------------------------------------------
32suite() ->
33    [{timetrap, fun() -> timetrap_utils:timetrap_val({seconds,?TO}) end}].
34
35%%--------------------------------------------------------------------
36%% Function: init_per_suite(Config0) ->
37%%               Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}
38%% Config0 = Config1 = [tuple()]
39%% Reason = term()
40%%--------------------------------------------------------------------
41init_per_suite(Config) ->
42    Config.
43
44%%--------------------------------------------------------------------
45%% Function: end_per_suite(Config0) -> void() | {save_config,Config1}
46%% Config0 = Config1 = [tuple()]
47%%--------------------------------------------------------------------
48end_per_suite(_Config) ->
49    ok.
50
51%%--------------------------------------------------------------------
52%% Function: init_per_group(GroupName, Config0) ->
53%%               Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}
54%% GroupName = atom()
55%% Config0 = Config1 = [tuple()]
56%% Reason = term()
57%%--------------------------------------------------------------------
58init_per_group(_GroupName, Config) ->
59    Config.
60
61%%--------------------------------------------------------------------
62%% Function: end_per_group(GroupName, Config0) ->
63%%               void() | {save_config,Config1}
64%% GroupName = atom()
65%% Config0 = Config1 = [tuple()]
66%%--------------------------------------------------------------------
67end_per_group(_GroupName, _Config) ->
68    ok.
69
70%%--------------------------------------------------------------------
71%% Function: init_per_testcase(TestCase, Config0) ->
72%%               Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}
73%% TestCase = atom()
74%% Config0 = Config1 = [tuple()]
75%% Reason = term()
76%%--------------------------------------------------------------------
77init_per_testcase(_, Config) ->
78    Config.
79
80%%--------------------------------------------------------------------
81%% Function: end_per_testcase(TestCase, Config0) ->
82%%               void() | {save_config,Config1}
83%% TestCase = atom()
84%% Config0 = Config1 = [tuple()]
85%%--------------------------------------------------------------------
86end_per_testcase(_, _Config) ->
87    ok.
88
89%%--------------------------------------------------------------------
90%% Function: groups() -> [Group]
91%% Group = {GroupName,Properties,GroupsAndTestCases}
92%% GroupName = atom()
93%% Properties = [parallel | sequence | Shuffle | {RepeatType,N}]
94%% GroupsAndTestCases = [Group | {group,GroupName} | TestCase]
95%% TestCase = atom()
96%% Shuffle = shuffle | {shuffle,{integer(),integer(),integer()}}
97%% RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail |
98%%              repeat_until_any_ok | repeat_until_any_fail
99%% N = integer() | forever
100%%--------------------------------------------------------------------
101groups() ->
102    [].
103
104%%--------------------------------------------------------------------
105%% Function: all() -> GroupsAndTestCases | {skip,Reason}
106%% GroupsAndTestCases = [{group,GroupName} | TestCase]
107%% GroupName = atom()
108%% TestCase = atom()
109%% Reason = term()
110%%--------------------------------------------------------------------
111all() ->
112    [tc0,tc1,tc2,tc3,tc4,tc5,tc6,tc7,tc8,tc9,
113     tc10,tc11,tc12,tc13,tc14].
114
115tc0(_) ->
116    ct:comment(io_lib:format("TO after ~w sec", [?TO])),
117    ct:sleep({seconds,5}),
118    ok.
119
120tc1() ->
121    [{timetrap,{timetrap_utils,timetrap_exit,[kaboom]}}].
122tc1(_) ->
123    exit(this_should_not_execute).
124
125tc2() ->
126    [{timetrap,fun() -> exit(kaboom) end}].
127tc2(_) ->
128    exit(this_should_not_execute).
129
130tc3() ->
131    [{timetrap,{timetrap_utils,timetrap_val,[{seconds,2}]}}].
132tc3(_) ->
133    ct:comment("TO after ~2 sec"),
134    ct:sleep({seconds,10}),
135    ok.
136
137tc4() ->
138    [{timetrap,fun() -> 500 end}].
139tc4(_) ->
140    ct:comment("TO after 500 ms"),
141    ct:sleep({seconds,10}),
142    ok.
143
144tc5() ->
145   [{timetrap,{timetrap_utils,timetrap_timeout,[1000,ok]}}].
146tc5(_) ->
147    ct:comment("TO after ~1 sec"),
148    ct:sleep({seconds,10}),
149    ok.
150
151tc6() ->
152    [{timetrap,{timetrap_utils,timetrap_timeout,[{seconds,40},
153						 {seconds,1}]}}].
154tc6(_) ->
155    ct:comment("TO after 40+1 sec"),
156    ct:sleep({seconds,42}),
157    ok.
158
159tc7() ->
160    [{timetrap,{timetrap_utils,timetrap_timeout,[1000,2000]}}].
161tc7(_) ->
162    ct:comment("TO after ~3 sec"),
163    ct:sleep({seconds,10}),
164    ok.
165
166tc8() ->
167    [{timetrap,fun() -> ct:sleep(6000), 1000 end}].
168tc8(_) ->
169    ct:comment("TO after 6+1 sec"),
170    ct:sleep({seconds,10}),
171    ok.
172
173tc9() ->
174    [{timetrap,{timetrap_utils,timetrap_timeout,
175		[500,fun() -> {seconds,2} end]}}].
176tc9(_) ->
177    ct:comment("TO after ~2 sec (2.5 sec in reality)"),
178    ct:sleep({seconds,10}),
179    ok.
180
181tc10() ->
182    [{timetrap,500}].
183tc10(_) ->
184    ct:timetrap({timetrap_utils,timetrap_val,[1500]}),
185    ct:comment("TO after ~1.5 sec"),
186    ct:sleep({seconds,10}),
187    ok.
188
189tc11() ->
190    [{timetrap,2000}].
191tc11(_) ->
192    ct:timetrap(fun() -> 1500 end),
193    ct:comment("TO after ~1.5 sec"),
194    ct:sleep({seconds,10}),
195    ok.
196
197tc12() ->
198    [{timetrap,500}].
199tc12(_) ->
200    ct:timetrap({timetrap_utils,timetrap_timeout,[1000,ok]}),
201    ct:comment("TO after ~1 sec"),
202    ct:sleep({seconds,10}),
203    ok.
204
205tc13() ->
206    [{timetrap,2000}].
207tc13(_) ->
208    ct:timetrap(fun() -> ct:sleep(500), ok end),
209    ct:comment("TO after ~500 ms"),
210    ct:sleep({seconds,10}),
211    ok.
212
213tc14(_) ->
214    ct:comment(io_lib:format("TO after ~w sec", [?TO])),
215    ct:sleep({seconds,5}),
216    ok.
217