File Coverage

blib/lib/Test2/Tools/Warnings.pm

Criterion	Covered	Total	%
statement	38	38	100.0
branch	4	4	100.0
condition			n/a
subroutine	11	11	100.0
pod	4	4	100.0
total	57	57	100.0

package Test2::Tools::Warnings;
use strict;
use warnings;

our $VERSION = '0.000153';

use Test2::API qw/context/;

our @EXPORT = qw/warns warning warnings no_warnings/;
use base 'Exporter';

sub warns(&) {
    my $code = shift;
    my $warnings = 0;
    local $SIG{__WARN__} = sub { $warnings++ };
    $code->();
    return $warnings;
}

sub no_warnings(&) { return !&warns(@_) }

sub warning(&) {
    my $code = shift;
    my @warnings;
    {
        local $SIG{__WARN__} = sub { push @warnings => @_ };
        $code->();
        return unless @warnings;
    }

    if (@warnings > 1) {
        my $ctx = context();
        $ctx->alert("Extra warnings in warning { ... }");
        $ctx->note($_) for @warnings;
        $ctx->release;
    }

    return $warnings[0];
}

sub warnings(&) {
    my $code = shift;

    my @warnings;
    local $SIG{__WARN__} = sub { push @warnings => @_ };
    $code->();

    return \@warnings;
}

1;


__END__