[REPATCH MANIFEST, ext/re/re.t] Tests for re pragma

Message-ID: <20011220231726.23878.qmail@onion.perl.org>

p4raw-id: //depot/perl@13827

2 files changed, 66 insertions, 0 deletions

diff --git a/MANIFEST b/MANIFEST
index 248cd7808d..8cfa207e2b 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -499,6 +499,7 @@ ext/POSIX/typemap		POSIX extension interface types
 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
diff --git a/ext/re/re.t b/ext/re/re.t
new file mode 100644
index 0000000000..bc697a3e67
--- /dev/null
+++ b/ext/re/re.t
@@ -0,0 +1,65 @@
+#!./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
+# get on
+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');
+ok( !( $^H & 0x00100000 ), 'unimport should clear bits in $^H when requested' );
+re->unimport('eval');
+ok( !( $^H & 0x00200000 ), '... and again' );
+
+package Term::Cap;
+
+sub Tgetent {
+	bless({}, $_[0]);
+}
+
+sub Tputs {
+	return $_[1];
+}