File Coverage

blib/lib/Test2/Plugin/SRand.pm
Criterion Covered Total %
statement 36 36 100.0
branch 15 16 93.7
condition 7 15 46.6
subroutine 9 9 100.0
pod 0 2 0.0
total 67 78 85.9


line stmt bran cond sub pod time code
1             package Test2::Plugin::SRand;
2 156     156   1188 use strict;
  156         293  
  156         7032  
3 156     156   835 use warnings;
  156         2218  
  156         8908  
4              
5             our $VERSION = '0.000156';
6              
7 156     156   8403 use Carp qw/carp/;
  156         435  
  156         12535  
8              
9 156         70626 use Test2::API qw{
10             context
11             test2_add_callback_post_load
12             test2_add_callback_exit
13             test2_stack
14 156     156   101874 };
  156         11577874  
15              
16             my $ADDED_HOOK = 0;
17             my $SEED;
18             my $FROM;
19              
20 8     8 0 52 sub seed { $SEED }
21 5     5 0 27 sub from { $FROM }
22              
23             sub import {
24 162     162   8088 my $class = shift;
25              
26 162 100       1478 carp "SRand loaded multiple times, re-seeding rand"
27             if defined $SEED;
28              
29 162 100 66     1795 if (@_ == 1) {
    100          
    100          
30 2         7 ($SEED) = @_;
31 2         4 $FROM = 'import arg';
32             }
33             elsif (@_ == 2 and $_[0] eq 'seed') {
34 1         3 $SEED = $_[1];
35 1         3 $FROM = 'import arg';
36             }
37             elsif(exists $ENV{T2_RAND_SEED}) {
38 1         4 $SEED = $ENV{T2_RAND_SEED};
39 1         3 $FROM = 'environment variable';
40             }
41             else {
42 158         9314 my @ltime = localtime;
43             # Yes, this would be an awful seed if you actually wanted randomness.
44             # The idea here is that we want "random" behavior to be predictable
45             # within a given day. This allows you to reproduce failures that may or
46             # may not happen due to randomness.
47 158         2039 $SEED = sprintf('%04d%02d%02d', 1900 + $ltime[5], 1 + $ltime[4], $ltime[3]);
48 158         736 $FROM = 'local date';
49             }
50              
51 162 100       707 $SEED = 0 unless $SEED;
52 162         673 srand($SEED);
53              
54 162 100 66     2317 if ($ENV{HARNESS_IS_VERBOSE} || !$ENV{HARNESS_ACTIVE}) {
    100          
55             # If the harness is verbose then just display the message for all to
56             # see. It is nice info and they already asked for noisy output.
57              
58             test2_add_callback_post_load(sub {
59 4     4   85 test2_stack()->top; # Ensure we have at least 1 hub.
60 4         56 my ($hub) = test2_stack()->all;
61 4         53 $hub->send(
62             Test2::Event::Note->new(
63             trace => Test2::Util::Trace->new(frame => [__PACKAGE__, __FILE__, __LINE__, 'SRAND']),
64             message => "Seeded srand with seed '$SEED' from $FROM.",
65             )
66             );
67 4         28 });
68             }
69             elsif (!$ADDED_HOOK++) {
70             # The seed can be important for debugging, so if anything is wrong we
71             # should output the seed message as a diagnostics message. This must be
72             # done at the very end, even later than a hub hook.
73             test2_add_callback_exit(
74             sub {
75 103     103   1850 my ($ctx, $real, $new) = @_;
76              
77 103 50 33     1797 $ctx->diag("Seeded srand with seed '$SEED' from $FROM.")
      33        
      33        
78             if $real
79             || ($new && $$new)
80             || !$ctx->hub->is_passing;
81             }
82 156         2090 );
83             }
84             }
85              
86             1;
87              
88             __END__