libtest-failwarnings-perl 0.7-1 / usr / share / perl5 / Test / FailWarnings.pm

use 5.008001;
use strict;
use warnings;

package Test::FailWarnings;
# ABSTRACT: Add test failures if warnings are caught
our $VERSION = '0.007'; # VERSION

use Test::More 0.86;
use Cwd qw/getcwd/;
use File::Spec;
use Carp;

our $ALLOW_DEPS = 0;
our @ALLOW_FROM = ();

my $ORIG_DIR = getcwd(); # cache in case handler runs after a chdir

sub import {
    my ( $class, @args ) = @_;
    croak("import arguments must be key/value pairs")
      unless @args % 2 == 0;
    my %opts = @args;
    $ALLOW_DEPS = $opts{'-allow_deps'};
    if ( $opts{'-allow_from'} ) {
        @ALLOW_FROM =
          ref $opts{'-allow_from'} ? @{ $opts{'-allow_from'} } : $opts{'-allow_from'};
    }
    $SIG{__WARN__} = \&handler;
}

sub handler {
    my $msg = shift;
    $msg = '' unless defined $msg;
    chomp $msg;
    my ( $package, $filename, $line ) = _find_source();

    # shortcut if ignoring dependencies and warning did not
    # come from something local
    if ( $ALLOW_DEPS ) {
        $filename = File::Spec->abs2rel( $filename, $ORIG_DIR )
            if File::Spec->file_name_is_absolute( $filename );
        return if $filename !~ /^(?:t|xt|lib|blib)/;
    }

    return if grep { $package eq $_ } @ALLOW_FROM;

    if ( $msg !~ m/at .*? line \d/ ) {
        chomp $msg;
        $msg = "'$msg' at $filename line $line.";
    }
    else {
        $msg = "'$msg'";
    }
    my $builder = Test::More->builder;
    $builder->ok( 0, "Test::FailWarnings should catch no warnings" )
      or $builder->diag("Warning was $msg");
}

sub _find_source {
    my $i = 1;
    while (1) {
        my ( $pkg, $filename, $line ) = caller( $i++ );
        return caller( $i - 2 ) unless defined $pkg;
        next if $pkg =~ /^(?:Carp|warnings)/;
        return ( $pkg, $filename, $line );
    }
}

1;


# vim: ts=4 sts=4 sw=4 et:

__END__

=pod

=encoding utf-8

=head1 NAME

Test::FailWarnings - Add test failures if warnings are caught

=head1 VERSION

version 0.007

=head1 SYNOPSIS

Test file:

    use strict;
    use warnings;
    use Test::More;
    use Test::FailWarnings;

    ok( 1, "first test" );
    ok( 1 + "lkadjaks", "add non-numeric" );

    done_testing;

Output:

    ok 1 - first test
    not ok 2 - Test::FailWarnings should catch no warnings
    #   Failed test 'Test::FailWarnings should catch no warnings'
    #   at t/bin/main-warn.pl line 7.
    # Warning was 'Argument "lkadjaks" isn't numeric in addition (+) at t/bin/main-warn.pl line 7.'
    ok 3 - add non-numeric
    1..3
    # Looks like you failed 1 test of 3.

=head1 DESCRIPTION

This module hooks C<$SIG{__WARN__}> and converts warnings to L<Test::More>
C<fail()> calls.  It is designed to be used with C<done_testing>, when you
don't need to know the test count in advance.

Just as with L<Test::NoWarnings>, this does not catch warnings if other things
localize C<$SIG{__WARN__}>, as this is designed to catch I<unhandled> warnings.

=for Pod::Coverage handler

=head1 USAGE

=head2 Overriding C<$SIG{__WARN__}>

On C<import>, C<$SIG{__WARN__}> is replaced with
C<Test::FailWarnings::handler>.

    use Test::FailWarnings;  # global

If you don't want global replacement, require the module instead and localize
in whatever scope you want.

    require Test::FailWarnings;

    {
        local $SIG{__WARN__} = \&Test::FailWarnings::handler;
        # ... warnings will issue fail() here
    }

When the handler reports on the source of the warning, it will look past
any calling packages starting with C<Carp> or C<warnings> to try to detect
the real origin of the warning.

=head2 Allowing warnings from dependencies

If you want to ignore failures from outside your own code, you can set
C<$Test::FailWarnings::ALLOW_DEPS> to a true value.  You can
do that on the C<use> line with C<< -allow_deps >>.

    use Test::FailWarnings -allow_deps => 1;

When true, warnings will only be thrown if they appear to originate from a filename
matching C<< qr/^(?:t|xt|lib|blib)/ >>

=head2 Allowing warnings from specific modules

If you want to white-list specific modules only, you can add their package
names to C<@Test::NoWarnings::ALLOW_FROM>.  You can do that on the C<use> line
with C<< -allow_from >>.

    use Test::FailWarnings -allow_from => [ qw/Annoying::Module/ ];

=head1 SEE ALSO

=over 4

=item *

L<Test::NoWarnings> -- catches warnings and reports in an C<END> block.  Not (yet) friendly with C<done_testing>.

=item *

L<Test::Warnings> -- a replacement for Test::NoWarnings that works with done_testing

=item *

L<Test::Warn> -- test for warnings without triggering failures from this modules

=back

=for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan

=head1 SUPPORT

=head2 Bugs / Feature Requests

Please report any bugs or feature requests through the issue tracker
at L<https://github.com/dagolden/test-failwarnings/issues>.
You will be notified automatically of any progress on your issue.

=head2 Source Code

This is open source software.  The code repository is available for
public review and contribution under the terms of the license.

L<https://github.com/dagolden/test-failwarnings>

  git clone git://github.com/dagolden/test-failwarnings.git

=head1 AUTHOR

David Golden <dagolden@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is Copyright (c) 2013 by David Golden.

This is free software, licensed under:

  The Apache License, Version 2.0, January 2004

=cut