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