line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Test::Stream::Plugin::SRand; |
2
|
1
|
|
|
1
|
|
551
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
25
|
|
3
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
23
|
|
4
|
|
|
|
|
|
|
|
5
|
1
|
|
|
1
|
|
5
|
use Test::Stream::Plugin; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
6
|
|
6
|
1
|
|
|
1
|
|
7
|
use Test::Stream::Sync; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
32
|
|
7
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
5
|
use Carp qw/carp/; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
47
|
|
9
|
|
|
|
|
|
|
|
10
|
1
|
|
|
1
|
|
5
|
use Test::Stream::Context qw/context/; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
7
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
my $ADDED_HOOK = 0; |
13
|
|
|
|
|
|
|
my $SEED; |
14
|
|
|
|
|
|
|
my $FROM; |
15
|
|
|
|
|
|
|
|
16
|
5
|
|
|
5
|
0
|
28
|
sub seed { $SEED } |
17
|
4
|
|
|
4
|
0
|
19
|
sub from { $FROM } |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
sub load_ts_plugin { |
20
|
6
|
|
|
6
|
0
|
45
|
my $class = shift; |
21
|
6
|
|
|
|
|
11
|
my $caller = shift; |
22
|
|
|
|
|
|
|
|
23
|
6
|
100
|
|
|
|
672
|
carp "SRand loaded multiple times, re-seeding rand" |
24
|
|
|
|
|
|
|
if defined $SEED; |
25
|
|
|
|
|
|
|
|
26
|
6
|
100
|
|
|
|
25
|
if (@_) { |
|
|
100
|
|
|
|
|
|
27
|
2
|
|
|
|
|
5
|
($SEED) = @_; |
28
|
2
|
|
|
|
|
3
|
$FROM = 'import arg' |
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
elsif(exists $ENV{TS_RAND_SEED}) { |
31
|
1
|
|
|
|
|
3
|
$SEED = $ENV{TS_RAND_SEED}; |
32
|
1
|
|
|
|
|
2
|
$FROM = 'environment variable' |
33
|
|
|
|
|
|
|
} |
34
|
|
|
|
|
|
|
else { |
35
|
3
|
|
|
|
|
180
|
my @ltime = localtime; |
36
|
3
|
|
|
|
|
18
|
$SEED = sprintf('%04d%02d%02d', 1900 + $ltime[5], 1 + $ltime[4], $ltime[3]); |
37
|
3
|
|
|
|
|
7
|
$FROM = 'local date'; |
38
|
|
|
|
|
|
|
} |
39
|
|
|
|
|
|
|
|
40
|
6
|
100
|
|
|
|
18
|
$SEED = 0 unless $SEED; |
41
|
6
|
|
|
|
|
12
|
srand($SEED); |
42
|
|
|
|
|
|
|
|
43
|
6
|
100
|
|
|
|
26
|
if ($ENV{HARNESS_IS_VERBOSE}) { |
|
|
100
|
|
|
|
|
|
44
|
|
|
|
|
|
|
# If the harness is verbose then just display the message for all to |
45
|
|
|
|
|
|
|
# see. It is nice info and they already asked for noisy output. |
46
|
|
|
|
|
|
|
Test::Stream::Sync->post_load(sub { |
47
|
3
|
|
|
3
|
|
8
|
my $ctx = context(); |
48
|
3
|
|
|
|
|
17
|
$ctx->note("Seeded srand with seed '$SEED' from $FROM."); |
49
|
3
|
|
|
|
|
12
|
$ctx->release; |
50
|
3
|
|
|
|
|
32
|
}); |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
elsif (!$ADDED_HOOK++) { |
53
|
|
|
|
|
|
|
# The seed can be important for debugging, so if anything is wrong we |
54
|
|
|
|
|
|
|
# should output the seed message as a diagnostics message. This must be |
55
|
|
|
|
|
|
|
# done at the very end, even later than a hub hook. |
56
|
|
|
|
|
|
|
Test::Stream::Sync->add_hook( |
57
|
|
|
|
|
|
|
sub { |
58
|
1
|
|
|
1
|
|
3
|
my ($ctx, $real, $new) = @_; |
59
|
|
|
|
|
|
|
|
60
|
1
|
50
|
33
|
|
|
13
|
$ctx->diag("Seeded srand with seed '$SEED' from $FROM.") |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
61
|
|
|
|
|
|
|
if $real |
62
|
|
|
|
|
|
|
|| ($new && $$new) |
63
|
|
|
|
|
|
|
|| !$ctx->hub->state->is_passing; |
64
|
|
|
|
|
|
|
} |
65
|
1
|
|
|
|
|
11
|
); |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
1; |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=pod |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
=encoding UTF-8 |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
=head1 NAME |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
Test::Stream::Plugin::SRand - Control the random seed for more controlled test |
78
|
|
|
|
|
|
|
environments. |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
=head1 DESCRIPTION |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
This module gives you control over the random seed used for your unit tests. In |
83
|
|
|
|
|
|
|
some testing environments the random seed can play a major role in results. |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
The default configuration for this module will seed srand with the local date. |
86
|
|
|
|
|
|
|
Using the date as the seed means that on any given day the random seed will |
87
|
|
|
|
|
|
|
always be the same, this means behavior will not change from run to run on a |
88
|
|
|
|
|
|
|
given day. However the seed is different on different days allowing you to be |
89
|
|
|
|
|
|
|
sure the code still works with actual randomness. |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
The seed is printed for you on failure, or when the harness is verbose. You can |
92
|
|
|
|
|
|
|
use the C environment variable to specify the seed. You can also |
93
|
|
|
|
|
|
|
provide a specific seed as a load-time argument to the plugin. |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
=head1 SYNOPSIS |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
Loading the plugin is easy, and the defaults are sane: |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
use Test::Stream 'SRand'; |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
Custom seed: |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
use Test::Stream SRand => ['42']; |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
=head1 NOTE ON LOAD ORDER |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
If you use this plugin you probably want to use it as the first, or near-first |
108
|
|
|
|
|
|
|
plugin. C is not called until the plugin is loaded, so other plugins |
109
|
|
|
|
|
|
|
loaded first may already be making use of random numbers before your seed |
110
|
|
|
|
|
|
|
takes effect. |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
=head1 SOURCE |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
The source code repository for Test::Stream can be found at |
115
|
|
|
|
|
|
|
F. |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
=head1 MAINTAINERS |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
=over 4 |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
=item Chad Granum Eexodist@cpan.orgE |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
=back |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
=head1 AUTHORS |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
=over 4 |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
=item Chad Granum Eexodist@cpan.orgE |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
=back |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
=head1 COPYRIGHT |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
Copyright 2015 Chad Granum Eexodist7@gmail.comE. |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or |
138
|
|
|
|
|
|
|
modify it under the same terms as Perl itself. |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
See F |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
=cut |