diff options
author | Nicholas Clark <nick@ccl4.org> | 2007-12-26 17:03:56 +0000 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2007-12-26 17:03:56 +0000 |
commit | 4df7f6afd80e96d28fd18bba9dda8b38b6ed6700 (patch) | |
tree | 4a12163f0a4326186eaaa2db0ba65cb330932dc6 /ext | |
parent | 0707d6cc81b12c5d582707b1575b1be4695dd7fc (diff) | |
download | perl-4df7f6afd80e96d28fd18bba9dda8b38b6ed6700.tar.gz |
Eliminate SVt_RV, and use SVt_IV to store plain references.
This frees up a scalar type for first class regular expressions.
p4raw-id: //depot/perl@32734
Diffstat (limited to 'ext')
-rw-r--r-- | ext/B/B.pm | 12 | ||||
-rw-r--r-- | ext/B/B.xs | 29 | ||||
-rw-r--r-- | ext/B/B/Concise.pm | 15 | ||||
-rwxr-xr-x | ext/B/t/b.t | 12 | ||||
-rw-r--r-- | ext/B/t/optree_constants.t | 18 | ||||
-rw-r--r-- | ext/B/t/terse.t | 6 | ||||
-rw-r--r-- | ext/Devel/Peek/t/Peek.t | 23 | ||||
-rw-r--r-- | ext/Storable/Storable.xs | 6 |
8 files changed, 88 insertions, 33 deletions
diff --git a/ext/B/B.pm b/ext/B/B.pm index 7c606e3c59..9dc85bb4bf 100644 --- a/ext/B/B.pm +++ b/ext/B/B.pm @@ -7,7 +7,7 @@ # package B; -our $VERSION = '1.17'; +our $VERSION = '1.18'; use XSLoader (); require Exporter; @@ -33,7 +33,8 @@ use strict; @B::PV::ISA = 'B::SV'; @B::IV::ISA = 'B::SV'; @B::NV::ISA = 'B::SV'; -@B::RV::ISA = 'B::SV'; +# RV is eliminated with 5.11.0, but effectively is a specialisation of IV now. +@B::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'; @@ -574,8 +575,8 @@ give incomprehensible results, or worse. 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 +602,9 @@ and later this is: 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 diff --git a/ext/B/B.xs b/ext/B/B.xs index e6af7a1531..aa02d540c8 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -25,8 +25,10 @@ static const char* const svclassnames[] = { "B::BIND", #endif "B::IV", - "B::RV", "B::NV", +#if PERL_VERSION <= 10 + "B::RV", +#endif "B::PV", "B::PVIV", "B::PVNV", @@ -34,6 +36,9 @@ static const char* const svclassnames[] = { #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 @@ packiv(sv) 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 @@ U32 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* diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm index e458727318..7e81d85e2b 100644 --- a/ext/B/B/Concise.pm +++ b/ext/B/B/Concise.pm @@ -28,7 +28,7 @@ our %EXPORT_TAGS = # 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 @@ sub concise_sv { $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]; diff --git a/ext/B/t/b.t b/ext/B/t/b.t index e0e21f4a96..0a3f245090 100755 --- a/ext/B/t/b.t +++ b/ext/B/t/b.t @@ -126,21 +126,25 @@ my $null_ret = $nv_ref->object_2svref(); 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); diff --git a/ext/B/t/optree_constants.t b/ext/B/t/optree_constants.t index c39a054456..c05138b633 100644 --- a/ext/B/t/optree_constants.t +++ b/ext/B/t/optree_constants.t @@ -43,21 +43,23 @@ sub myyes() { 1==1 } 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', '' ], diff --git a/ext/B/t/terse.t b/ext/B/t/terse.t index 2df8eee9b2..8d86a49bfe 100644 --- a/ext/B/t/terse.t +++ b/ext/B/t/terse.t @@ -99,7 +99,11 @@ my $path = join " ", map { qq["-I$_"] } @INC; $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; diff --git a/ext/Devel/Peek/t/Peek.t b/ext/Devel/Peek/t/Peek.t index 0b6878e927..76118d1395 100644 --- a/ext/Devel/Peek/t/Peek.t +++ b/ext/Devel/Peek/t/Peek.t @@ -44,6 +44,7 @@ sub do_test { $pattern =~ s/^ *\$IVNV *\n/ ($] < 5.009) ? " IV = 0\n NV = 0\n" : ''; /mge; + $pattern =~ s/\$RV/IV/g if $] >= 5.011; print $pattern, "\n" if $DEBUG; my ($dump, $dump2) = split m/\*\*\*\*\*\n/, scalar <IN>; @@ -153,7 +154,7 @@ do_test( 9, do_test(10, \$a, -'SV = RV\\($ADDR\\) at $ADDR +'SV = $RV\\($ADDR\\) at $ADDR REFCNT = 1 FLAGS = \\(ROK\\) RV = $ADDR @@ -182,7 +183,7 @@ if ($type eq 'N') { } do_test(11, [$b,$c], -'SV = RV\\($ADDR\\) at $ADDR +'SV = $RV\\($ADDR\\) at $ADDR REFCNT = 1 FLAGS = \\(ROK\\) RV = $ADDR @@ -203,7 +204,7 @@ do_test(11, do_test(12, {$b=>$c}, -'SV = RV\\($ADDR\\) at $ADDR +'SV = $RV\\($ADDR\\) at $ADDR REFCNT = 1 FLAGS = \\(ROK\\) RV = $ADDR @@ -221,7 +222,7 @@ do_test(12, do_test(13, sub(){@_}, -'SV = RV\\($ADDR\\) at $ADDR +'SV = $RV\\($ADDR\\) at $ADDR REFCNT = 1 FLAGS = \\(ROK\\) RV = $ADDR @@ -247,7 +248,7 @@ do_test(13, do_test(14, \&do_test, -'SV = RV\\($ADDR\\) at $ADDR +'SV = $RV\\($ADDR\\) at $ADDR REFCNT = 1 FLAGS = \\(ROK\\) RV = $ADDR @@ -276,7 +277,7 @@ do_test(14, do_test(15, qr(tic), -'SV = RV\\($ADDR\\) at $ADDR +'SV = $RV\\($ADDR\\) at $ADDR REFCNT = 1 FLAGS = \\(ROK\\) RV = $ADDR @@ -296,7 +297,7 @@ do_test(15, do_test(16, (bless {}, "Tac"), -'SV = RV\\($ADDR\\) at $ADDR +'SV = $RV\\($ADDR\\) at $ADDR REFCNT = 1 FLAGS = \\(ROK\\) RV = $ADDR @@ -356,7 +357,7 @@ do_test(18, 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 +381,7 @@ do_test(19, } 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 +460,7 @@ do_test(21, # 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 +486,7 @@ sub const () { do_test(23, \&const, -'SV = RV\\($ADDR\\) at $ADDR +'SV = $RV\\($ADDR\\) at $ADDR REFCNT = 1 FLAGS = \\(ROK\\) RV = $ADDR diff --git a/ext/Storable/Storable.xs b/ext/Storable/Storable.xs index e284163f99..bb68c1bc36 100644 --- a/ext/Storable/Storable.xs +++ b/ext/Storable/Storable.xs @@ -3434,7 +3434,9 @@ static int sv_type(pTHX_ SV *sv) { 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 @@ static int sv_type(pTHX_ SV *sv) */ return svis_SCALAR; case SVt_PV: +#if PERL_VERSION <= 10 case SVt_RV: +#else + case SVt_IV: +#endif case SVt_PVIV: case SVt_PVNV: /* |