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

package Test2::Plugin::SRand;
use strict;
use warnings;

our $VERSION = '0.000153';

use Carp qw/carp/;

use Test2::API qw{
    context
    test2_add_callback_post_load
    test2_add_callback_exit
    test2_stack
};

my $ADDED_HOOK = 0;
my $SEED;
my $FROM;

sub seed { $SEED }
sub from { $FROM }

sub import {
    my $class = shift;

    carp "SRand loaded multiple times, re-seeding rand"
        if defined $SEED;

    if (@_ == 1) {
        ($SEED) = @_;
        $FROM = 'import arg';
    }
    elsif (@_ == 2 and $_[0] eq 'seed') {
        $SEED = $_[1];
        $FROM = 'import arg';
    }
    elsif(exists $ENV{T2_RAND_SEED}) {
        $SEED = $ENV{T2_RAND_SEED};
        $FROM = 'environment variable';
    }
    else {
        my @ltime = localtime;
        # Yes, this would be an awful seed if you actually wanted randomness.
        # The idea here is that we want "random" behavior to be predictable
        # within a given day. This allows you to reproduce failures that may or
        # may not happen due to randomness.
        $SEED = sprintf('%04d%02d%02d', 1900 + $ltime[5], 1 + $ltime[4], $ltime[3]);
        $FROM = 'local date';
    }

    $SEED = 0 unless $SEED;
    srand($SEED);

    if ($ENV{HARNESS_IS_VERBOSE} || !$ENV{HARNESS_ACTIVE}) {
        # If the harness is verbose then just display the message for all to
        # see. It is nice info and they already asked for noisy output.

        test2_add_callback_post_load(sub {
            test2_stack()->top; # Ensure we have at least 1 hub.
            my ($hub) = test2_stack()->all;
            $hub->send(
                Test2::Event::Note->new(
                    trace => Test2::Util::Trace->new(frame => [__PACKAGE__, __FILE__, __LINE__, 'SRAND']),
                    message => "Seeded srand with seed '$SEED' from $FROM.",
                )
            );
        });
    }
    elsif (!$ADDED_HOOK++) {
        # The seed can be important for debugging, so if anything is wrong we
        # should output the seed message as a diagnostics message. This must be
        # done at the very end, even later than a hub hook.
        test2_add_callback_exit(
            sub {
                my ($ctx, $real, $new) = @_;

                $ctx->diag("Seeded srand with seed '$SEED' from $FROM.")
                    if $real
                    || ($new && $$new)
                    || !$ctx->hub->is_passing;
            }
        );
    }
}

1;

__END__