File 6721-eunit-Add-possibility-to-scale-timeouts.patch of Package erlang (Revision 0b3a6d6e89afeaba4dcdf8fb3d620103)
Currently displaying revision 0b3a6d6e89afeaba4dcdf8fb3d620103 , Show latest
xxxxxxxxxx
1
From 0d75a4bd6fbe42081702ea5532979dce4b8b9e55 Mon Sep 17 00:00:00 2001
2
From: Tomas Abrahamsson <tomas.abrahamsson@gmail.com>
3
Date: Wed, 6 Sep 2023 20:51:01 +0200
4
Subject: [PATCH] eunit: Add possibility to scale timeouts
5
6
Add an option to eunit:test(..., Options):
7
8
{scale_timeouts, N}
9
10
to be able to increase the timeouts by some factor, or
11
decrease it if the factor is below 1.0.
12
13
This applies to both the the default 5 second timeout,
14
and to timeouts specified as {timeout, Seconds, Test}
15
in eunit test generators.
16
---
17
lib/eunit/src/eunit.erl | 5 +++
18
lib/eunit/src/eunit_proc.erl | 16 ++++++++--
19
lib/eunit/test/eunit_SUITE.erl | 57 ++++++++++++++++++++++++++++++++--
20
3 files changed, 74 insertions(+), 4 deletions(-)
21
22
diff --git a/lib/eunit/src/eunit.erl b/lib/eunit/src/eunit.erl
23
index f30c238366..7c84b0209e 100644
24
--- a/lib/eunit/src/eunit.erl
25
+++ b/lib/eunit/src/eunit.erl
26
27
%% not automatically execute tests found in related module suffixed with "_tests".
28
%% This behaviour might be unwanted if execution of modules found in a folder
29
%% is ordered while it contains both source and test modules.</dd>
30
+%% <dt>`scale_timeouts'</dt>
31
+%% <dd>If this numeric value is set, timeouts will get scaled accordingly.
32
+%% It may be useful when running a set of tests on a slower host.
33
+%% Examples: `{scale_timeouts,10}' make the timeouts 10 times longer, while
34
+%% `{scale_timeouts,0.1}' would shorten them by a factor of 10.</dd>
35
%% </dl>
36
%%
37
%% Options in the environment variable EUNIT are also included last in
38
diff --git a/lib/eunit/src/eunit_proc.erl b/lib/eunit/src/eunit_proc.erl
39
index 48254f53a3..1cdaaeaf9b 100644
40
--- a/lib/eunit/src/eunit_proc.erl
41
+++ b/lib/eunit/src/eunit_proc.erl
42
43
erlang:cancel_timer(Ref).
44
45
with_timeout(undefined, Default, F, St) ->
46
- with_timeout(Default, F, St);
47
+ with_timeout(scale_timeout(Default, St), F, St);
48
with_timeout(Time, _Default, F, St) ->
49
- with_timeout(Time, F, St).
50
+ with_timeout(scale_timeout(Time, St), F, St).
51
+
52
+scale_timeout(infinity, _St) ->
53
+ infinity;
54
+scale_timeout(Time, St) ->
55
+ case proplists:get_value(scale_timeouts, St#procstate.options) of
56
+ undefined ->
57
+ Time;
58
+ N when is_integer(N) ->
59
+ N * Time;
60
+ N when is_float(N) ->
61
+ round(N * Time)
62
+ end.
63
64
with_timeout(infinity, F, _St) ->
65
%% don't start timers unnecessarily
66
diff --git a/lib/eunit/test/eunit_SUITE.erl b/lib/eunit/test/eunit_SUITE.erl
67
index 33bf090eeb..377dc97557 100644
68
--- a/lib/eunit/test/eunit_SUITE.erl
69
+++ b/lib/eunit/test/eunit_SUITE.erl
70
71
app_test/1, appup_test/1, eunit_test/1, eunit_exact_test/1,
72
fixture_test/1, primitive_test/1, surefire_utf8_test/1,
73
surefire_latin_test/1, surefire_c0_test/1, surefire_ensure_dir_test/1,
74
- stacktrace_at_timeout_test/1]).
75
+ stacktrace_at_timeout_test/1, scale_timeouts_test/1]).
76
+
77
+%% Two eunit tests:
78
+-export([times_out_test_/0, times_out_default_test/0]).
79
80
-export([sample_gen/0]).
81
82
-include_lib("common_test/include/ct.hrl").
83
+-include_lib("stdlib/include/assert.hrl").
84
-define(TIMEOUT, 1000).
85
86
suite() -> [{ct_hooks,[ts_install_cth]}].
87
88
all() ->
89
[app_test, appup_test, eunit_test, eunit_exact_test, primitive_test,
90
fixture_test, surefire_utf8_test, surefire_latin_test, surefire_c0_test,
91
- surefire_ensure_dir_test, stacktrace_at_timeout_test].
92
+ surefire_ensure_dir_test, stacktrace_at_timeout_test,
93
+ scale_timeouts_test].
94
95
groups() ->
96
[].
97
98
%% Check that file is valid XML
99
xmerl_scan:file(File),
100
Chars.
101
+
102
+scale_timeouts_test(_Config) ->
103
+ %% Scaling with integers
104
+ %% The times_out_test_ will timeout after 1 second.
105
+ %% Scale it up by a factor of 2 and check that at least 2s have passed.
106
+ Millis1 = run_eunit_test_that_times_out(times_out_test_,
107
+ [{scale_timeouts, 2}]),
108
+ ?assert(Millis1 >= 2000, #{duration => Millis1}),
109
+ ?assert(Millis1 < 5000, #{duration => Millis1}),
110
+
111
+ %% Scaling with float: should get rounded
112
+ %% Scaling down should work too
113
+ Millis2 = run_eunit_test_that_times_out(times_out_test_,
114
+ [{scale_timeouts, 0.25}]),
115
+ ?assert(Millis2 >= 250, #{duration => Millis2}),
116
+ ?assert(Millis2 < 1000, #{duration => Millis2}),
117
+
118
+ %% It should be possible to scale the default timeout as well
119
+ Millis3 = run_eunit_test_that_times_out(times_out_default_test,
120
+ [{scale_timeouts, 0.01}]),
121
+ ?assert(Millis3 > 0, #{duration => Millis3}),
122
+ ?assert(Millis3 < 1000, #{duration => Millis3}),
123
+ ok.
124
+
125
+run_eunit_test_that_times_out(TestFn, Options) ->
126
+ T0 = erlang:monotonic_time(millisecond),
127
+ %% Expect error due to the timeout:
128
+ case lists:suffix("_test_", atom_to_list(TestFn)) of
129
+ true ->
130
+ error = eunit:test({generator, ?MODULE, TestFn}, Options);
131
+ false ->
132
+ error = eunit:test({?MODULE, TestFn}, Options)
133
+ end,
134
+ T1 = erlang:monotonic_time(millisecond),
135
+ T1 - T0.
136
+
137
+%% an eunit test generator:
138
+times_out_test_() ->
139
+ {timeout, 1, % the fun should timeout after this many seconds
140
+ fun() -> timer:sleep(10_000) % long enough to cause a timeout
141
+ end}.
142
+
143
+%% an eunit test:
144
+times_out_default_test() ->
145
+ %% The default timeout for an xyz_test/0 is 5s,
146
+ %% so this is long enough to cause a time out.
147
+ timer:sleep(20_000).
148
+
149
--
150
2.35.3
151
152