1#!./perl 2 3BEGIN { 4 chdir 't' if -d 't'; 5 @INC = '../lib'; 6} 7 8use strict; 9 10use Test::More tests => 13; 11require_ok( 're' ); 12 13# setcolor 14$INC{ 'Term/Cap.pm' } = 1; 15local $ENV{PERL_RE_TC}; 16re::setcolor(); 17is( $ENV{PERL_RE_COLORS}, "md\tme\tso\tse\tus\tue", 18 'setcolor() should provide default colors' ); 19$ENV{PERL_RE_TC} = 'su,n,ny'; 20re::setcolor(); 21is( $ENV{PERL_RE_COLORS}, "su\tn\tny", '... or use $ENV{PERL_RE_COLORS}' ); 22 23# bits 24# get on 25my $warn; 26local $SIG{__WARN__} = sub { 27 $warn = shift; 28}; 29eval { re::bits(1) }; 30like( $warn, qr/Useless use/, 'bits() should warn with no args' ); 31 32delete $ENV{PERL_RE_COLORS}; 33re::bits(0, 'debug'); 34is( $ENV{PERL_RE_COLORS}, undef, 35 "... should not set regex colors given 'debug'" ); 36re::bits(0, 'debugcolor'); 37isnt( $ENV{PERL_RE_COLORS}, '', 38 "... should set regex colors given 'debugcolor'" ); 39re::bits(0, 'nosuchsubpragma'); 40like( $warn, qr/Unknown "re" subpragma/, 41 '... should warn about unknown subpragma' ); 42ok( re::bits(0, 'taint') & 0x00100000, '... should set taint bits' ); 43ok( re::bits(0, 'eval') & 0x00200000, '... should set eval bits' ); 44 45local $^H; 46 47# import 48re->import('taint', 'eval'); 49ok( $^H & 0x00100000, 'import should set taint bits in $^H when requested' ); 50ok( $^H & 0x00200000, 'import should set eval bits in $^H when requested' ); 51 52re->unimport('taint'); 53ok( !( $^H & 0x00100000 ), 'unimport should clear bits in $^H when requested' ); 54re->unimport('eval'); 55ok( !( $^H & 0x00200000 ), '... and again' ); 56 57package Term::Cap; 58 59sub Tgetent { 60 bless({}, $_[0]); 61} 62 63sub Tputs { 64 return $_[1]; 65} 66