Change 33921 by [EMAIL PROTECTED] 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 <[EMAIL PROTECTED]>
Date: Wed, 30 Jan 2008 15:09:22 -0500
Message-ID: <[EMAIL PROTECTED]>
[ 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" <[EMAIL PROTECTED]>
Date: Sat, 2 Feb 2008 16:33:52 +0100
Message-ID: <[EMAIL PROTECTED]>
[ 33233]
Subject: [patch] B portability macros
From: Jim Cromie <[EMAIL PROTECTED]>
Date: Fri, 01 Feb 2008 17:43:11 -0700
Message-ID: <[EMAIL PROTECTED]>
[ 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.
