stock perl 5.8.0 from CPAN

4 files changed, 136 insertions, 25 deletions

diff --git a/gnu/usr.bin/perl/ext/re/Makefile.PL b/gnu/usr.bin/perl/ext/re/Makefile.PL
index bc31b2c2cc6..51573af05c9 100644
--- a/gnu/usr.bin/perl/ext/re/Makefile.PL
+++ b/gnu/usr.bin/perl/ext/re/Makefile.PL
@@ -1,13 +1,18 @@
 use ExtUtils::MakeMaker;
 use File::Spec;
+use Config;
+
+my $object = 're_exec$(OBJ_EXT) re_comp$(OBJ_EXT) re$(OBJ_EXT)';
+
+my $defines = '-DPERL_EXT_RE_BUILD -DPERL_EXT_RE_DEBUG';
 
 WriteMakefile(
     NAME		=> 're',
     VERSION_FROM	=> 're.pm',
     MAN3PODS		=> {}, 	# Pods will be built by installman.
     XSPROTOARG		=> '-noprototypes',
-    OBJECT		=> 're_exec$(OBJ_EXT) re_comp$(OBJ_EXT) re$(OBJ_EXT)',
-    DEFINE		=> '-DPERL_EXT_RE_BUILD -DPERL_EXT_RE_DEBUG',
+    OBJECT		=> $object,
+    DEFINE             => $defines,
     clean		=> { FILES => '*$(OBJ_EXT) *.c ../../lib/re.pm' },
 );
 
@@ -36,3 +41,22 @@ re_exec\$(OBJ_EXT) : re_exec.c
 
 EOF
 }
+
+sub MY::c_o {
+    my($self) = @_;
+    package MY; # so that "SUPER" works right
+    my $inh = $self->SUPER::c_o(@_);
+    use Config;
+    if ($Config{osname} eq 'aix' && $Config{ccversion} eq '5.0.1.0') {
+	# Known buggy optimizer.
+	my $cccmd = $self->const_cccmd;
+	$cccmd =~ s/^CCCMD\s*=\s*//;
+	$cccmd =~ s/\s\$\(OPTIMIZE\)\s/ /;
+	$inh .= qq{
+
+re_comp\$\(OBJ_EXT\): re_comp.c
+\t$cccmd \$(CCCDLFLAGS) -I\$(PERL_INC) \$(DEFINE) \$*.c
+};
+    }
+    $inh;
+}
diff --git a/gnu/usr.bin/perl/ext/re/re.pm b/gnu/usr.bin/perl/ext/re/re.pm
index 3f142d9de48..95e25407607 100644
--- a/gnu/usr.bin/perl/ext/re/re.pm
+++ b/gnu/usr.bin/perl/ext/re/re.pm
@@ -1,6 +1,6 @@
 package re;
 
-$VERSION = 0.02;
+our $VERSION = 0.03;
 
 =head1 NAME
 
@@ -42,21 +42,21 @@ other transformations.
 
 When C<use re 'eval'> is in effect, a regex is allowed to contain
 C<(?{ ... })> zero-width assertions even if regular expression contains
-variable interpolation.  That is normally disallowed, since it is a 
+variable interpolation.  That is normally disallowed, since it is a
 potential security risk.  Note that this pragma is ignored when the regular
 expression is obtained from tainted data, i.e.  evaluation is always
 disallowed with tainted regular expresssions.  See L<perlre/(?{ code })>.
 
-For the purpose of this pragma, interpolation of precompiled regular 
+For the purpose of this pragma, interpolation of precompiled regular
 expressions (i.e., the result of C<qr//>) is I<not> considered variable
 interpolation.  Thus:
 
     /foo${pat}bar/
 
-I<is> allowed if $pat is a precompiled regular expression, even 
+I<is> allowed if $pat is a precompiled regular expression, even
 if $pat contains C<(?{ ... })> assertions.
 
-When C<use re 'debug'> is in effect, perl emits debugging messages when 
+When C<use re 'debug'> is in effect, perl emits debugging messages when
 compiling and using regular expressions.  The output is the same as that
 obtained by running a C<-DDEBUGGING>-enabled perl interpreter with the
 B<-Dr> switch. It may be quite voluminous depending on the complexity
@@ -64,7 +64,7 @@ of the match.  Using C<debugcolor> instead of C<debug> enables a
 form of output that can be used to get a colorful display on terminals
 that understand termcap color sequences.  Set C<$ENV{PERL_RE_TC}> to a
 comma-separated list of C<termcap> properties to use for highlighting
-strings on/off, pre-point part on/off.  
+strings on/off, pre-point part on/off.
 See L<perldebug/"Debugging regular expressions"> for additional info.
 
 The directive C<use re 'debug'> is I<not lexically scoped>, as the
@@ -77,8 +77,8 @@ See L<perlmodlib/Pragmatic Modules>.
 # N.B. File::Basename contains a literal for 'taint' as a fallback.  If
 # taint is changed here, File::Basename must be updated as well.
 my %bitmask = (
-taint	=> 0x00100000,
-eval	=> 0x00200000,
+taint		=> 0x00100000,
+eval		=> 0x00200000,
 );
 
 sub setcolor {
@@ -98,7 +98,7 @@ sub setcolor {
 sub bits {
     my $on = shift;
     my $bits = 0;
-    unless(@_) {
+    unless (@_) {
 	require Carp;
 	Carp::carp("Useless use of \"re\" pragma");
     }
@@ -111,19 +111,24 @@ sub bits {
 	  uninstall() unless $on;
 	  next;
       }
-      $bits |= $bitmask{$s} || 0;
+      if (exists $bitmask{$s}) {
+	  $bits |= $bitmask{$s};
+      } else {
+	  require Carp;
+	  Carp::carp("Unknown \"re\" subpragma '$s' (known ones are: @{[join(', ', map {qq('$_')} 'debug', 'debugcolor', sort keys %bitmask)]})");
+      }
     }
     $bits;
 }
 
 sub import {
     shift;
-    $^H |= bits(1,@_);
+    $^H |= bits(1, @_);
 }
 
 sub unimport {
     shift;
-    $^H &= ~ bits(0,@_);
+    $^H &= ~ bits(0, @_);
 }
 
 1;
diff --git a/gnu/usr.bin/perl/ext/re/re.t b/gnu/usr.bin/perl/ext/re/re.t
new file mode 100644
index 00000000000..1a8f278566d
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/re/re.t
@@ -0,0 +1,65 @@
+#!./perl
+
+BEGIN {
+	chdir 't' if -d 't';
+	@INC = '../lib';
+}
+
+use strict;
+
+use Test::More tests => 13;
+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}, undef,
+	"... 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];
+}
diff --git a/gnu/usr.bin/perl/ext/re/re.xs b/gnu/usr.bin/perl/ext/re/re.xs
index 25c2a90d60f..11239d7e59d 100644
--- a/gnu/usr.bin/perl/ext/re/re.xs
+++ b/gnu/usr.bin/perl/ext/re/re.xs
@@ -1,5 +1,4 @@
-/* We need access to debugger hooks */
-#ifndef DEBUGGING
+#if defined(PERL_EXT_RE_DEBUG) && !defined(DEBUGGING)
 #  define DEBUGGING
 #endif
 
@@ -8,6 +7,8 @@
 #include "perl.h"
 #include "XSUB.h"
 
+START_EXTERN_C
+
 extern regexp*	my_regcomp (pTHX_ char* exp, char* xend, PMOP* pm);
 extern I32	my_regexec (pTHX_ regexp* prog, char* stringarg, char* strend,
 			    char* strbeg, I32 minend, SV* screamer,
@@ -18,44 +19,60 @@ extern char*	my_re_intuit_start (pTHX_ regexp *prog, SV *sv, char *strpos,
 				    struct re_scream_pos_data_s *data);
 extern SV*	my_re_intuit_string (pTHX_ regexp *prog);
 
-static int oldfl;
+END_EXTERN_C
+
+#define MY_CXT_KEY "re::_guts" XS_VERSION
+
+typedef struct {
+    int		x_oldflag;		/* debug flag */
+} my_cxt_t;
+
+START_MY_CXT
 
-#define R_DB 512
+#define oldflag		(MY_CXT.x_oldflag)
 
 static void
-deinstall(pTHX)
+uninstall(pTHX)
 {
+    dMY_CXT;
     PL_regexecp = Perl_regexec_flags;
     PL_regcompp = Perl_pregcomp;
     PL_regint_start = Perl_re_intuit_start;
     PL_regint_string = Perl_re_intuit_string;
     PL_regfree = Perl_pregfree;
 
-    if (!oldfl)
-	PL_debug &= ~R_DB;
+    if (!oldflag)
+	PL_debug &= ~DEBUG_r_FLAG;
 }
 
 static void
 install(pTHX)
 {
+    dMY_CXT;
     PL_colorset = 0;			/* Allow reinspection of ENV. */
     PL_regexecp = &my_regexec;
     PL_regcompp = &my_regcomp;
     PL_regint_start = &my_re_intuit_start;
     PL_regint_string = &my_re_intuit_string;
     PL_regfree = &my_regfree;
-    oldfl = PL_debug & R_DB;
-    PL_debug |= R_DB;
+    oldflag = PL_debug & DEBUG_r_FLAG;
+    PL_debug |= DEBUG_r_FLAG;
 }
 
 MODULE = re	PACKAGE = re
 
+BOOT:
+{
+   MY_CXT_INIT;
+}
+
+
 void
 install()
   CODE:
     install(aTHX);
 
 void
-deinstall()
+uninstall()
   CODE:
-    deinstall(aTHX);
+    uninstall(aTHX);