fix re debug segvs in global destruction, and a tweak to Benchmark to prevent infinit...
[p5sagit/p5-mst-13.2.git] / ext / re / t / re.t
CommitLineData
93c8c1bf 1#!./perl
2
93c8c1bf 3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '../lib';
2628e9ce 6 require Config;
7 if (($Config::Config{'extensions'} !~ /\bre\b/) ){
8 print "1..0 # Skip -- Perl configured without re module\n";
9 exit 0;
10 }
93c8c1bf 11}
12
4940c443 13use strict;
14
07be1b83 15use Test::More tests => 14;
93c8c1bf 16require_ok( 're' );
17
18# setcolor
19$INC{ 'Term/Cap.pm' } = 1;
20local $ENV{PERL_RE_TC};
21re::setcolor();
22is( $ENV{PERL_RE_COLORS}, "md\tme\tso\tse\tus\tue",
23 'setcolor() should provide default colors' );
24$ENV{PERL_RE_TC} = 'su,n,ny';
25re::setcolor();
26is( $ENV{PERL_RE_COLORS}, "su\tn\tny", '... or use $ENV{PERL_RE_COLORS}' );
27
28# bits
29# get on
30my $warn;
31local $SIG{__WARN__} = sub {
32 $warn = shift;
33};
34eval { re::bits(1) };
35like( $warn, qr/Useless use/, 'bits() should warn with no args' );
36
37delete $ENV{PERL_RE_COLORS};
38re::bits(0, 'debug');
4940c443 39is( $ENV{PERL_RE_COLORS}, undef,
93c8c1bf 40 "... should not set regex colors given 'debug'" );
41re::bits(0, 'debugcolor');
42isnt( $ENV{PERL_RE_COLORS}, '',
43 "... should set regex colors given 'debugcolor'" );
44re::bits(0, 'nosuchsubpragma');
45like( $warn, qr/Unknown "re" subpragma/,
46 '... should warn about unknown subpragma' );
47ok( re::bits(0, 'taint') & 0x00100000, '... should set taint bits' );
48ok( re::bits(0, 'eval') & 0x00200000, '... should set eval bits' );
49
50local $^H;
51
52# import
53re->import('taint', 'eval');
54ok( $^H & 0x00100000, 'import should set taint bits in $^H when requested' );
55ok( $^H & 0x00200000, 'import should set eval bits in $^H when requested' );
56
57re->unimport('taint');
58ok( !( $^H & 0x00100000 ), 'unimport should clear bits in $^H when requested' );
59re->unimport('eval');
60ok( !( $^H & 0x00200000 ), '... and again' );
07be1b83 61my $reg=qr/(foo|bar|baz|blah)/;
62close STDERR;
63eval"use re Debug=>'ALL'";
64my $ok='foo'=~/$reg/;
65eval"no re Debug=>'ALL'";
66ok( $ok, 'No segv!' );
67
93c8c1bf 68
69package Term::Cap;
70
71sub Tgetent {
72 bless({}, $_[0]);
73}
74
75sub Tputs {
76 return $_[1];
77}