view release on metacpan or  search on metacpan

lib/Benchmark/Confirm.pm  view on Meta::CPAN

            }
        }
        else {
            push @imports, $func;
        }
    }
    Benchmark->export_to_level(1, @imports);
}

our @CONFIRMS;

END {
    if (ref $capture eq 'IO::Capture::Stdout') {
        $capture->stop;
        while ( my $line = $capture->read ) {
            print "# ${line}"; # valid TAP
        }
    }
    if (@CONFIRMS > 1) {
        atonce();
        Test::More::done_testing();
    }
}

sub atonce {
    my $expect = _normalize(shift @CONFIRMS);
    Test::More::ok(1);

    for my $got (@CONFIRMS) {
        Test::More::is_deeply( _normalize($got), $expect );
    };

    reset_confirm();
}

sub _normalize {
    my $element = shift;
    (ref $element eq 'CODE') ? 'CODE' : [$element];
}

sub reset_confirm {
    @CONFIRMS = ();
}


package # hide from PAUSE
    Benchmark;
use strict;
no warnings 'redefine';

# based Benchmark 1.13
sub runloop {
    my($n, $c) = @_;

    $n+=0; # force numeric now, so garbage won't creep into the eval
    croak "negative loopcount $n" if $n<0;
    confess usage unless defined $c;
    my($t0, $t1, $td); # before, after, difference

    # find package of caller so we can execute code there
    my($curpack) = caller(0);
    my($i, $pack)= 0;
    while (($pack) = caller(++$i)) {
        last if $pack ne $curpack;
    }

    my ($subcode, $subref, $confirmref);
    if (ref $c eq 'CODE') {
        $subcode = "sub { for (1 .. $n) { local \$_; package $pack; &\$c; } }";
        $subref  = eval $subcode; ## no critic
        $confirmref = eval "sub { package $pack; &\$c; }"; ## no critic
    }
    else {
        $subcode = "sub { for (1 .. $n) { local \$_; package $pack; $c;} }";
        $subref  = _doeval($subcode);
        $confirmref = _doeval("sub { package $pack; $c; }");
    }
    croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@;
    print STDERR "runloop $n '$subcode'\n" if $Benchmark::Debug;

    push @Benchmark::Confirm::CONFIRMS, $confirmref->();

    # Wait for the user timer to tick.  This makes the error range more like 
    # -0.01, +0.  If we don't wait, then it's more like -0.01, +0.01.  This
    # may not seem important, but it significantly reduces the chances of
    # getting a too low initial $n in the initial, 'find the minimum' loop
    # in &countit.  This, in turn, can reduce the number of calls to
    # &runloop a lot, and thus reduce additive errors.
    my $tbase = Benchmark->new(0)->[1];
    while ( ( $t0 = Benchmark->new(0) )->[1] == $tbase ) {} ;
    $subref->();
    $t1 = Benchmark->new($n);
    $td = &timediff($t1, $t0);
    timedebug("runloop:",$td);
    $td;
}

1;