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