Change 33126 by [EMAIL PROTECTED] on 2008/01/30 15:26:23
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.
Affected files ...
... //depot/maint-5.10/perl/ext/B/B.pm#2 integrate
... //depot/maint-5.10/perl/ext/B/B.xs#2 integrate
... //depot/maint-5.10/perl/ext/B/B/Concise.pm#2 integrate
... //depot/maint-5.10/perl/ext/B/B/Deparse.pm#2 integrate
... //depot/maint-5.10/perl/ext/B/t/b.t#2 integrate
... //depot/maint-5.10/perl/ext/B/t/concise.t#2 integrate
... //depot/maint-5.10/perl/ext/B/t/deparse.t#2 integrate
... //depot/maint-5.10/perl/ext/B/t/optree_constants.t#2 integrate
... //depot/maint-5.10/perl/ext/B/t/terse.t#2 integrate
... //depot/maint-5.10/perl/ext/Devel/Peek/t/Peek.t#2 integrate
... //depot/maint-5.10/perl/ext/Storable/Storable.xs#2 integrate
Differences ...
==== //depot/maint-5.10/perl/ext/B/B.pm#2 (text) ====
Index: perl/ext/B/B.pm
--- perl/ext/B/B.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/ext/B/B.pm 2008-01-30 07:26:23.000000000 -0800
@@ -7,7 +7,7 @@
#
package B;
-our $VERSION = '1.17';
+our $VERSION = '1.18';
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]::ORANGE::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, 5.10.1 I<etc> this is:
B::SV
|
@@ -601,6 +603,9 @@
B::PVLV B::FM
+For 5.11.0 and later, B::RV is abolished, and IVs can be used to store
+references.
+
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
==== //depot/maint-5.10/perl/ext/B/B.xs#2 (text) ====
Index: perl/ext/B/B.xs
--- perl/ext/B/B.xs#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/ext/B/B.xs 2008-01-30 07:26:23.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::ORANGE",
+#endif
#if PERL_VERSION >= 9
"B::GV",
#endif
@@ -1366,6 +1371,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 +1415,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*
==== //depot/maint-5.10/perl/ext/B/B/Concise.pm#2 (text) ====
Index: perl/ext/B/B/Concise.pm
--- perl/ext/B/B/Concise.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/ext/B/B/Concise.pm 2008-01-30 07:26:23.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.10/perl/ext/B/B/Deparse.pm#2 (text) ====
Index: perl/ext/B/B/Deparse.pm
--- perl/ext/B/B/Deparse.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/ext/B/B/Deparse.pm 2008-01-30 07:26:23.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.10/perl/ext/B/t/b.t#2 (xtext) ====
Index: perl/ext/B/t/b.t
--- perl/ext/B/t/b.t#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/ext/B/t/b.t 2008-01-30 07:26:23.000000000 -0800
@@ -126,21 +126,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.10/perl/ext/B/t/concise.t#2 (text) ====
Index: perl/ext/B/t/concise.t
--- perl/ext/B/t/concise.t#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/ext/B/t/concise.t 2008-01-30 07:26:23.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.10/perl/ext/B/t/deparse.t#2 (text) ====
Index: perl/ext/B/t/deparse.t
--- perl/ext/B/t/deparse.t#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/ext/B/t/deparse.t 2008-01-30 07:26:23.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.10/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~32694~ 2007-12-22 01:23:09.000000000
-0800
+++ perl/ext/B/t/optree_constants.t 2008-01-30 07:26:23.000000000 -0800
@@ -43,21 +43,23 @@
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', '\\\\' ],
+ myrex => [ $RV_class, '\\\\' ],
myundef => [ 'NULL', ],
) : (
myaref => [ 'PVIV', '' ],
==== //depot/maint-5.10/perl/ext/B/t/terse.t#2 (text) ====
Index: perl/ext/B/t/terse.t
--- perl/ext/B/t/terse.t#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/ext/B/t/terse.t 2008-01-30 07:26:23.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.10/perl/ext/Devel/Peek/t/Peek.t#2 (text) ====
Index: perl/ext/Devel/Peek/t/Peek.t
--- perl/ext/Devel/Peek/t/Peek.t#1~32694~ 2007-12-22 01:23:09.000000000
-0800
+++ perl/ext/Devel/Peek/t/Peek.t 2008-01-30 07:26:23.000000000 -0800
@@ -44,6 +44,9 @@
$pattern =~ s/^ *\$IVNV *\n/
($] < 5.009) ? " IV = 0\n NV = 0\n" : '';
/mge;
+ $pattern =~ s/\$RV/
+ ($] < 5.011) ? 'RV' : 'IV';
+ /mge;
print $pattern, "\n" if $DEBUG;
my ($dump, $dump2) = split m/\*\*\*\*\*\n/, scalar <IN>;
@@ -153,7 +156,7 @@
do_test(10,
\$a,
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = $RV\\($ADDR\\) at $ADDR
REFCNT = 1
FLAGS = \\(ROK\\)
RV = $ADDR
@@ -182,7 +185,7 @@
}
do_test(11,
[$b,$c],
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = $RV\\($ADDR\\) at $ADDR
REFCNT = 1
FLAGS = \\(ROK\\)
RV = $ADDR
@@ -203,7 +206,7 @@
do_test(12,
{$b=>$c},
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = $RV\\($ADDR\\) at $ADDR
REFCNT = 1
FLAGS = \\(ROK\\)
RV = $ADDR
@@ -221,7 +224,7 @@
do_test(13,
sub()[EMAIL PROTECTED],
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = $RV\\($ADDR\\) at $ADDR
REFCNT = 1
FLAGS = \\(ROK\\)
RV = $ADDR
@@ -247,7 +250,7 @@
do_test(14,
\&do_test,
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = $RV\\($ADDR\\) at $ADDR
REFCNT = 1
FLAGS = \\(ROK\\)
RV = $ADDR
@@ -274,9 +277,30 @@
\\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$dump2"
OUTSIDE = $ADDR \\(MAIN\\)');
+if ($] >= 5.011) {
+do_test(15,
+ qr(tic),
+'SV = $RV\\($ADDR\\) at $ADDR
+ REFCNT = 1
+ FLAGS = \\(ROK\\)
+ RV = $ADDR
+ SV = ORANGE\\($ADDR\\) at $ADDR
+ REFCNT = 1
+ FLAGS = \\(OBJECT,SMG\\)
+ IV = 0
+ NV = 0
+ PV = 0
+ MAGIC = $ADDR
+ MG_VIRTUAL = $ADDR
+ MG_TYPE = PERL_MAGIC_qr\(r\)
+ MG_OBJ = $ADDR
+ PAT = "\(\?-xism:tic\)"
+ REFCNT = 2
+ STASH = $ADDR\\t"Regexp"');
+} else {
do_test(15,
qr(tic),
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = $RV\\($ADDR\\) at $ADDR
REFCNT = 1
FLAGS = \\(ROK\\)
RV = $ADDR
@@ -293,10 +317,11 @@
PAT = "\(\?-xism:tic\)"
REFCNT = 2
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
@@ -356,7 +381,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
@@ -380,7 +405,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 +484,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 +510,7 @@
do_test(23,
\&const,
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = $RV\\($ADDR\\) at $ADDR
REFCNT = 1
FLAGS = \\(ROK\\)
RV = $ADDR
==== //depot/maint-5.10/perl/ext/Storable/Storable.xs#2 (text) ====
Index: perl/ext/Storable/Storable.xs
--- perl/ext/Storable/Storable.xs#1~32694~ 2007-12-22 01:23:09.000000000
-0800
+++ perl/ext/Storable/Storable.xs 2008-01-30 07:26:23.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.
