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