ext/re/re.t

   1 #!./perl
   2
   3 BEGIN {
   4         chdir 't' if -d 't';
   5         @INC = '../lib';
   6 }
   7
   8 use strict;
   9
  10 use Test::More tests => 13;
  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}, undef,
  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 }