# 07_warning.t
#
# test suite for Regexp::Assemble
# Make sure warnings are emitted when asked for
#
# copyright (C) 2005-2006 David Landgren
use constant WARN_TESTS => 6;
eval qq{use Test::More tests => WARN_TESTS};
if( $@ ) {
warn "# Test::More not available, no tests performed\n";
print "1..1\nok 1\n";
exit 0;
}
my $have_Test_Warn;
BEGIN {
$have_Test_Warn = do {
eval "use Test::Warn";
$@ ? 0 : 1;
};
}
use Regexp::Assemble;
SKIP: {
skip( 'Test::Warn not installed on this system', WARN_TESTS )
unless $have_Test_Warn;
my $ra = Regexp::Assemble->new( dup_warn => 1 )
->add( qw( abc def ghi ));
my $rax = Regexp::Assemble->new( dup_warn => 0 )
->add( qw( abc def ghi ));
my $ram = Regexp::Assemble->new->dup_warn
->add( qw( abc def ghi ));
warning_is { $rax->add( 'def' ) } { carped => "" }, "do not carp explicit";
SKIP: {
skip( "Sub::Uplevel version $Sub::Uplevel::VERSION broken on 5.8.8, 0.13 or better required", 2 )
if $] == 5.008008 and $Sub::Uplevel::VERSION < 0.13;
warning_like { $ra->add('def') } qr(duplicate pattern added: /def/ at \S+ line \d+\s*),
"carp duplicate pattern, warn from new";
warning_like { $ram->add('abc') } qr(duplicate pattern added: /abc/ at \S+ line \d+\s*),
"carp duplicate pattern, warn from method";
}
$ra->dup_warn(0);
warning_is { $ra->add( 'ghi' ) } { carped => "" }, "do not carp";
$ra->dup_warn(1);
my $dup_count = 0;
$ra->dup_warn( sub { ++$dup_count } );
$ra->add( 'abc' );
cmp_ok( $dup_count, 'eq', 1, 'dup callback' );
$ra->dup_warn(
sub {
warn join('-', @{$_[-1]})
}
);
$ra->add( 'dup' );
warning_is { $ra->add( 'dup' ) } 'd-u-p',
"custom carp duplicate pattern";
} # SKIP