1#!/usr/bin/perl -w 2 3BEGIN { 4 if( $ENV{PERL_CORE} ) { 5 chdir 't'; 6 @INC = ('../lib', 'lib'); 7 } 8 else { 9 unshift @INC, 't/lib'; 10 } 11} 12 13use strict; 14use Test::More tests => 16; 15 16use Test::Builder; 17my $Test = Test::Builder->new; 18 19my $r = $Test->maybe_regex(qr/^FOO$/i); 20ok(defined $r, 'qr// detected'); 21ok(('foo' =~ /$r/), 'qr// good match'); 22ok(('bar' !~ /$r/), 'qr// bad match'); 23 24SKIP: { 25 skip "blessed regex checker added in 5.10", 3 if $] < 5.010; 26 27 my $obj = bless qr/foo/, 'Wibble'; 28 my $re = $Test->maybe_regex($obj); 29 ok( defined $re, "blessed regex detected" ); 30 ok( ('foo' =~ /$re/), 'blessed qr/foo/ good match' ); 31 ok( ('bar' !~ /$re/), 'blessed qr/foo/ bad math' ); 32} 33 34{ 35 my $r = $Test->maybe_regex('/^BAR$/i'); 36 ok(defined $r, '"//" detected'); 37 ok(('bar' =~ m/$r/), '"//" good match'); 38 ok(('foo' !~ m/$r/), '"//" bad match'); 39}; 40 41{ 42 my $r = $Test->maybe_regex('not a regex'); 43 ok(!defined $r, 'non-regex detected'); 44}; 45 46 47{ 48 my $r = $Test->maybe_regex('/0/'); 49 ok(defined $r, 'non-regex detected'); 50 ok(('f00' =~ m/$r/), '"//" good match'); 51 ok(('b4r' !~ m/$r/), '"//" bad match'); 52}; 53 54 55{ 56 my $r = $Test->maybe_regex('m,foo,i'); 57 ok(defined $r, 'm,, detected'); 58 ok(('fOO' =~ m/$r/), '"//" good match'); 59 ok(('bar' !~ m/$r/), '"//" bad match'); 60}; 61