Here are tests for everything but the 'debug' subpragma of the re pragma.
That'll take a bit more scary regex-fu than I have at the moment. Anyone who
is daring enough to change re.pm, re.xs, or re.c, though, now has no excuse for
improving the tests.
-- c
--- ~MANIFEST Sat Dec 15 23:53:50 2001
+++ MANIFEST Sat Dec 15 23:54:17 2001
@@ -494,6 +494,7 @@
ext/re/hints/mpeix.pl Hints for re for named architecture
ext/re/Makefile.PL re extension makefile writer
ext/re/re.pm re extension Perl module
+ext/re/re.t see if re pragma works
ext/re/re.xs re extension external subroutines
ext/Safe/safe1.t See if Safe works
ext/Safe/safe2.t See if Safe works
--- /dev/null Thu Aug 30 03:54:37 2001
+++ ext/re/re.t Sat Dec 15 23:53:39 2001
@@ -0,0 +1,64 @@
+#!./perl
+
+use strict;
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+use Test::More 'no_plan';
+require_ok( 're' );
+
+# setcolor
+$INC{ 'Term/Cap.pm' } = 1;
+local $ENV{PERL_RE_TC};
+re::setcolor();
+is( $ENV{PERL_RE_COLORS}, "md\tme\tso\tse\tus\tue",
+ 'setcolor() should provide default colors' );
+$ENV{PERL_RE_TC} = 'su,n,ny';
+re::setcolor();
+is( $ENV{PERL_RE_COLORS}, "su\tn\tny", '... or use $ENV{PERL_RE_COLORS}' );
+
+# bits
+my $warn;
+local $SIG{__WARN__} = sub {
+ $warn = shift;
+};
+eval { re::bits(1) };
+like( $warn, qr/Useless use/, 'bits() should warn with no args' );
+
+delete $ENV{PERL_RE_COLORS};
+re::bits(0, 'debug');
+is( $ENV{PERL_RE_COLORS}, '',
+ "... should not set regex colors given 'debug'" );
+re::bits(0, 'debugcolor');
+isnt( $ENV{PERL_RE_COLORS}, '',
+ "... should set regex colors given 'debugcolor'" );
+re::bits(0, 'nosuchsubpragma');
+like( $warn, qr/Unknown "re" subpragma/,
+ '... should warn about unknown subpragma' );
+ok( re::bits(0, 'taint') & 0x00100000, '... should set taint bits' );
+ok( re::bits(0, 'eval') & 0x00200000, '... should set eval bits' );
+
+local $^H;
+
+# import
+re->import('taint', 'eval');
+ok( $^H & 0x00100000, 'import should set taint bits in $^H when requested' );
+ok( $^H & 0x00200000, 'import should set eval bits in $^H when requested' );
+
+re->unimport('taint');
+isnt( $^H & 0x00100000, 1, 'unimport should clear bits in $^H when requested' );
+re->unimport('eval');
+isnt( $^H & 0x00200000, 1, '... and again' );
+
+package Term::Cap;
+
+sub Tgetent {
+ bless({}, $_[0]);
+}
+
+sub Tputs {
+ return $_[1];
+}
