Change 33210 by [EMAIL PROTECTED] on 2008/02/02 19:08:57
Integrate:
[ 33126]
Integrate:
[ 32687]
Deparse each @array and friends.
[ 32725]
Swap SVt_RV and SVt_NV in the SV ordering.
[ 32733]
Better diagnostics by removing an && from an ok() and converting it to
two is()s.
[ 32734]
Eliminate SVt_RV, and use SVt_IV to store plain references.
This frees up a scalar type for first class regular expressions.
[ 32736]
Remove two warnings (sub diag() was redefined, and implict split is
deprecated)
[ 33125]
Need to substitute out the placeholder '$RV' for earlier perls too.
[ 33128]
Integrate:
[ 32751]
First class regexps.
[ 32752]
Dump the REGEXP member of SVt_REGEXP.
[ 32841]
Abolish wrapped in struct regexp - store the wrapped pattern pointer
in the SvPVX().
[ 32859]
Don't allocate the NV slot for SVt_REGEXP.
[ 32880]
Make new regex type be 'REGEXP' and make all core qr//'s be in class
Regexp (and related changes)
[ 32987]
Add a diagram for the 5.11 SV class structure, including B::REGEXP.
[ 33056]
Subject: [PATCH ext/Devel/DProf/Makefile.PL] RE: [PATCH
ext/Devel/DProf/Makefile.PL] unnecessary define
From: "Robin Barker" <[EMAIL PROTECTED]>
Message-ID: <[EMAIL PROTECTED]>
Date: Wed, 23 Jan 2008 14:13:30 -0000
[ 33064]
Subject: [PATCH ext/Devel/DProf] ... and the rest; was RE: unnecessary
define
From: "Robin Barker" <[EMAIL PROTECTED]>
Message-ID: <[EMAIL PROTECTED]>
Date: Thu, 24 Jan 2008 13:28:33 -0000
[ 33071]
Change 33069 missed updating dump.c to dump PVIOs correctly.
[clearly just the parts in ext/ - no core code changes]
[ 33207]
Integrate:
[ 33206]
Change 27244 wasn't quite correct. XSUB is dumped as 0x0, not 0.
[ 33209]
Integrate:
[ 33208]
5.8.x and earler have a SUBPROCESS line in the dump of a PVIO.
Affected files ...
... //depot/maint-5.8/perl/ext/B/B.pm#28 integrate
... //depot/maint-5.8/perl/ext/B/B.xs#37 integrate
... //depot/maint-5.8/perl/ext/B/B/Concise.pm#42 integrate
... //depot/maint-5.8/perl/ext/B/B/Deparse.pm#39 integrate
... //depot/maint-5.8/perl/ext/B/t/b.t#10 integrate
... //depot/maint-5.8/perl/ext/B/t/concise.t#17 integrate
... //depot/maint-5.8/perl/ext/B/t/deparse.t#16 integrate
... //depot/maint-5.8/perl/ext/B/t/optree_constants.t#2 integrate
... //depot/maint-5.8/perl/ext/B/t/terse.t#5 integrate
... //depot/maint-5.8/perl/ext/B/typemap#6 integrate
... //depot/maint-5.8/perl/ext/Devel/DProf/DProf.xs#15 integrate
... //depot/maint-5.8/perl/ext/Devel/DProf/Makefile.PL#3 integrate
... //depot/maint-5.8/perl/ext/Devel/Peek/t/Peek.t#14 integrate
... //depot/maint-5.8/perl/ext/Storable/Storable.xs#33 integrate
Differences ...
==== //depot/maint-5.8/perl/ext/B/B.pm#28 (text) ====
Index: perl/ext/B/B.pm
--- perl/ext/B/B.pm#27~32265~ 2007-11-10 03:31:16.000000000 -0800
+++ perl/ext/B/B.pm 2008-02-02 11:08:57.000000000 -0800
@@ -7,7 +7,7 @@
#
package B;
-our $VERSION = '1.17';
+our $VERSION = '1.19';
use XSLoader ();
require Exporter;
@@ -33,10 +33,12 @@
@B::PV::ISA = 'B::SV';
@B::IV::ISA = 'B::SV';
@B::NV::ISA = 'B::SV';
[EMAIL PROTECTED]::RV::ISA = 'B::SV';
+# RV is eliminated with 5.11.0, but effectively is a specialisation of IV now.
[EMAIL PROTECTED]::RV::ISA = $] >= 5.011 ? 'B::IV' : 'B::SV';
@B::PVIV::ISA = qw(B::PV B::IV);
@B::PVNV::ISA = qw(B::PVIV B::NV);
@B::PVMG::ISA = 'B::PVNV';
[EMAIL PROTECTED]::REGEXP::ISA = 'B::PVMG' if $] >= 5.011;
# Change in the inheritance hierarchy post 5.9.0
@B::PVLV::ISA = $] > 5.009 ? 'B::GV' : 'B::PVMG';
# BM is eliminated post 5.9.5, but effectively is a specialisation of GV now.
@@ -574,8 +576,8 @@
B::IV, B::NV, B::RV, B::PV, B::PVIV, B::PVNV, B::PVMG, B::BM (5.9.5 and
earlier), B::PVLV, B::AV, B::HV, B::CV, B::GV, B::FM, B::IO. These classes
correspond in the obvious way to the underlying C structures of similar names.
-The inheritance hierarchy mimics the underlying C "inheritance". For 5.9.5
-and later this is:
+The inheritance hierarchy mimics the underlying C "inheritance". For the
+5.10.x branch, (I<ie> 5.10.0, 5.10.1 I<etc>) this is:
B::SV
|
@@ -600,7 +602,6 @@
| |
B::PVLV B::FM
-
For 5.9.0 and earlier, PVLV is a direct subclass of PVMG, and BM is still
present as a distinct type, so the base of this diagram is
@@ -616,6 +617,32 @@
|
B::FM
+For 5.11.0 and later, B::RV is abolished, and IVs can be used to store
+references, and a new type B::REGEXP is introduced, giving this structure:
+
+ B::SV
+ |
+ +------------+------------+
+ | | |
+ B::PV B::IV B::NV
+ \ / /
+ \ / /
+ B::PVIV /
+ \ /
+ \ /
+ \ /
+ B::PVNV
+ |
+ |
+ B::PVMG
+ |
+ +-------+-------+---+---+-------+-------+
+ | | | | | |
+ B::AV B::GV B::HV B::CV B::IO B::REGEXP
+ | |
+ | |
+ B::PVLV B::FM
+
Access methods correspond to the underlying C macros for field access,
usually with the leading "class indication" prefix removed (Sv, Av,
==== //depot/maint-5.8/perl/ext/B/B.xs#37 (text) ====
Index: perl/ext/B/B.xs
--- perl/ext/B/B.xs#36~32265~ 2007-11-10 03:31:16.000000000 -0800
+++ perl/ext/B/B.xs 2008-02-02 11:08:57.000000000 -0800
@@ -26,7 +26,9 @@
#endif
"B::IV",
"B::NV",
+#if PERL_VERSION <= 10
"B::RV",
+#endif
"B::PV",
"B::PVIV",
"B::PVNV",
@@ -34,6 +36,9 @@
#if PERL_VERSION <= 8
"B::BM",
#endif
+#if PERL_VERSION >= 11
+ "B::REGEXP",
+#endif
#if PERL_VERSION >= 9
"B::GV",
#endif
@@ -564,6 +569,9 @@
typedef SV *B__PV;
typedef SV *B__NV;
typedef SV *B__PVMG;
+#if PERL_VERSION >= 11
+typedef SV *B__REGEXP;
+#endif
typedef SV *B__PVLV;
typedef SV *B__BM;
typedef SV *B__RV;
@@ -1366,6 +1374,24 @@
ST(0) = sv_2mortal(newSVpvn((char *)&w, 4));
}
+
+#if PERL_VERSION >= 11
+
+B::SV
+RV(sv)
+ B::IV sv
+ CODE:
+ if( SvROK(sv) ) {
+ RETVAL = SvRV(sv);
+ }
+ else {
+ croak( "argument is not SvROK" );
+ }
+ OUTPUT:
+ RETVAL
+
+#endif
+
MODULE = B PACKAGE = B::NV PREFIX = Sv
NV
@@ -1392,12 +1418,16 @@
PARENT_FAKELEX_FLAGS(sv)
B::NV sv
+#if PERL_VERSION < 11
+
MODULE = B PACKAGE = B::RV PREFIX = Sv
B::SV
SvRV(sv)
B::RV sv
+#endif
+
MODULE = B PACKAGE = B::PV PREFIX = Sv
char*
@@ -1476,6 +1506,31 @@
SvSTASH(sv)
B::PVMG sv
+MODULE = B PACKAGE = B::REGEXP
+
+#if PERL_VERSION >= 11
+
+IV
+REGEX(sv)
+ B::PVMG sv
+ CODE:
+ RETVAL = PTR2IV(((struct xregexp *)SvANY(sv))->xrx_regexp);
+ OUTPUT:
+ RETVAL
+
+SV*
+precomp(sv)
+ B::PVMG sv
+ REGEXP* rx = NO_INIT
+ CODE:
+ rx = ((struct xregexp *)SvANY(sv))->xrx_regexp;
+ /* FIXME - UTF-8? And the equivalent precomp methods? */
+ RETVAL = newSVpvn( rx->precomp, rx->prelen );
+ OUTPUT:
+ RETVAL
+
+#endif
+
#define MgMOREMAGIC(mg) mg->mg_moremagic
#define MgPRIVATE(mg) mg->mg_private
#define MgTYPE(mg) mg->mg_type
==== //depot/maint-5.8/perl/ext/B/B/Concise.pm#42 (text) ====
Index: perl/ext/B/B/Concise.pm
--- perl/ext/B/B/Concise.pm#41~32265~ 2007-11-10 03:31:16.000000000 -0800
+++ perl/ext/B/B/Concise.pm 2008-02-02 11:08:57.000000000 -0800
@@ -28,7 +28,7 @@
# use #6
use B qw(class ppname main_start main_root main_cv cstring svref_2object
SVf_IOK SVf_NOK SVf_POK SVf_IVisUV SVf_FAKE OPf_KIDS OPf_SPECIAL
- CVf_ANON PAD_FAKELEX_ANON PAD_FAKELEX_MULTI);
+ CVf_ANON PAD_FAKELEX_ANON PAD_FAKELEX_MULTI SVf_ROK);
my %style =
("terse" =>
@@ -698,9 +698,16 @@
$hr->{svval} = "*$stash" . $gv->SAFENAME;
return "*$stash" . $gv->SAFENAME;
} else {
- while (class($sv) eq "RV") {
- $hr->{svval} .= "\\";
- $sv = $sv->RV;
+ if ($] >= 5.011) {
+ while (class($sv) eq "IV" && $sv->FLAGS & SVf_ROK) {
+ $hr->{svval} .= "\\";
+ $sv = $sv->RV;
+ }
+ } else {
+ while (class($sv) eq "RV") {
+ $hr->{svval} .= "\\";
+ $sv = $sv->RV;
+ }
}
if (class($sv) eq "SPECIAL") {
$hr->{svval} .= ["Null", "sv_undef", "sv_yes", "sv_no"]->[$$sv];
==== //depot/maint-5.8/perl/ext/B/B/Deparse.pm#39 (text) ====
Index: perl/ext/B/B/Deparse.pm
--- perl/ext/B/B/Deparse.pm#38~32265~ 2007-11-10 03:31:16.000000000 -0800
+++ perl/ext/B/B/Deparse.pm 2008-02-02 11:08:57.000000000 -0800
@@ -21,7 +21,7 @@
PMf_KEEP PMf_GLOBAL PMf_CONTINUE PMf_EVAL PMf_ONCE
PMf_MULTILINE PMf_SINGLELINE PMf_FOLD PMf_EXTENDED),
($] < 5.009 ? 'PMf_SKIPWHITE' : 'RXf_SKIPWHITE');
-$VERSION = 0.83;
+$VERSION = 0.84;
use strict;
use vars qw/$AUTOLOAD/;
use warnings ();
@@ -1624,6 +1624,9 @@
sub pp_each { unop(@_, "each") }
sub pp_values { unop(@_, "values") }
sub pp_keys { unop(@_, "keys") }
+sub pp_aeach { unop(@_, "each") }
+sub pp_avalues { unop(@_, "values") }
+sub pp_akeys { unop(@_, "keys") }
sub pp_pop { unop(@_, "pop") }
sub pp_shift { unop(@_, "shift") }
==== //depot/maint-5.8/perl/ext/B/t/b.t#10 (xtext) ====
Index: perl/ext/B/t/b.t
--- perl/ext/B/t/b.t#9~31161~ 2007-05-07 03:47:46.000000000 -0700
+++ perl/ext/B/t/b.t 2008-02-02 11:08:57.000000000 -0800
@@ -74,8 +74,11 @@
'$. has no more magic' );
}
-ok(B::svref_2object(qr/foo/)->MAGIC->precomp() eq 'foo', 'Get string from
qr//');
-like(B::svref_2object(qr/foo/)->MAGIC->REGEX(), qr/\d+/, "REGEX() returns
numeric value");
+my $r = qr/foo/;
+my $obj = B::svref_2object($r);
+my $regexp = ($] < 5.011) ? $obj->MAGIC : $obj;
+ok($regexp->precomp() eq 'foo', 'Get string from qr//');
+like($regexp->REGEX(), qr/\d+/, "REGEX() returns numeric value");
my $iv = 1;
my $iv_ref = B::svref_2object(\$iv);
is(ref $iv_ref, "B::IV", "Test B:IV return from svref_2object");
@@ -126,21 +129,25 @@
is(ref $null_ret, "SCALAR", "Test object_2svref() return is SCALAR");
is($$null_ret, $nv, "Test object_2svref()");
+my $RV_class = $] >= 5.011 ? 'B::IV' : 'B::RV';
my $cv = sub{ 1; };
my $cv_ref = B::svref_2object(\$cv);
-is($cv_ref->REFCNT, 1, "Test B::RV->REFCNT");
-is(ref $cv_ref, "B::RV", "Test B::RV return from svref_2object - code");
+is($cv_ref->REFCNT, 1, "Test $RV_class->REFCNT");
+is(ref $cv_ref, "$RV_class",
+ "Test $RV_class return from svref_2object - code");
my $cv_ret = $cv_ref->object_2svref();
is(ref $cv_ret, "REF", "Test object_2svref() return is REF");
is($$cv_ret, $cv, "Test object_2svref()");
my $av = [];
my $av_ref = B::svref_2object(\$av);
-is(ref $av_ref, "B::RV", "Test B::RV return from svref_2object - array");
+is(ref $av_ref, "$RV_class",
+ "Test $RV_class return from svref_2object - array");
my $hv = [];
my $hv_ref = B::svref_2object(\$hv);
-is(ref $hv_ref, "B::RV", "Test B::RV return from svref_2object - hash");
+is(ref $hv_ref, "$RV_class",
+ "Test $RV_class return from svref_2object - hash");
local *gv = *STDOUT;
my $gv_ref = B::svref_2object(\*gv);
==== //depot/maint-5.8/perl/ext/B/t/concise.t#17 (text) ====
Index: perl/ext/B/t/concise.t
--- perl/ext/B/t/concise.t#16~32265~ 2007-11-10 03:31:16.000000000 -0800
+++ perl/ext/B/t/concise.t 2008-02-02 11:08:57.000000000 -0800
@@ -14,7 +14,6 @@
exit 0;
}
require 'test.pl'; # we use runperl from 'test.pl', so can't use
Test::More
- sub diag { print "# @_\n" } # but this is still handy
}
plan tests => 156;
@@ -201,7 +200,8 @@
sub defd_empty {};
($res,$err) = render('-basic', \&defd_empty);
- is(scalar split(/\n/, $res), 3,
+ my @lines = split(/\n/, $res);
+ is(scalar @lines, 3,
"'sub defd_empty {}' seen as 3 liner");
is(1, $res =~ /leavesub/ && $res =~ /(next|db)state/,
==== //depot/maint-5.8/perl/ext/B/t/deparse.t#16 (text) ====
Index: perl/ext/B/t/deparse.t
--- perl/ext/B/t/deparse.t#15~32265~ 2007-11-10 03:31:16.000000000 -0800
+++ perl/ext/B/t/deparse.t 2008-02-02 11:08:57.000000000 -0800
@@ -27,7 +27,7 @@
require feature;
feature->import(':5.10');
}
-use Test::More tests => 54;
+use Test::More tests => 57;
use B::Deparse;
my $deparse = B::Deparse->new();
@@ -102,8 +102,9 @@
use constant cr => ['hello'];
my $string = "sub " . $deparse->coderef2text(\&cr);
-my $val = (eval $string)->();
-ok( ref($val) eq 'ARRAY' && $val->[0] eq 'hello');
+my $val = (eval $string)->() or diag $string;
+is(ref($val), 'ARRAY');
+is($val->[0], 'hello');
my $Is_VMS = $^O eq 'VMS';
my $Is_MacOS = $^O eq 'MacOS';
@@ -384,3 +385,13 @@
return $x++;
}
;
+####
+# SKIP ?$] < 5.011 && 'each @array not implemented on this Perl version'
+# 49 each @array;
+each @ARGV;
+each @$a;
+####
+# SKIP ?$] < 5.011 && 'each @array not implemented on this Perl version'
+# 50 keys @array; values @array
+keys @$a if keys @ARGV;
+values @ARGV if values @$a;
==== //depot/maint-5.8/perl/ext/B/t/optree_constants.t#2 (text) ====
Index: perl/ext/B/t/optree_constants.t
--- perl/ext/B/t/optree_constants.t#1~30564~ 2007-03-13 10:50:17.000000000
-0700
+++ perl/ext/B/t/optree_constants.t 2008-02-02 11:08:57.000000000 -0800
@@ -43,21 +43,27 @@
sub myno () { return 1!=1 }
sub pi () { 3.14159 };
+my $RV_class = $] >= 5.011 ? 'IV' : 'RV';
+
my $want = { # expected types, how value renders in-line, todos (maybe)
mystr => [ 'PV', '"'.mystr.'"' ],
- myhref => [ 'RV', '\\\\HASH'],
+ myhref => [ $RV_class, '\\\\HASH'],
pi => [ 'NV', pi ],
- myglob => [ 'RV', '\\\\' ],
- mysub => [ 'RV', '\\\\' ],
- myunsub => [ 'RV', '\\\\' ],
+ myglob => [ $RV_class, '\\\\' ],
+ mysub => [ $RV_class, '\\\\' ],
+ myunsub => [ $RV_class, '\\\\' ],
# these are not inlined, at least not per BC::Concise
- #myyes => [ 'RV', ],
- #myno => [ 'RV', ],
+ #myyes => [ $RV_class, ],
+ #myno => [ $RV_class, ],
$] > 5.009 ? (
- myaref => [ 'RV', '\\\\' ],
+ myaref => [ $RV_class, '\\\\' ],
myfl => [ 'NV', myfl ],
myint => [ 'IV', myint ],
- myrex => [ 'RV', '\\\\' ],
+ $] >= 5.011 ? (
+ myrex => [ $RV_class, '\\\\"\\(?-xism:Foo\\)"' ],
+ ) : (
+ myrex => [ $RV_class, '\\\\' ],
+ ),
myundef => [ 'NULL', ],
) : (
myaref => [ 'PVIV', '' ],
==== //depot/maint-5.8/perl/ext/B/t/terse.t#5 (text) ====
Index: perl/ext/B/t/terse.t
--- perl/ext/B/t/terse.t#4~23814~ 2005-01-18 14:08:15.000000000 -0800
+++ perl/ext/B/t/terse.t 2008-02-02 11:08:57.000000000 -0800
@@ -99,7 +99,11 @@
$path = '-I::lib -MMac::err=unix' if $^O eq 'MacOS';
my $redir = $^O eq 'MacOS' ? '' : "2>&1";
my $items = qx{$^X $path "-MO=Terse" -le "print \\42" $redir};
-like( $items, qr/RV $hex \\42/, 'RV' );
+if( $] >= 5.011 ) {
+ like( $items, qr/IV $hex \\42/, 'RV (but now stored in an IV)' );
+} else {
+ like( $items, qr/RV $hex \\42/, 'RV' );
+}
package TieOut;
==== //depot/maint-5.8/perl/ext/B/typemap#6 (text) ====
Index: perl/ext/B/typemap
--- perl/ext/B/typemap#5~30564~ 2007-03-13 10:50:17.000000000 -0700
+++ perl/ext/B/typemap 2008-02-02 11:08:57.000000000 -0800
@@ -17,6 +17,7 @@
B::IV T_SV_OBJ
B::NV T_SV_OBJ
B::PVMG T_SV_OBJ
+B::REGEXP T_SV_OBJ
B::PVLV T_SV_OBJ
B::BM T_SV_OBJ
B::RV T_SV_OBJ
==== //depot/maint-5.8/perl/ext/Devel/DProf/DProf.xs#15 (text) ====
Index: perl/ext/Devel/DProf/DProf.xs
--- perl/ext/Devel/DProf/DProf.xs#14~32296~ 2007-11-12 15:04:43.000000000
-0800
+++ perl/ext/Devel/DProf/DProf.xs 2008-02-02 11:08:57.000000000 -0800
@@ -466,10 +466,6 @@
}
}
-#ifdef PL_NEEDED
-# define defstash PL_defstash
-#endif
-
/* Counts overhead of prof_mark and extra XS call. */
static void
test_time(pTHX_ clock_t *r, clock_t *u, clock_t *s)
==== //depot/maint-5.8/perl/ext/Devel/DProf/Makefile.PL#3 (text) ====
Index: perl/ext/Devel/DProf/Makefile.PL
--- perl/ext/Devel/DProf/Makefile.PL#2~18535~ 2003-01-20 18:49:55.000000000
-0800
+++ perl/ext/Devel/DProf/Makefile.PL 2008-02-02 11:08:57.000000000 -0800
@@ -10,8 +10,6 @@
VERSION_FROM => 'DProf.pm',
clean => { 'FILES' => 'tmon.out t/tmon.out t/err'},
XSPROTOARG => '-noprototypes',
- DEFINE => '-DPERLDBf_NONAME=0x40 -DPERLDBf_GOTO=0x80 '
- .'-DG_NODEBUG=32 -DPL_NEEDED',
dist => {
COMPRESS => 'gzip -9f',
SUFFIX => 'gz',
==== //depot/maint-5.8/perl/ext/Devel/Peek/t/Peek.t#14 (text) ====
Index: perl/ext/Devel/Peek/t/Peek.t
--- perl/ext/Devel/Peek/t/Peek.t#13~30695~ 2007-03-22 13:59:51.000000000
-0700
+++ perl/ext/Devel/Peek/t/Peek.t 2008-02-02 11:08:57.000000000 -0800
@@ -14,11 +14,12 @@
use Devel::Peek;
-plan(24);
+plan(25);
our $DEBUG = 0;
open(SAVERR, ">&STDERR") or die "Can't dup STDERR: $!";
+
sub do_test {
my $pattern = pop;
if (open(OUT,">peek$$")) {
@@ -32,6 +33,24 @@
$pattern =~ s/\$FLOAT/(?:\\d*\\.\\d+(?:e[-+]\\d+)?|\\d+)/g;
# handle DEBUG_LEAKING_SCALARS prefix
$pattern =~ s/^(\s*)(SV =.* at )/(?:$1ALLOCATED at .*?\n)?$1$2/mg;
+
+ $pattern =~ s/^ *\$XSUB *\n/
+ ($] < 5.009) ? " XSUB = 0x0\n XSUBANY = 0\n" : '';
+ /mge;
+ $pattern =~ s/^ *\$ROOT *\n/
+ ($] < 5.009) ? " ROOT = 0x0\n" : '';
+ /mge;
+ $pattern =~ s/\$RV/
+ ($] < 5.011) ? 'RV' : 'IV';
+ /mge;
+ $pattern =~ s/^ *\$NV *\n/
+ ($] < 5.011) ? " NV = 0\n" : '';
+ /mge;
+ $pattern =~ s/^ *\$SUBPROCESS *\n/
+ ($] < 5.009) ? " SUBPROCESS = 0\n" : '';
+ /mge;
+
+
print $pattern, "\n" if $DEBUG;
my $dump = <IN>;
print $dump, "\n" if $DEBUG;
@@ -134,7 +153,7 @@
do_test(10,
\$a,
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = $RV\\($ADDR\\) at $ADDR
REFCNT = 1
FLAGS = \\(ROK\\)
RV = $ADDR
@@ -163,7 +182,7 @@
}
do_test(11,
[$b,$c],
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = $RV\\($ADDR\\) at $ADDR
REFCNT = 1
FLAGS = \\(ROK\\)
RV = $ADDR
@@ -186,7 +205,7 @@
do_test(12,
{$b=>$c},
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = $RV\\($ADDR\\) at $ADDR
REFCNT = 1
FLAGS = \\(ROK\\)
RV = $ADDR
@@ -206,7 +225,7 @@
do_test(13,
sub()[EMAIL PROTECTED],
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = $RV\\($ADDR\\) at $ADDR
REFCNT = 1
FLAGS = \\(ROK\\)
RV = $ADDR
@@ -219,8 +238,7 @@
COMP_STASH = $ADDR\\t"main"
START = $ADDR ===> \\d+
ROOT = $ADDR
- XSUB = 0x0
- XSUBANY = 0
+ $XSUB
GVGV::GV = $ADDR\\t"main" :: "__ANON__[^"]*"
FILE = ".*\\b(?i:peek\\.t)"
DEPTH = 0
@@ -234,7 +252,7 @@
do_test(14,
\&do_test,
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = $RV\\($ADDR\\) at $ADDR
REFCNT = 1
FLAGS = \\(ROK\\)
RV = $ADDR
@@ -246,8 +264,7 @@
COMP_STASH = $ADDR\\t"main"
START = $ADDR ===> \\d+
ROOT = $ADDR
- XSUB = 0x0
- XSUBANY = 0
+ $XSUB
GVGV::GV = $ADDR\\t"main" :: "do_test"
FILE = ".*\\b(?i:peek\\.t)"
DEPTH = 1
@@ -262,9 +279,25 @@
\\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$dump"
OUTSIDE = $ADDR \\(MAIN\\)');
+if ($] >= 5.011) {
do_test(15,
qr(tic),
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = $RV\\($ADDR\\) at $ADDR
+ REFCNT = 1
+ FLAGS = \\(ROK\\)
+ RV = $ADDR
+ SV = REGEXP\\($ADDR\\) at $ADDR
+ REFCNT = 2
+ FLAGS = \\(OBJECT,POK,pPOK\\)
+ IV = 0
+ PV = $ADDR "\\(\\?-xism:tic\\)"\\\0
+ CUR = 12
+ LEN = \\d+
+ STASH = $ADDR\\t"Regexp"');
+} else {
+do_test(15,
+ qr(tic),
+'SV = $RV\\($ADDR\\) at $ADDR
REFCNT = 1
FLAGS = \\(ROK\\)
RV = $ADDR
@@ -279,10 +312,11 @@
MG_TYPE = PERL_MAGIC_qr\(r\)
MG_OBJ = $ADDR
STASH = $ADDR\\t"Regexp"');
+}
do_test(16,
(bless {}, "Tac"),
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = $RV\\($ADDR\\) at $ADDR
REFCNT = 1
FLAGS = \\(ROK\\)
RV = $ADDR
@@ -352,7 +386,7 @@
if (ord('A') == 193) {
do_test(19,
{chr(256)=>chr(512)},
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = $RV\\($ADDR\\) at $ADDR
REFCNT = 1
FLAGS = \\(ROK\\)
RV = $ADDR
@@ -378,7 +412,7 @@
} else {
do_test(19,
{chr(256)=>chr(512)},
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = $RV\\($ADDR\\) at $ADDR
REFCNT = 1
FLAGS = \\(ROK\\)
RV = $ADDR
@@ -459,7 +493,7 @@
# blessed refs
do_test(22,
bless(\\undef, 'Foobar'),
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = $RV\\($ADDR\\) at $ADDR
REFCNT = 1
FLAGS = \\(ROK\\)
RV = $ADDR
@@ -485,7 +519,7 @@
do_test(23,
\&const,
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = $RV\\($ADDR\\) at $ADDR
REFCNT = 1
FLAGS = \\(ROK\\)
RV = $ADDR
@@ -496,7 +530,7 @@
NV = 0
PROTOTYPE = ""
COMP_STASH = 0x0
- ROOT = 0x0
+ $ROOT
XSUB = $ADDR
XSUBANY = $ADDR \\(CONST SV\\)
SV = PV\\($ADDR\\) at $ADDR
@@ -524,3 +558,29 @@
UV = \d+
NV = 0
PV = 0');
+
+do_test(25,
+ *STDOUT{IO},
+'SV = $RV\\($ADDR\\) at $ADDR
+ REFCNT = 1
+ FLAGS = \\(ROK\\)
+ RV = $ADDR
+ SV = PVIO\\($ADDR\\) at $ADDR
+ REFCNT = 3
+ FLAGS = \\(OBJECT\\)
+ IV = 0
+ $NV
+ STASH = $ADDR\s+"IO::Handle"
+ IFP = $ADDR
+ OFP = $ADDR
+ DIRP = 0x0
+ LINES = 0
+ PAGE = 0
+ PAGE_LEN = 60
+ LINES_LEFT = 0
+ TOP_GV = 0x0
+ FMT_GV = 0x0
+ BOTTOM_GV = 0x0
+ $SUBPROCESS
+ TYPE = \'>\'
+ FLAGS = 0x0');
==== //depot/maint-5.8/perl/ext/Storable/Storable.xs#33 (text) ====
Index: perl/ext/Storable/Storable.xs
--- perl/ext/Storable/Storable.xs#32~32449~ 2007-11-22 09:31:11.000000000
-0800
+++ perl/ext/Storable/Storable.xs 2008-02-02 11:08:57.000000000 -0800
@@ -3434,7 +3434,9 @@
{
switch (SvTYPE(sv)) {
case SVt_NULL:
+#if PERL_VERSION <= 10
case SVt_IV:
+#endif
case SVt_NV:
/*
* No need to check for ROK, that can't be set here since there
@@ -3442,7 +3444,11 @@
*/
return svis_SCALAR;
case SVt_PV:
+#if PERL_VERSION <= 10
case SVt_RV:
+#else
+ case SVt_IV:
+#endif
case SVt_PVIV:
case SVt_PVNV:
/*
@@ -4497,7 +4503,7 @@
if (cname) {
/* No need to do anything, as rv will already be PVMG. */
- assert (SvTYPE(rv) >= SVt_RV);
+ assert (SvTYPE(rv) == SVt_RV || SvTYPE(rv) >= SVt_PV);
} else {
sv_upgrade(rv, SVt_RV);
}
End of Patch.
