File Coverage

blib/lib/Test/Stream/Plugin/SRand.pm
Criterion Covered Total %
statement 41 41 100.0
branch 13 14 92.8
condition 3 9 33.3
subroutine 11 11 100.0
pod 0 3 0.0
total 68 78 87.1


line stmt bran cond sub pod time code
1             package Test::Stream::Plugin::SRand;
2 1     1   569 use strict;
  1         2  
  1         24  
3 1     1   5 use warnings;
  1         1  
  1         22  
4              
5 1     1   5 use Test::Stream::Plugin;
  1         2  
  1         6  
6 1     1   5 use Test::Stream::Sync;
  1         2  
  1         29  
7              
8 1     1   9 use Carp qw/carp/;
  1         2  
  1         47  
9              
10 1     1   4 use Test::Stream::Context qw/context/;
  1         2  
  1         6  
11              
12             my $ADDED_HOOK = 0;
13             my $SEED;
14             my $FROM;
15              
16 5     5 0 37 sub seed { $SEED }
17 4     4 0 17 sub from { $FROM }
18              
19             sub load_ts_plugin {
20 6     6 0 43 my $class = shift;
21 6         11 my $caller = shift;
22              
23 6 100       671 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         166 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       17 $SEED = 0 unless $SEED;
41 6         13 srand($SEED);
42              
43 6 100       25 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   10 my $ctx = context();
48 3         17 $ctx->note("Seeded srand with seed '$SEED' from $FROM.");
49 3         12 $ctx->release;
50 3         31 });
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   2 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