package tests::LrMatchTest; use strict; use base qw/Lire::Test::TestCase/; use Lire::SQLExt::LrMatch; sub test_lr_match { my $self = $_[0]; $self->assert_died( sub { Lire::SQLExt::LrMatch::lr_match( '', undef, undef ) }, qr/missing 're' parameter/ ); foreach my $test ( # Value, RE, CS, Result [ 'ANOTHER STRING', 'str', 1, 0 ], [ 'ANOTHER STRING', 'str', 0, 1 ], [ undef, 'test$', 0, 0 ], [ 'a test', 'test$', 0, 1 ], [ 'a test failing', 'test$', 0, 0 ], [ 'A 123 number', '\d+', 0, 1 ] ) { my ( $value, $re, $cs, $result ) = @$test; my @warnings = (); local $SIG{'__WARN__'} = sub { push @warnings, join( "", @_); $self->annotate( $warnings[-1] ); }; $self->assert( Lire::SQLExt::LrMatch::lr_match( $value, $re, $cs ) == $result, "lr_match( '".($value || 'undef' )."', '$re', $cs ) != $result" ); my $rx = $Lire::SQLExt::LrMatch::RE_CACHE{$re}; $self->assert_not_null( $rx, "'$re' wasn't cached" ); $self->assert( ref( $rx ) eq 'Regexp', "$rx' isn't a Regexp reference" ); $self->assert_equals( 0, scalar @warnings ); } } 1;