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