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

Change 33921: Integrate:

From:
Dave Mitchell
Date:
May 24, 2008 09:45
Subject:
Change 33921: Integrate:
Change 33921 by davem@davem-pigeon on 2008/05/24 16:32:36

	
	Integrate:
	[ 33153]
	Typo fix in change #33058
	
	Subject: Re: [PATCH t/cmd/for.t] Regression tests for 'for reverse ..'
	From: Daniel Frederick Crisman <daniel@crisman.org>
	Date: Wed, 30 Jan 2008 15:09:22 -0500
	Message-ID: <20080130200922.GA20450@fury.crisman.org>
	
	[ 33178]
	In pp_split(), eliminate most (all?) of the conditional calls to
	sv_2mortal() by conditionally passing SVs_TEMP to newSVpvn_flags().
	
	[ 33229]
	Fix op/reg_email_thr.t when PERLIO=stdio
	
	[ 33230]
	Subject: [PATCH] fix B::Debug pmnext
	From: "Reini Urban" <rurban@x-ray.at>
	Date: Sat, 2 Feb 2008 16:33:52 +0100
	Message-ID: <6910a60802020733u7817a55dm6f5e213625063204@mail.gmail.com>
	
	[ 33233]
	Subject: [patch] B portability macros
	From: Jim Cromie <jim.cromie@gmail.com>
	Date: Fri, 01 Feb 2008 17:43:11 -0700
	Message-ID: <47A3BC9F.7080200@gmail.com>
	
	[ 33235]
	Removed mention of a book that was never published.
	
	[ 33236]
	Fix CPAN bug #32896: make version.pm loadable in a Safe compartment
	
	[ 33237]
	Add a new test for Safe
	
	[ 33238]
	Adapt Safe innards to older (XS) versions of version.pm

Affected files ...

... //depot/maint-5.10/perl/MANIFEST#25 integrate
... //depot/maint-5.10/perl/ext/B/B.pm#4 integrate
... //depot/maint-5.10/perl/ext/B/B.xs#7 integrate
... //depot/maint-5.10/perl/ext/B/B/Debug.pm#2 integrate
... //depot/maint-5.10/perl/ext/List/Util/lib/Scalar/Util.pm#2 integrate
... //depot/maint-5.10/perl/ext/Opcode/Safe.pm#6 integrate
... //depot/maint-5.10/perl/ext/Safe/t/safeload.t#1 branch
... //depot/maint-5.10/perl/pp.c#6 integrate
... //depot/maint-5.10/perl/t/cmd/for.t#3 integrate
... //depot/maint-5.10/perl/t/op/reg_email.t#3 integrate

Differences ...

==== //depot/maint-5.10/perl/MANIFEST#25 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#24~33920~	2008-05-24 09:04:48.000000000 -0700
+++ perl/MANIFEST	2008-05-24 09:32:36.000000000 -0700
@@ -1006,6 +1006,7 @@
 ext/Safe/t/safe1.t		See if Safe works
 ext/Safe/t/safe2.t		See if Safe works
 ext/Safe/t/safe3.t		See if Safe works
+ext/Safe/t/safeload.t		Tests that some modules can be loaded by Safe
 ext/Safe/t/safeops.t		Tests that all ops can be trapped by Safe
 ext/Safe/t/safeuniversal.t	Tests Safe with functions from universal.c
 ext/SDBM_File/Makefile.PL	SDBM extension makefile writer

==== //depot/maint-5.10/perl/ext/B/B.pm#4 (text) ====
Index: perl/ext/B/B.pm
--- perl/ext/B/B.pm#3~33128~	2008-01-30 08:40:00.000000000 -0800
+++ perl/ext/B/B.pm	2008-05-24 09:32:36.000000000 -0700
@@ -1097,12 +1097,16 @@
 
 =item pmnext
 
+Only up to Perl 5.9.4
+
 =item pmregexp
 
 =item pmflags
 
 =item extflags
 
+Since Perl 5.9.5
+
 =item precomp
 
 =item pmoffset

==== //depot/maint-5.10/perl/ext/B/B.xs#7 (text) ====
Index: perl/ext/B/B.xs
--- perl/ext/B/B.xs#6~33641~	2008-04-03 09:39:03.000000000 -0700
+++ perl/ext/B/B.xs	2008-05-24 09:32:36.000000000 -0700
@@ -463,6 +463,16 @@
     return sstr;
 }
 
+#if PERL_VERSION >= 9
+#  define PMOP_pmreplstart(o)	o->op_pmstashstartu.op_pmreplstart
+#  define PMOP_pmreplroot(o)	o->op_pmreplrootu.op_pmreplroot
+#else
+#  define PMOP_pmreplstart(o)	o->op_pmreplstart
+#  define PMOP_pmreplroot(o)	o->op_pmreplroot
+#  define PMOP_pmpermflags(o)	o->op_pmpermflags
+#  define PMOP_pmdynflags(o)      o->op_pmdynflags
+#endif
+
 static void
 walkoptree(pTHX_ SV *opsv, const char *method)
 {
@@ -492,12 +502,7 @@
 	}
     }
     if (o && (cc_opclass(aTHX_ o) == OPc_PMOP) && o->op_type != OP_PUSHRE
-#if PERL_VERSION >= 9
-	    && (kid = cPMOPo->op_pmreplrootu.op_pmreplroot)
-#else
-	    && (kid = cPMOPo->op_pmreplroot)
-#endif
-	)
+           && (kid = PMOP_pmreplroot(cPMOPo)))
     {
 	sv_setiv(newSVrv(opsv, cc_opclassname(aTHX_ kid)), PTR2IV(kid));
 	walkoptree(aTHX_ opsv, method);
@@ -523,11 +528,7 @@
 	XPUSHs(opsv);
         switch (o->op_type) {
 	case OP_SUBST:
-#if PERL_VERSION >= 9
-            SP = oplist(aTHX_ cPMOPo->op_pmstashstartu.op_pmreplstart, SP);
-#else
-            SP = oplist(aTHX_ cPMOPo->op_pmreplstart, SP);
-#endif
+            SP = oplist(aTHX_ PMOP_pmreplstart(cPMOPo), SP);
             continue;
 	case OP_SORT:
 	    if (o->op_flags & OPf_STACKED && o->op_flags & OPf_SPECIAL) {
@@ -988,13 +989,6 @@
     OUTPUT:
         RETVAL
 
-#if PERL_VERSION >= 9
-#  define PMOP_pmreplstart(o)	o->op_pmstashstartu.op_pmreplstart
-#else
-#  define PMOP_pmreplstart(o)	o->op_pmreplstart
-#  define PMOP_pmpermflags(o)	o->op_pmpermflags
-#  define PMOP_pmdynflags(o)      o->op_pmdynflags
-#endif
 #define PMOP_pmnext(o)		o->op_pmnext
 #define PMOP_pmregexp(o)	PM_GETRE(o)
 #ifdef USE_ITHREADS

==== //depot/maint-5.10/perl/ext/B/B/Debug.pm#2 (text) ====
Index: perl/ext/B/B/Debug.pm
--- perl/ext/B/B/Debug.pm#1~32694~	2007-12-22 01:23:09.000000000 -0800
+++ perl/ext/B/B/Debug.pm	2008-05-24 09:32:36.000000000 -0700
@@ -72,7 +72,7 @@
     $op->B::LISTOP::debug();
     printf "\top_pmreplroot\t0x%x\n", ${$op->pmreplroot};
     printf "\top_pmreplstart\t0x%x\n", ${$op->pmreplstart};
-    printf "\top_pmnext\t0x%x\n", ${$op->pmnext};
+    printf "\top_pmnext\t0x%x\n", ${$op->pmnext} if $] < 5.009005;
     printf "\top_pmregexp->precomp\t%s\n", cstring($op->precomp);
     printf "\top_pmflags\t0x%x\n", $op->pmflags;
     $op->pmreplroot->debug;

==== //depot/maint-5.10/perl/ext/List/Util/lib/Scalar/Util.pm#2 (text) ====
Index: perl/ext/List/Util/lib/Scalar/Util.pm
--- perl/ext/List/Util/lib/Scalar/Util.pm#1~32694~	2007-12-22 01:23:09.000000000 -0800
+++ perl/ext/List/Util/lib/Scalar/Util.pm	2008-05-24 09:32:36.000000000 -0700
@@ -331,11 +331,4 @@
 This program is free software; you can redistribute it and/or modify it
 under the same terms as perl itself.
 
-=head1 BLATANT PLUG
-
-The weaken and isweak subroutines in this module and the patch to the core Perl
-were written in connection  with the APress book `Tuomas J. Lukka's Definitive
-Guide to Object-Oriented Programming in Perl', to avoid explaining why certain
-things would have to be done in cumbersome ways.
-
 =cut

==== //depot/maint-5.10/perl/ext/Opcode/Safe.pm#6 (text) ====
Index: perl/ext/Opcode/Safe.pm
--- perl/ext/Opcode/Safe.pm#5~33615~	2008-03-31 11:01:17.000000000 -0700
+++ perl/ext/Opcode/Safe.pm	2008-05-24 09:32:36.000000000 -0700
@@ -57,6 +57,9 @@
     &utf8::downgrade
     &utf8::native_to_unicode
     &utf8::unicode_to_native
+    $version::VERSION
+    $version::CLASS
+    @version::ISA
 ], ($] >= 5.008001 && qw[
     &Regexp::DESTROY
 ]), ($] >= 5.010 && qw[

==== //depot/maint-5.10/perl/ext/Safe/t/safeload.t#1 (text) ====
Index: perl/ext/Safe/t/safeload.t
--- /dev/null	2008-05-07 15:08:24.549929899 -0700
+++ perl/ext/Safe/t/safeload.t	2008-05-24 09:32:36.000000000 -0700
@@ -0,0 +1,30 @@
+#!perl
+
+BEGIN {
+    if ($ENV{PERL_CORE}) {
+	chdir 't' if -d 't';
+	@INC = '../lib';
+    }
+    require Config;
+    import Config;
+    if ($Config{'extensions'} !~ /\bOpcode\b/) {
+	print "1..0\n";
+	exit 0;
+    }
+    # Can we load the version module ?
+    eval { require version; 1 } or do {
+	print "1..0 # no version.pm\n";
+	exit 0;
+    };
+    delete $INC{"version.pm"};
+}
+
+use strict;
+use Test::More;
+use Safe;
+plan(tests => 1);
+
+my $c = new Safe;
+$c->permit(qw(require caller));
+my $r = $c->reval(q{ use version; 1 });
+ok( defined $r, "Can load version.pm in a Safe compartment" ) or diag $@;

==== //depot/maint-5.10/perl/pp.c#6 (text) ====
Index: perl/pp.c
--- perl/pp.c#5~33742~	2008-04-24 19:21:31.000000000 -0700
+++ perl/pp.c	2008-05-24 09:32:36.000000000 -0700
@@ -4599,7 +4599,7 @@
     I32 base;
     const I32 gimme = GIMME_V;
     const I32 oldsave = PL_savestack_ix;
-    I32 make_mortal = 1;
+    U32 make_mortal = SVs_TEMP;
     bool multiline = 0;
     MAGIC *mg = NULL;
 
@@ -4698,9 +4698,8 @@
 	    if (m >= strend)
 		break;
 
-	    dstr = newSVpvn_utf8(s, m-s, do_utf8);
-	    if (make_mortal)
-		sv_2mortal(dstr);
+	    dstr = newSVpvn_flags(s, m-s,
+				  (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
 	    XPUSHs(dstr);
 
 	    /* skip the whitespace found last */
@@ -4729,9 +4728,8 @@
 	    m++;
 	    if (m >= strend)
 		break;
-	    dstr = newSVpvn_utf8(s, m-s, do_utf8);
-	    if (make_mortal)
-		sv_2mortal(dstr);
+	    dstr = newSVpvn_flags(s, m-s,
+				  (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
 	    XPUSHs(dstr);
 	    s = m;
 	}
@@ -4756,10 +4754,7 @@
                 /* keep track of how many bytes we skip over */
                 m = s;
                 s += UTF8SKIP(s);
-                dstr = newSVpvn_utf8(m, s-m, TRUE);
-
-                if (make_mortal)
-                    sv_2mortal(dstr);
+                dstr = newSVpvn_flags(m, s-m, SVf_UTF8 | make_mortal);
 
                 PUSHs(dstr);
 
@@ -4797,9 +4792,8 @@
 		    ;
 		if (m >= strend)
 		    break;
-		dstr = newSVpvn_utf8(s, m-s, do_utf8);
-		if (make_mortal)
-		    sv_2mortal(dstr);
+		dstr = newSVpvn_flags(s, m-s,
+				      (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
 		XPUSHs(dstr);
 		/* The rx->minlen is in characters but we want to step
 		 * s ahead by bytes. */
@@ -4814,9 +4808,8 @@
 	      (m = fbm_instr((unsigned char*)s, (unsigned char*)strend,
 			     csv, multiline ? FBMrf_MULTILINE : 0)) )
 	    {
-		dstr = newSVpvn_utf8(s, m-s, do_utf8);
-		if (make_mortal)
-		    sv_2mortal(dstr);
+		dstr = newSVpvn_flags(s, m-s,
+				      (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
 		XPUSHs(dstr);
 		/* The rx->minlen is in characters but we want to step
 		 * s ahead by bytes. */
@@ -4847,9 +4840,8 @@
 		strend = s + (strend - m);
 	    }
 	    m = RX_OFFS(rx)[0].start + orig;
-	    dstr = newSVpvn_utf8(s, m-s, do_utf8);
-	    if (make_mortal)
-		sv_2mortal(dstr);
+	    dstr = newSVpvn_flags(s, m-s,
+				  (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
 	    XPUSHs(dstr);
 	    if (RX_NPARENS(rx)) {
 		I32 i;
@@ -4861,12 +4853,12 @@
 		       parens that didn't match -- they should be set to
 		       undef, not the empty string */
 		    if (m >= orig && s >= orig) {
-			dstr = newSVpvn_utf8(s, m-s, do_utf8);
+			dstr = newSVpvn_flags(s, m-s,
+					     (do_utf8 ? SVf_UTF8 : 0)
+					      | make_mortal);
 		    }
 		    else
 			dstr = &PL_sv_undef;  /* undef, not "" */
-		    if (make_mortal)
-			sv_2mortal(dstr);
 		    XPUSHs(dstr);
 		}
 	    }
@@ -4881,9 +4873,7 @@
     /* keep field after final delim? */
     if (s < strend || (iters && origlimit)) {
         const STRLEN l = strend - s;
-	dstr = newSVpvn_utf8(s, l, do_utf8);
-	if (make_mortal)
-	    sv_2mortal(dstr);
+	dstr = newSVpvn_flags(s, l, (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
 	XPUSHs(dstr);
 	iters++;
     }

==== //depot/maint-5.10/perl/t/cmd/for.t#3 (xtext) ====
Index: perl/t/cmd/for.t
--- perl/t/cmd/for.t#2~33133~	2008-01-30 10:46:51.000000000 -0800
+++ perl/t/cmd/for.t	2008-05-24 09:32:36.000000000 -0700
@@ -169,7 +169,7 @@
 for (reverse 'A' .. 'C') {
     $r .= $_;
 }
-is ($r, 'CBA', 'Reverse orwards for list via ..');
+is ($r, 'CBA', 'Reverse for list via ..');
 
 $r = '';
 for my $i (@array) {

==== //depot/maint-5.10/perl/t/op/reg_email.t#3 (text) ====
Index: perl/t/op/reg_email.t
--- perl/t/op/reg_email.t#2~33920~	2008-05-24 09:04:48.000000000 -0700
+++ perl/t/op/reg_email.t	2008-05-24 09:32:36.000000000 -0700
@@ -73,6 +73,10 @@
     my $count = 0;
 
     $| = 1;
+    # rewinding DATA is necessary with PERLIO=stdio when this
+    # test is run from another thread
+    seek *DATA, 0, 0;
+    while (<DATA>) { last if /^__DATA__/ }
     while (<DATA>) {
 	chomp;
 	next if /^#/;
End of Patch.



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