develooper Front page | perl.perl5.changes | Postings from May 2008

Change 33955: Integrate:

From:
Dave Mitchell
Date:
May 30, 2008 19:00
Subject:
Change 33955: Integrate:
Change 33955 by davem@davem-pigeon on 2008/05/31 01:54:46

	Integrate:
	[ 33851]
	Fix for [perl #51848] Deparse interpolation in regex literal
	
	[ 33854]
	DEBUG_LEAKING_SCALARS wasn't reporting the correct line number
	of SVs allocated at runtime
	
	[ 33869]
	Subject: [PATCH] correct errors / omissions in documenting DOES
	From: Ricardo SIGNES <perl.p5p@rjbs.manxome.org>
	Date: Mon, 19 May 2008 10:14:02 -0400
	Message-ID: <20080519141402.GA54401@knight.local>
	
	[ 33874]
	Subject: Re: [PATCH: TODO Tests] Re: [perl #53806] No complain about bareword
	From: "Rafael Garcia-Suarez" <rgarciasuarez@gmail.com>
	Date: Tue, 20 May 2008 09:45:19 +0200
	Message-ID: <b77c1dce0805200045i1000598ci13c9cb3a29f64b6d@mail.gmail.com>
	
	[ 33876]
	Subject: Re: [PATCH: TODO Tests] Re: [perl #53806] No complain about bareword
	From: "Rafael Garcia-Suarez" <rgarciasuarez@gmail.com>
	Date: Tue, 20 May 2008 10:14:28 +0200
	Message-ID: <b77c1dce0805200114o5df69d8br9a02de5a508c3462@mail.gmail.com>
	
	[ 33890]
	The TODO tests of change 33876 were actually fixed by change 33874.
	
	[ 33896]
	Eliminate POSIX::int_macro_int, and all the complex AUTOLOAD fandango
	that creates closures round it. Instead, wrap WEXITSTATUS, WIFEXITED,
	WIFSIGNALED, WIFSTOPPED, WSTOPSIG and WTERMSIG directly with XS.
	The shared library is slightly larger, but dynamic memory usage savings
	beat this, even within one thread of one process. Simpler code too.
	
	[ 33897]
	Replaced the WEXITSTATUS, WIFEXITED, WIFSIGNALED, WIFSTOPPED, WSTOPSIG
	and WTERMSIG wrappers with one wrapper using the XS "ALIAS" feature.
	This gets the shared object size back below the size before the removal
	of int_macro_int. It looks like there are other space savings to be
	made this way.
	
	[ 33898]
	Subject: Re: [perl #54566] assertion failure fiddling with @ISA
	From: "Rafael Garcia-Suarez" <rgarciasuarez@gmail.com>
	Date: Wed, 21 May 2008 14:42:48 +0200
	Message-ID: <b77c1dce0805210542l164caf85k86a34feae25ca9a7@mail.gmail.com>
	
	[ 33909]
	Subject: [DOC PATCH] Memoize.pm refers to old title of "Higher Order Perl"
	From: Moritz Lenz <moritz@casella.verplant.org>
	Date: Thu, 22 May 2008 15:47:04 +0200
	Message-ID: <48357958.2050501@casella.verplant.org>
	
	[ 33927]
	Subject: [PATCH] lib.pm should not warn about loading .par files
	From: Paul Fenwick <pjf@perltraining.com.au>
	Date: Thu, 22 May 2008 23:24:34 +1000
	Message-ID: <48357412.5020703@perltraining.com.au>
	
	[ 33936]
	My recent changes to POSIX.xs forgot that WEXITSTATUS etc may not even
	be defined. This fix changes the error message from "Your vendor has
	not defined POSIX macro %s, used" to "POSIX::%s not implemented on
	this architecture", which I assume is not going to break anything.
	
	[ 33937]
	[perl #54758] Perl 5.10 memory corruption
	When @a = sort @a is pessimised if @a has magic,
	growing the stack requires various pointers to be reset in case
	the stack gets reallocated.
	
	[ 33939]
	Revert part of #31039
	
	[ 33949]
	
	Subject: [PATCH] Propagate new i_gdbm*ndbm variables
	From: Andy Dougherty <doughera@lafayette.edu>
	Date: Thu, 29 May 2008 12:43:29 -0400 (EDT)
	Message-ID: <Pine.LNX.4.64.0805291241070.365@fractal.phys.lafayette.edu>
	
	[ 33951]
	Add index() tests for embedded nulls
	
	Subject:  Re: [perl #53746] bug with index() matching beyond end of string when \0 bytes (00000000) are involved
	From:  Abigail <abigail@abigail.be>
	Date:  Tue, 6 May 2008 14:57:36 +0200
	Message-Id:  <20080506125736.GC17310@abigail.be>
	
	[ 33952]
	[perl #53746] bug with index() matching beyond end of string
	An off-by-one error meant that index($str,...)
	was effectively being executed as index("$str\0", ...).
	Probably introduced by change #26511.

Affected files ...

... //depot/maint-5.10/perl/Configure#10 integrate
... //depot/maint-5.10/perl/Cross/config.sh-arm-linux#6 integrate
... //depot/maint-5.10/perl/NetWare/config.wc#6 integrate
... //depot/maint-5.10/perl/Porting/config.sh#6 integrate
... //depot/maint-5.10/perl/configure.com#9 integrate
... //depot/maint-5.10/perl/epoc/config.sh#6 integrate
... //depot/maint-5.10/perl/ext/B/B/Deparse.pm#7 integrate
... //depot/maint-5.10/perl/ext/B/t/concise-xs.t#3 integrate
... //depot/maint-5.10/perl/ext/B/t/deparse.t#6 integrate
... //depot/maint-5.10/perl/ext/POSIX/POSIX.pm#4 integrate
... //depot/maint-5.10/perl/ext/POSIX/POSIX.xs#4 integrate
... //depot/maint-5.10/perl/lib/Memoize.pm#2 integrate
... //depot/maint-5.10/perl/lib/UNIVERSAL.pm#2 integrate
... //depot/maint-5.10/perl/lib/lib_pm.PL#2 integrate
... //depot/maint-5.10/perl/lib/strict.t#2 integrate
... //depot/maint-5.10/perl/mg.c#13 integrate
... //depot/maint-5.10/perl/plan9/config_sh.sample#6 integrate
... //depot/maint-5.10/perl/pod/perlobj.pod#2 integrate
... //depot/maint-5.10/perl/pod/perltodo.pod#12 integrate
... //depot/maint-5.10/perl/pp_sort.c#2 integrate
... //depot/maint-5.10/perl/sv.c#19 integrate
... //depot/maint-5.10/perl/symbian/config.sh#6 integrate
... //depot/maint-5.10/perl/t/lib/strict/subs#2 integrate
... //depot/maint-5.10/perl/t/op/index.t#3 integrate
... //depot/maint-5.10/perl/toke.c#8 integrate
... //depot/maint-5.10/perl/uconfig.sh#7 integrate
... //depot/maint-5.10/perl/util.c#5 integrate
... //depot/maint-5.10/perl/win32/config.bc#6 integrate
... //depot/maint-5.10/perl/win32/config.ce#6 integrate
... //depot/maint-5.10/perl/win32/config.gc#7 integrate
... //depot/maint-5.10/perl/win32/config.vc#7 integrate
... //depot/maint-5.10/perl/win32/config.vc64#7 integrate

Differences ...

==== //depot/maint-5.10/perl/Configure#10 (xtext) ====
Index: perl/Configure
--- perl/Configure#9~33904~	2008-05-21 09:37:54.000000000 -0700
+++ perl/Configure	2008-05-30 18:54:46.000000000 -0700
@@ -25,7 +25,7 @@
 
 # $Id: Head.U 6 2006-08-25 22:21:46Z rmanfredi $
 #
-# Generated on Tue May 20 17:29:22 CEST 2008 [metaconfig 3.5 PL0]
+# Generated on Tue May 27 17:17:47 CEST 2008 [metaconfig 3.5 PL0]
 # (with additional metaconfig patches by perlbug@perl.org)
 
 cat >c1$$ <<EOF
@@ -19093,7 +19093,7 @@
 			fi
 		fi
 	fi
-	$rm_try
+	$rm -f core try.core core.try.*
 	case "$fflushNULL" in
 	x)	$cat >&4 <<EOM
 Your fflush(NULL) works okay for output streams.

==== //depot/maint-5.10/perl/Cross/config.sh-arm-linux#6 (text) ====
Index: perl/Cross/config.sh-arm-linux
--- perl/Cross/config.sh-arm-linux#5~33894~	2008-05-20 16:39:57.000000000 -0700
+++ perl/Cross/config.sh-arm-linux	2008-05-30 18:54:46.000000000 -0700
@@ -625,6 +625,8 @@
 i_fp='undef'
 i_fp_class='undef'
 i_gdbm='undef'
+i_gdbm_ndbm='undef'
+i_gdbmndbm='undef'
 i_grp='define'
 i_ieeefp='undef'
 i_inttypes='define'

==== //depot/maint-5.10/perl/NetWare/config.wc#6 (text) ====
Index: perl/NetWare/config.wc
--- perl/NetWare/config.wc#5~33894~	2008-05-20 16:39:57.000000000 -0700
+++ perl/NetWare/config.wc	2008-05-30 18:54:46.000000000 -0700
@@ -608,6 +608,8 @@
 i_fp='undef'
 i_fp_class='undef'
 i_gdbm='undef'
+i_gdbm_ndbm='undef'
+i_gdbmndbm='undef'
 i_grp='undef'
 i_ieeefp='undef'
 i_inttypes='undef'

==== //depot/maint-5.10/perl/Porting/config.sh#6 (text) ====
Index: perl/Porting/config.sh
--- perl/Porting/config.sh#5~33894~	2008-05-20 16:39:57.000000000 -0700
+++ perl/Porting/config.sh	2008-05-30 18:54:46.000000000 -0700
@@ -638,6 +638,8 @@
 i_fp='undef'
 i_fp_class='undef'
 i_gdbm='define'
+i_gdbm_ndbm='undef'
+i_gdbmndbm='undef'
 i_grp='define'
 i_ieeefp='undef'
 i_inttypes='define'

==== //depot/maint-5.10/perl/configure.com#9 (text) ====
Index: perl/configure.com
--- perl/configure.com#8~33894~	2008-05-20 16:39:57.000000000 -0700
+++ perl/configure.com	2008-05-30 18:54:46.000000000 -0700
@@ -6232,6 +6232,8 @@
 $ WC "i_fp='undef'"
 $ WC "i_fp_class='undef'"
 $ WC "i_gdbm='undef'"
+$ WC "i_gdbm_ndbm='undef'"
+$ WC "i_gdbmndbm='undef'"
 $ WC "i_grp='" + i_grp + "'"
 $ WC "i_ieeefp='undef'"
 $ WC "i_inttypes='" + i_inttypes + "'"

==== //depot/maint-5.10/perl/epoc/config.sh#6 (text) ====
Index: perl/epoc/config.sh
--- perl/epoc/config.sh#5~33894~	2008-05-20 16:39:57.000000000 -0700
+++ perl/epoc/config.sh	2008-05-30 18:54:46.000000000 -0700
@@ -571,6 +571,8 @@
 i_fp='undef'
 i_fp_class='undef'
 i_gdbm='undef'
+i_gdbm_ndbm='undef'
+i_gdbmndbm='undef'
 i_grp='undef'
 i_ieeefp='undef'
 i_inttypes='undef'

==== //depot/maint-5.10/perl/ext/B/B/Deparse.pm#7 (text) ====
Index: perl/ext/B/B/Deparse.pm
--- perl/ext/B/B/Deparse.pm#6~33947~	2008-05-28 18:09:23.000000000 -0700
+++ perl/ext/B/B/Deparse.pm	2008-05-30 18:54:46.000000000 -0700
@@ -4062,6 +4062,16 @@
     return "tr" . double_delim($from, $to) . $flags;
 }
 
+sub re_dq_disambiguate {
+    my ($first, $last) = @_;
+    # Disambiguate "${foo}bar", "${foo}{bar}", "${foo}[1]"
+    ($last =~ /^[A-Z\\\^\[\]_?]/ &&
+	$first =~ s/([\$@])\^$/${1}{^}/)  # "${^}W" etc
+	|| ($last =~ /^[{\[\w_]/ &&
+	    $first =~ s/([\$@])([A-Za-z_]\w*)$/${1}{$2}/);
+    return $first . $last;
+}
+
 # Like dq(), but different
 sub re_dq {
     my $self = shift;
@@ -4077,14 +4087,7 @@
     } elsif ($type eq "concat") {
 	my $first = $self->re_dq($op->first, $extended);
 	my $last  = $self->re_dq($op->last,  $extended);
-
-	# Disambiguate "${foo}bar", "${foo}{bar}", "${foo}[1]"
-	($last =~ /^[A-Z\\\^\[\]_?]/ &&
-	    $first =~ s/([\$@])\^$/${1}{^}/)  # "${^}W" etc
-	    || ($last =~ /^[{\[\w_]/ &&
-		$first =~ s/([\$@])([A-Za-z_]\w*)$/${1}{$2}/);
-
-	return $first . $last;
+	return re_dq_disambiguate($first, $last);
     } elsif ($type eq "uc") {
 	return '\U' . $self->re_dq($op->first->sibling, $extended) . '\E';
     } elsif ($type eq "lc") {
@@ -4156,7 +4159,9 @@
 	my $str = '';
 	$kid = $kid->first->sibling;
 	while (!null($kid)) {
-	    $str .= $self->re_dq($kid, $extended);
+	    my $first = $str;
+	    my $last = $self->re_dq($kid, $extended);
+	    $str = re_dq_disambiguate($first, $last);
 	    $kid = $kid->sibling;
 	}
 	return $str, 1;

==== //depot/maint-5.10/perl/ext/B/t/concise-xs.t#3 (text) ====
Index: perl/ext/B/t/concise-xs.t
--- perl/ext/B/t/concise-xs.t#2~33881~	2008-05-20 05:48:04.000000000 -0700
+++ perl/ext/B/t/concise-xs.t	2008-05-30 18:54:46.000000000 -0700
@@ -180,7 +180,13 @@
 	       skip => [qw/ _POSIX_JOB_CONTROL /,	# platform varying
 			# Might be XS or imported from Fcntl, depending on your
 			# perl version:
-			qw / S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISREG /],
+			qw / S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISREG /,
+			# Might be XS or AUTOLOADed, depending on your perl
+			# version:
+			qw /WEXITSTATUS WIFEXITED WIFSIGNALED WIFSTOPPED
+			    WSTOPSIG WTERMSIG/,
+		       'int_macro_int', # Removed in POSIX 1.16
+		       ],
 	       perl => [qw/ import croak AUTOLOAD /],
 
 	       XS => [qw/ write wctomb wcstombs uname tzset tzname
@@ -194,7 +200,7 @@
 		      mblen lseek log10 localeconv ldexp lchown
 		      isxdigit isupper isspace ispunct isprint
 		      islower isgraph isdigit iscntrl isalpha
-		      isalnum int_macro_int getcwd frexp fpathconf
+		      isalnum getcwd frexp fpathconf
 		      fmod floor dup2 dup difftime cuserid ctime
 		      ctermid cosh constant close clock ceil
 		      bootstrap atan asin asctime acos access abort

==== //depot/maint-5.10/perl/ext/B/t/deparse.t#6 (text) ====
Index: perl/ext/B/t/deparse.t
--- perl/ext/B/t/deparse.t#5~33947~	2008-05-28 18:09:23.000000000 -0700
+++ perl/ext/B/t/deparse.t	2008-05-30 18:54:46.000000000 -0700
@@ -27,7 +27,7 @@
     require feature;
     feature->import(':5.10');
 }
-use Test::More tests => 60;
+use Test::More tests => 61;
 
 use B::Deparse;
 my $deparse = B::Deparse->new();
@@ -416,3 +416,7 @@
 elsif ($a and $b) { x(); }
 elsif ($a or $b) { x(); }
 else { x(); }
+####
+# 54 interpolation in regexps
+my($y, $t);
+/x${y}z$t/;

==== //depot/maint-5.10/perl/ext/POSIX/POSIX.pm#4 (text) ====
Index: perl/ext/POSIX/POSIX.pm
--- perl/ext/POSIX/POSIX.pm#3~33881~	2008-05-20 05:48:04.000000000 -0700
+++ perl/ext/POSIX/POSIX.pm	2008-05-30 18:54:46.000000000 -0700
@@ -4,7 +4,7 @@
 
 our(@ISA, %EXPORT_TAGS, @EXPORT_OK, @EXPORT, $AUTOLOAD, %SIGRT) = ();
 
-our $VERSION = "1.15";
+our $VERSION = "1.16";
 
 use AutoLoader;
 
@@ -35,10 +35,6 @@
 
 XSLoader::load 'POSIX', $VERSION;
 
-my %NON_CONSTS
-  = (map {($_,1)} qw(WEXITSTATUS WIFEXITED WIFSIGNALED WIFSTOPPED WSTOPSIG
-		     WTERMSIG));
-
 sub AUTOLOAD {
     no strict;
     no warnings 'uninitialized';
@@ -50,15 +46,9 @@
     local $! = 0;
     my $constname = $AUTOLOAD;
     $constname =~ s/.*:://;
-    if ($NON_CONSTS{$constname}) {
-        my ($val, $error) = &int_macro_int($constname, $_[0]);
-        croak $error if $error;
-        *$AUTOLOAD = sub { &int_macro_int($constname, $_[0]) };
-    } else {
-        my ($error, $val) = constant($constname);
-        croak $error if $error;
-	*$AUTOLOAD = sub { $val };
-    }
+    my ($error, $val) = constant($constname);
+    croak $error if $error;
+    *$AUTOLOAD = sub { $val };
 
     goto &$AUTOLOAD;
 }

==== //depot/maint-5.10/perl/ext/POSIX/POSIX.xs#4 (text) ====
Index: perl/ext/POSIX/POSIX.xs
--- perl/ext/POSIX/POSIX.xs#3~33881~	2008-05-20 05:48:04.000000000 -0700
+++ perl/ext/POSIX/POSIX.xs	2008-05-30 18:54:46.000000000 -0700
@@ -394,116 +394,6 @@
 
 #include "const-c.inc"
 
-/* These were implemented in the old "constant" subroutine. They are actually
-   macros that take an integer argument and return an integer result.  */
-static int
-int_macro_int (const char *name, STRLEN len, IV *arg_result) {
-  /* Initially switch on the length of the name.  */
-  /* This code has been edited from a "constant" function generated by:
-
-use ExtUtils::Constant qw (constant_types C_constant XS_constant);
-
-my $types = {map {($_, 1)} qw(IV)};
-my @names = (qw(WEXITSTATUS WIFEXITED
-	       WIFSIGNALED WIFSTOPPED WSTOPSIG WTERMSIG));
-
-print constant_types(); # macro defs
-foreach (C_constant ("POSIX", 'int_macro_int', 'IV', $types, undef, 5, @names) ) {
-    print $_, "\n"; # C constant subs
-}
-print "#### XS Section:\n";
-print XS_constant ("POSIX", $types);
-   */
-
-  switch (len) {
-  case 8:
-    /* Names all of length 8.  */
-    /* WSTOPSIG WTERMSIG */
-    /* Offset 1 gives the best switch position.  */
-    switch (name[1]) {
-    case 'S':
-      if (memEQ(name, "WSTOPSIG", 8)) {
-      /*                ^            */
-#ifdef WSTOPSIG
-        int i = *arg_result;
-        *arg_result = WSTOPSIG(WMUNGE(i));
-        return PERL_constant_ISIV;
-#else
-        return PERL_constant_NOTDEF;
-#endif
-      }
-      break;
-    case 'T':
-      if (memEQ(name, "WTERMSIG", 8)) {
-      /*                ^            */
-#ifdef WTERMSIG
-        int i = *arg_result;
-        *arg_result = WTERMSIG(WMUNGE(i));
-        return PERL_constant_ISIV;
-#else
-        return PERL_constant_NOTDEF;
-#endif
-      }
-      break;
-    }
-    break;
-  case 9:
-    if (memEQ(name, "WIFEXITED", 9)) {
-#ifdef WIFEXITED
-      int i = *arg_result;
-      *arg_result = WIFEXITED(WMUNGE(i));
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  case 10:
-    if (memEQ(name, "WIFSTOPPED", 10)) {
-#ifdef WIFSTOPPED
-      int i = *arg_result;
-      *arg_result = WIFSTOPPED(WMUNGE(i));
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  case 11:
-    /* Names all of length 11.  */
-    /* WEXITSTATUS WIFSIGNALED */
-    /* Offset 1 gives the best switch position.  */
-    switch (name[1]) {
-    case 'E':
-      if (memEQ(name, "WEXITSTATUS", 11)) {
-      /*                ^                */
-#ifdef WEXITSTATUS
-	int i = *arg_result;
-        *arg_result = WEXITSTATUS(WMUNGE(i));
-        return PERL_constant_ISIV;
-#else
-        return PERL_constant_NOTDEF;
-#endif
-      }
-      break;
-    case 'I':
-      if (memEQ(name, "WIFSIGNALED", 11)) {
-      /*                ^                */
-#ifdef WIFSIGNALED
-	int i = *arg_result;
-        *arg_result = WIFSIGNALED(WMUNGE(i));
-        return PERL_constant_ISIV;
-#else
-        return PERL_constant_NOTDEF;
-#endif
-      }
-      break;
-    }
-    break;
-  }
-  return PERL_constant_NOTFOUND;
-}
-
 static void
 restore_sigmask(pTHX_ SV *osset_sv)
 {
@@ -756,47 +646,64 @@
 
 INCLUDE: const-xs.inc
 
-void
-int_macro_int(sv, iv)
-    PREINIT:
-	dXSTARG;
-	STRLEN		len;
-        int		type;
-    INPUT:
-	SV *		sv;
-        const char *	s = SvPV(sv, len);
-	IV		iv;
-    PPCODE:
-        /* Change this to int_macro_int(s, len, &iv, &nv);
-           if you need to return both NVs and IVs */
-	type = int_macro_int(s, len, &iv);
-      /* Return 1 or 2 items. First is error message, or undef if no error.
-           Second, if present, is found value */
-        switch (type) {
-        case PERL_constant_NOTFOUND:
-          sv = sv_2mortal(newSVpvf("%s is not a valid POSIX macro", s));
-          EXTEND(SP, 1);
-          PUSHs(&PL_sv_undef);
-          PUSHs(sv);
-          break;
-        case PERL_constant_NOTDEF:
-          sv = sv_2mortal(newSVpvf(
-	    "Your vendor has not defined POSIX macro %s, used", s));
-          EXTEND(SP, 1);
-          PUSHs(&PL_sv_undef);
-          PUSHs(sv);
-          break;
-        case PERL_constant_ISIV:
-          PUSHi(iv);
-          break;
-        default:
-          sv = sv_2mortal(newSVpvf(
-	    "Unexpected return type %d while processing POSIX macro %s, used",
-               type, s));
-          EXTEND(SP, 1);
-          PUSHs(&PL_sv_undef);
-          PUSHs(sv);
-        }
+int
+WEXITSTATUS(status)
+	int status
+    ALIAS:
+	POSIX::WIFEXITED = 1
+	POSIX::WIFSIGNALED = 2
+	POSIX::WIFSTOPPED = 3
+	POSIX::WSTOPSIG = 4
+	POSIX::WTERMSIG = 5
+    CODE:
+	switch(ix) {
+	case 0:
+#ifdef WEXITSTATUS
+	    RETVAL = WEXITSTATUS(status);
+#else
+	    not_here("WEXITSTATUS");
+#endif
+	    break;
+	case 1:
+#ifdef WIFEXITED
+	    RETVAL = WIFEXITED(status);
+#else
+	    not_here("WIFEXITED");
+#endif
+	    break;
+	case 2:
+#ifdef WIFSIGNALED
+	    RETVAL = WIFSIGNALED(status);
+#else
+	    not_here("WIFSIGNALED");
+#endif
+	    break;
+	case 3:
+#ifdef WIFSTOPPED
+	    RETVAL = WIFSTOPPED(status);
+#else
+	    not_here("WIFSTOPPED");
+#endif
+	    break;
+	case 4:
+#ifdef WSTOPSIG
+	    RETVAL = WSTOPSIG(status);
+#else
+	    not_here("WSTOPSIG");
+#endif
+	    break;
+	case 5:
+#ifdef WTERMSIG
+	    RETVAL = WTERMSIG(status);
+#else
+	    not_here("WTERMSIG");
+#endif
+	    break;
+	default:
+	    Perl_croak(aTHX_ "Illegal alias %d for POSIX::W*", ix);
+	}
+    OUTPUT:
+	RETVAL
 
 int
 isalnum(charstring)

==== //depot/maint-5.10/perl/lib/Memoize.pm#2 (text) ====
Index: perl/lib/Memoize.pm
--- perl/lib/Memoize.pm#1~32694~	2007-12-22 01:23:09.000000000 -0800
+++ perl/lib/Memoize.pm	2008-05-30 18:54:46.000000000 -0700
@@ -1003,11 +1003,10 @@
 Perl Journal, issue #13.  (This article is also included in the
 Memoize distribution as `article.html'.)
 
-My upcoming book will discuss memoization (and many other fascinating
-topics) in tremendous detail.  It will be published by Morgan Kaufmann
-in 2002, possibly under the title I<Perl Advanced Techniques
-Handbook>.  It will also be available on-line for free.  For more
-information, visit http://perl.plover.com/book/ .
+The author's book I<Higher Order Perl> (2005, ISBN 1558607013, published
+by Morgan Kaufmann) discusses memoization (and many other fascinating
+topics) in tremendous detail. It will also be available on-line for free.
+For more information, visit http://perl.plover.com/book/ .
 
 To join a mailing list for announcements about C<Memoize>, send an
 empty message to C<mjd-perl-memoize-request@plover.com>.  This mailing

==== //depot/maint-5.10/perl/lib/UNIVERSAL.pm#2 (text) ====
Index: perl/lib/UNIVERSAL.pm
--- perl/lib/UNIVERSAL.pm#1~32694~	2007-12-22 01:23:09.000000000 -0800
+++ perl/lib/UNIVERSAL.pm	2008-05-30 18:54:46.000000000 -0700
@@ -117,8 +117,9 @@
 mandates an inheritance relationship.  Other relationships include aggregation,
 delegation, and mocking.)
 
-By default, classes in Perl only perform the C<UNIVERSAL> role.  To mark that
-your own classes perform other roles, override C<DOES> appropriately.
+By default, classes in Perl only perform the C<UNIVERSAL> role, as well as the
+role of all classes in their inheritance.  In other words, by default C<DOES>
+responds identically to C<isa>.
 
 There is a relationship between roles and classes, as each class implies the
 existence of a role of the same name.  There is also a relationship between

==== //depot/maint-5.10/perl/lib/lib_pm.PL#2 (text) ====
Index: perl/lib/lib_pm.PL
--- perl/lib/lib_pm.PL#1~32694~	2007-12-22 01:23:09.000000000 -0800
+++ perl/lib/lib_pm.PL	2008-05-30 18:54:46.000000000 -0700
@@ -58,7 +58,7 @@
 print OUT <<'!NO!SUBS!';
 
 our @ORIG_INC = @INC;	# take a handy copy of 'original' value
-our $VERSION = '0.5565';
+our $VERSION = '0.56';
 my $Is_MacOS = $^O eq 'MacOS';
 my $Mac_FS;
 if ($Is_MacOS) {
@@ -79,7 +79,7 @@
 
 	$path = _nativize($path);
 
-	if (-e $path && ! -d _) {
+	if ($path !~ /\.par$/i && -e $path && ! -d _) {
 	    require Carp;
 	    Carp::carp("Parameter to use lib must be directory, not file");
 	}

==== //depot/maint-5.10/perl/lib/strict.t#2 (text) ====
Index: perl/lib/strict.t
--- perl/lib/strict.t#1~32694~	2007-12-22 01:23:09.000000000 -0800
+++ perl/lib/strict.t	2008-05-30 18:54:46.000000000 -0700
@@ -84,17 +84,20 @@
     $expected =~ s|(\./)?abc\.pm|:abc.pm|g if $^O eq 'MacOS';
     $expected =~ s|./abc|:abc|g if $^O eq 'MacOS';
     my $prefix = ($results =~ s/^PREFIX\n//) ;
+    my $TODO = $prog =~ m/^#\s*TODO:/;
     if ( $results =~ s/^SKIPPED\n//) {
 	print "$results\n" ;
     }
     elsif (($prefix and $results !~ /^\Q$expected/) or
 	   (!$prefix and $results ne $expected)){
-        print STDERR "PROG: $switch\n$prog\n";
-        print STDERR "EXPECTED:\n$expected\n";
-        print STDERR "GOT:\n$results\n";
+        if (! $TODO) {
+            print STDERR "PROG: $switch\n$prog\n";
+            print STDERR "EXPECTED:\n$expected\n";
+            print STDERR "GOT:\n$results\n";
+        }
         print "not ";
     }
-    print "ok " . ++$i . "\n";
+    print "ok " . ++$i . ($TODO ? " # TODO" : "") . "\n";
     foreach (@temps) 
 	{ unlink $_ if $_ } 
 }

==== //depot/maint-5.10/perl/mg.c#13 (text) ====
Index: perl/mg.c
--- perl/mg.c#12~33953~	2008-05-30 16:12:33.000000000 -0700
+++ perl/mg.c	2008-05-30 18:54:46.000000000 -0700
@@ -1531,7 +1531,7 @@
     stash = GvSTASH(
         SvTYPE(mg->mg_obj) == SVt_PVGV
             ? (GV*)mg->mg_obj
-            : (GV*)SvMAGIC(mg->mg_obj)->mg_obj
+            : (GV*)mg_find(mg->mg_obj, PERL_MAGIC_isa)->mg_obj
     );
 
     if (stash)
@@ -1555,7 +1555,7 @@
     stash = GvSTASH(
         SvTYPE(mg->mg_obj) == SVt_PVGV
             ? (GV*)mg->mg_obj
-            : (GV*)SvMAGIC(mg->mg_obj)->mg_obj
+            : (GV*)mg_find(mg->mg_obj, PERL_MAGIC_isa)->mg_obj
     );
 
     if (stash)

==== //depot/maint-5.10/perl/plan9/config_sh.sample#6 (text) ====
Index: perl/plan9/config_sh.sample
--- perl/plan9/config_sh.sample#5~33894~	2008-05-20 16:39:57.000000000 -0700
+++ perl/plan9/config_sh.sample	2008-05-30 18:54:46.000000000 -0700
@@ -619,6 +619,8 @@
 i_fp='undef'
 i_fp_class='undef'
 i_gdbm='undef'
+i_gdbm_ndbm='undef'
+i_gdbmndbm='undef'
 i_grp='define'
 i_ieeefp='undef'
 i_inttypes='define'

==== //depot/maint-5.10/perl/pod/perlobj.pod#2 (text) ====
Index: perl/pod/perlobj.pod
--- perl/pod/perlobj.pod#1~32694~	2007-12-22 01:23:09.000000000 -0800
+++ perl/pod/perlobj.pod	2008-05-30 18:54:46.000000000 -0700
@@ -407,6 +407,13 @@
 C<blessed> returns the name of the package the argument has been
 blessed into, or C<undef>.
 
+=item DOES(ROLE)
+
+C<DOES> returns I<true> if its object claims to perform the role C<ROLE>.
+
+By default, the response to C<DOES> is the same as the response to ISA.  For
+more information on C<DOES> and other universal methods, see L<UNIVERSAL>.
+
 =item can(METHOD)
 X<can>
 

==== //depot/maint-5.10/perl/pod/perltodo.pod#12 (text) ====
Index: perl/pod/perltodo.pod
--- perl/pod/perltodo.pod#11~33954~	2008-05-30 17:29:21.000000000 -0700
+++ perl/pod/perltodo.pod	2008-05-30 18:54:46.000000000 -0700
@@ -551,18 +551,6 @@
 the perl API that comes from writing modules that use XS to interface to
 C.
 
-=head2 investigate removing int_macro_int from POSIX.xs
-
-As a hang over from the original C<constant> implementation, F<POSIX.xs>
-contains a function C<int_macro_int> which in conjunction with C<AUTOLOAD> is
-used to wrap the C functions C<WEXITSTATUS>, C<WIFEXITED>, C<WIFSIGNALED>,
-C<WIFSTOPPED>, C<WSTOPSIG> and C<WTERMSIG>. It's probably worth replacing
-this complexity with 5 simple direct wrappings of those 5 functions.
-
-However, it would be interesting if someone could measure the memory usage
-before and after, both for the case of C<use POSIX();> and the case of
-actually calling the Perl space functions.
-
 =head2 safely supporting POSIX SA_SIGINFO
 
 Some years ago Jarkko supplied patches to provide support for the POSIX

==== //depot/maint-5.10/perl/pp_sort.c#2 (text) ====
Index: perl/pp_sort.c
--- perl/pp_sort.c#1~32694~	2007-12-22 01:23:09.000000000 -0800
+++ perl/pp_sort.c	2008-05-30 18:54:46.000000000 -0700
@@ -1553,11 +1553,12 @@
 	max = AvFILL(av) + 1;
 	if (SvMAGICAL(av)) {
 	    MEXTEND(SP, max);
-	    p2 = SP;
 	    for (i=0; i < max; i++) {
 		SV **svp = av_fetch(av, i, FALSE);
 		*SP++ = (svp) ? *svp : NULL;
 	    }
+	    SP--;
+	    p1 = p2 = SP - (max-1);
 	}
 	else {
 	    if (SvREADONLY(av))
@@ -1713,7 +1714,7 @@
 	SvREADONLY_off(av);
     else if (av && !sorting_av) {
 	/* simulate pp_aassign of tied AV */
-	SV** const base = ORIGMARK+1;
+	SV** const base = MARK+1;
 	for (i=0; i < max; i++) {
 	    base[i] = newSVsv(base[i]);
 	}

==== //depot/maint-5.10/perl/sv.c#19 (text) ====
Index: perl/sv.c
--- perl/sv.c#18~33953~	2008-05-30 16:12:33.000000000 -0700
+++ perl/sv.c	2008-05-30 18:54:46.000000000 -0700
@@ -246,13 +246,12 @@
     SvREFCNT(sv) = 1;
     SvFLAGS(sv) = 0;
     sv->sv_debug_optype = PL_op ? PL_op->op_type : 0;
-    sv->sv_debug_line = (U16) (PL_parser
-	    ?  PL_parser->copline == NOLINE
-		?  PL_curcop
+    sv->sv_debug_line = (U16) (PL_parser && PL_parser->copline != NOLINE
+		? PL_parser->copline
+		:  PL_curcop
 		    ? CopLINE(PL_curcop)
 		    : 0
-		: PL_parser->copline
-	    : 0);
+	    );
     sv->sv_debug_inpad = 0;
     sv->sv_debug_cloned = 0;
     sv->sv_debug_file = PL_curcop ? savepv(CopFILE(PL_curcop)): NULL;

==== //depot/maint-5.10/perl/symbian/config.sh#6 (text) ====
Index: perl/symbian/config.sh
--- perl/symbian/config.sh#5~33894~	2008-05-20 16:39:57.000000000 -0700
+++ perl/symbian/config.sh	2008-05-30 18:54:46.000000000 -0700
@@ -546,6 +546,8 @@
 i_fp='undef'
 i_fp_class='undef'
 i_gdbm='undef'
+i_gdbm_ndbm='undef'
+i_gdbmndbm='undef'
 i_grp='undef'
 i_ieeefp='undef'
 i_inttypes='undef'

==== //depot/maint-5.10/perl/t/lib/strict/subs#2 (text) ====
Index: perl/t/lib/strict/subs
--- perl/t/lib/strict/subs#1~32694~	2007-12-22 01:23:09.000000000 -0800
+++ perl/t/lib/strict/subs	2008-05-30 18:54:46.000000000 -0700
@@ -393,3 +393,18 @@
 EXPECT
 Bareword "FOO" not allowed while "strict subs" in use at - line 2.
 Execution of - aborted due to compilation errors.
+########
+# [perl #53806] No complain about bareword
+use strict 'subs';
+print FOO . "\n";
+EXPECT
+Bareword "FOO" not allowed while "strict subs" in use at - line 3.
+Execution of - aborted due to compilation errors.
+########
+# [perl #53806] No complain about bareword
+use strict 'subs';
+$ENV{PATH} = "";
+system(FOO . "\n");
+EXPECT
+Bareword "FOO" not allowed while "strict subs" in use at - line 4.
+Execution of - aborted due to compilation errors.

==== //depot/maint-5.10/perl/t/op/index.t#3 (xtext) ====
Index: perl/t/op/index.t
--- perl/t/op/index.t#2~33920~	2008-05-24 09:04:48.000000000 -0700
+++ perl/t/op/index.t	2008-05-30 18:54:46.000000000 -0700
@@ -7,7 +7,7 @@
 }
 
 use strict;
-plan( tests => 69 );
+plan( tests => 111 );
 
 run_tests() unless caller;
 
@@ -160,4 +160,42 @@
     is(index($t, 'xyz'), 4, "0xfffffffd and utf8cache");
 }
 
+
+# Tests for NUL characters.
+{
+    my @tests = (
+        ["",            -1, -1, -1],
+        ["foo",         -1, -1, -1],
+        ["\0",           0, -1, -1],
+        ["\0\0",         0,  0, -1],
+        ["\0\0\0",       0,  0,  0],
+        ["foo\0",        3, -1, -1],
+        ["foo\0foo\0\0", 3,  7, -1],
+    );
+    foreach my $l (1 .. 3) {
+        my $q = "\0" x $l;
+        my $i = 0;
+        foreach my $test (@tests) {
+            $i ++;
+            my $str = $$test [0];
+            my $res = $$test [$l];
+
+            {
+                is (index ($str, $q), $res, "Find NUL character(s)");
+            }
+
+            #
+            # Bug #53746 shows a difference between variables and literals,
+            # so test literals as well.
+            #
+            my $test_str = qq {is (index ("$str", "$q"), $res, } .
+                           qq {"Find NUL character(s)")};
+               $test_str =~ s/\0/\\0/g;
+
+            eval $test_str;
+            die $@ if $@;
+        }
+    }
+}
+
 }

==== //depot/maint-5.10/perl/toke.c#8 (text) ====
Index: perl/toke.c
--- perl/toke.c#7~33953~	2008-05-30 16:12:33.000000000 -0700
+++ perl/toke.c	2008-05-30 18:54:46.000000000 -0700
@@ -5596,10 +5596,10 @@
 
 		/* Call it a bare word */
 
+		bareword:
 		if (PL_hints & HINT_STRICT_SUBS)
 		    pl_yylval.opval->op_private |= OPpCONST_STRICT;
 		else {
-		bareword:
 		    if (lastchar != '-') {
 			if (ckWARN(WARN_RESERVED)) {
 			    d = PL_tokenbuf;

==== //depot/maint-5.10/perl/uconfig.sh#7 (xtext) ====
Index: perl/uconfig.sh
--- perl/uconfig.sh#6~33894~	2008-05-20 16:39:57.000000000 -0700
+++ perl/uconfig.sh	2008-05-30 18:54:46.000000000 -0700
@@ -533,6 +533,8 @@
 i_fp='undef'
 i_fp_class='undef'
 i_gdbm='undef'
+i_gdbm_ndbm='undef'
+i_gdbmndbm='undef'
 i_grp='undef'
 i_ieeefp='undef'
 i_inttypes='undef'

==== //depot/maint-5.10/perl/util.c#5 (text) ====
Index: perl/util.c
--- perl/util.c#4~33614~	2008-03-31 09:59:07.000000000 -0700
+++ perl/util.c	2008-05-30 18:54:46.000000000 -0700
@@ -435,9 +435,9 @@
     if (little >= lend)
         return (char*)big;
     {
-        char first = *little++;
+        char first = *little;
         const char *s, *x;
-        bigend -= lend - little;
+        bigend -= lend - little++;
     OUTER:
         while (big <= bigend) {
             if (*big++ == first) {

==== //depot/maint-5.10/perl/win32/config.bc#6 (text) ====
Index: perl/win32/config.bc
--- perl/win32/config.bc#5~33894~	2008-05-20 16:39:57.000000000 -0700
+++ perl/win32/config.bc	2008-05-30 18:54:46.000000000 -0700
@@ -613,6 +613,8 @@
 i_fp='undef'
 i_fp_class='undef'
 i_gdbm='undef'
+i_gdbm_ndbm='undef'
+i_gdbmndbm='undef'
 i_grp='undef'
 i_ieeefp='undef'
 i_inttypes='undef'

==== //depot/maint-5.10/perl/win32/config.ce#6 (text) ====
Index: perl/win32/config.ce
--- perl/win32/config.ce#5~33894~	2008-05-20 16:39:57.000000000 -0700
+++ perl/win32/config.ce	2008-05-30 18:54:46.000000000 -0700
@@ -606,6 +606,8 @@
 i_fp='undef'
 i_fp_class='undef'
 i_gdbm='undef'
+i_gdbm_ndbm='undef'
+i_gdbmndbm='undef'
 i_grp='undef'
 i_ieeefp='undef'
 i_inttypes='undef'

==== //depot/maint-5.10/perl/win32/config.gc#7 (text) ====
Index: perl/win32/config.gc
--- perl/win32/config.gc#6~33894~	2008-05-20 16:39:57.000000000 -0700
+++ perl/win32/config.gc	2008-05-30 18:54:46.000000000 -0700
@@ -613,6 +613,8 @@
 i_fp='undef'
 i_fp_class='undef'
 i_gdbm='undef'
+i_gdbm_ndbm='undef'
+i_gdbmndbm='undef'
 i_grp='undef'
 i_ieeefp='undef'
 i_inttypes='undef'

==== //depot/maint-5.10/perl/win32/config.vc#7 (text) ====
Index: perl/win32/config.vc
--- perl/win32/config.vc#6~33894~	2008-05-20 16:39:57.000000000 -0700
+++ perl/win32/config.vc	2008-05-30 18:54:46.000000000 -0700
@@ -613,6 +613,8 @@
 i_fp='undef'
 i_fp_class='undef'
 i_gdbm='undef'
+i_gdbm_ndbm='undef'
+i_gdbmndbm='undef'
 i_grp='undef'
 i_ieeefp='undef'
 i_inttypes='undef'

==== //depot/maint-5.10/perl/win32/config.vc64#7 (text) ====
Index: perl/win32/config.vc64
--- perl/win32/config.vc64#6~33894~	2008-05-20 16:39:57.000000000 -0700
+++ perl/win32/config.vc64	2008-05-30 18:54:46.000000000 -0700
@@ -613,6 +613,8 @@
 i_fp='undef'
 i_fp_class='undef'
 i_gdbm='undef'
+i_gdbm_ndbm='undef'
+i_gdbmndbm='undef'
 i_grp='undef'
 i_ieeefp='undef'
 i_inttypes='undef'
End of Patch.



Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About