1#!./perl 2 3BEGIN { 4 require Config; 5 if (($Config::Config{'extensions'} !~ /\bre\b/) ){ 6 print "1..0 # Skip -- Perl configured without re module\n"; 7 exit 0; 8 } 9} 10 11use strict; 12 13use Test::More tests => 15; 14require_ok( 're' ); 15 16# setcolor 17$INC{ 'Term/Cap.pm' } = 1; 18local $ENV{PERL_RE_TC}; 19re::setcolor(); 20is( $ENV{PERL_RE_COLORS}, "md\tme\tso\tse\tus\tue", 21 'setcolor() should provide default colors' ); 22$ENV{PERL_RE_TC} = 'su,n,ny'; 23re::setcolor(); 24is( $ENV{PERL_RE_COLORS}, "su\tn\tny", '... or use $ENV{PERL_RE_COLORS}' ); 25 26# bits 27# get on 28my $warn; 29local $SIG{__WARN__} = sub { 30 $warn = shift; 31}; 32#eval { re::bits(1) }; 33#like( $warn, qr/Useless use/, 'bits() should warn with no args' ); 34 35delete $ENV{PERL_RE_COLORS}; 36re::bits(0, 'debug'); 37is( $ENV{PERL_RE_COLORS}, undef, 38 "... should not set regex colors given 'debug'" ); 39re::bits(0, 'debugcolor'); 40isnt( $ENV{PERL_RE_COLORS}, '', 41 "... should set regex colors given 'debugcolor'" ); 42re::bits(0, 'nosuchsubpragma'); 43like( $warn, qr/Unknown "re" subpragma/, 44 '... should warn about unknown subpragma' ); 45ok( re::bits(0, 'taint') & 0x00100000, '... should set taint bits' ); 46ok( re::bits(0, 'eval') & 0x00200000, '... should set eval bits' ); 47 48local $^H; 49 50# import 51re->import('taint', 'eval'); 52ok( $^H & 0x00100000, 'import should set taint bits in $^H when requested' ); 53ok( $^H & 0x00200000, 'import should set eval bits in $^H when requested' ); 54 55re->unimport('taint'); 56ok( !( $^H & 0x00100000 ), 'unimport should clear bits in $^H when requested' ); 57re->unimport('eval'); 58ok( !( $^H & 0x00200000 ), '... and again' ); 59my $reg=qr/(foo|bar|baz|blah)/; 60close STDERR; 61eval"use re Debug=>'ALL'"; 62my $ok='foo'=~/$reg/; 63eval"no re Debug=>'ALL'"; 64ok( $ok, 'No segv!' ); 65 66my $message = "Don't tread on me"; 67$_ = $message; 68re->import("/aa"); 69is($_, $message, "re doesn't clobber \$_"); 70 71package Term::Cap; 72 73sub Tgetent { 74 bless({}, $_[0]); 75} 76 77sub Tputs { 78 return $_[1]; 79} 80 81package main; 82 83{ 84 my $w; 85 local $SIG{__WARN__} = sub { warn shift; ++$w }; 86 re->import(); 87 is $w, undef, 'no warning for "use re;" (which is not useless)'; 88} 89