diff options
| -rw-r--r-- | dump.c | 12 | ||||
| -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 | ||||
| -rw-r--r-- | pp.c | 6 | ||||
| -rw-r--r-- | pp_hot.c | 6 | ||||
| -rw-r--r-- | sv.c | 108 | ||||
| -rw-r--r-- | sv.h | 20 |
13 files changed, 163 insertions, 110 deletions
@@ -31,12 +31,12 @@ static const char* const svtypenames[SVt_LAST] = { "NULL", "BIND", "IV", - "RV", "NV", "PV", "PVIV", "PVNV", "PVMG", + "ORANGE", "PVGV", "PVLV", "PVAV", @@ -51,12 +51,12 @@ static const char* const svshorttypenames[SVt_LAST] = { "UNDEF", "BIND", "IV", - "RV", "NV", "PV", "PVIV", "PVNV", "PVMG", + "ORANGE", "GV", "PVLV", "AV", @@ -1529,7 +1529,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo } if ((type >= SVt_PVIV && type != SVt_PVAV && type != SVt_PVHV && type != SVt_PVCV && !isGV_with_GP(sv)) - || type == SVt_IV) { + || (type == SVt_IV && !SvROK(sv))) { if (SvIsUV(sv) #ifdef PERL_OLD_COPY_ON_WRITE || SvIsCOW(sv) @@ -2371,9 +2371,6 @@ Perl_sv_xmlpeek(pTHX_ SV *sv) case SVt_NV: sv_catpv(t, " NV=\""); break; - case SVt_RV: - sv_catpv(t, " RV=\""); - break; case SVt_PV: sv_catpv(t, " PV=\""); break; @@ -2407,6 +2404,9 @@ Perl_sv_xmlpeek(pTHX_ SV *sv) case SVt_BIND: sv_catpv(t, " BIND=\""); break; + case SVt_ORANGE: + sv_catpv(t, " ORANGE=\""); + break; case SVt_PVFM: sv_catpv(t, " FM=\""); break; 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: /* @@ -172,8 +172,8 @@ PP(pp_rv2gv) const char * const name = CopSTASHPV(PL_curcop); gv = newGVgen(name); } - if (SvTYPE(sv) < SVt_RV || SvTYPE(sv) == SVt_NV) - sv_upgrade(sv, SVt_RV); + if (SvTYPE(sv) < SVt_PV && SvTYPE(sv) != SVt_IV) + sv_upgrade(sv, SVt_IV); else if (SvPVX_const(sv)) { SvPV_free(sv); SvLEN_set(sv, 0); @@ -536,7 +536,7 @@ S_refto(pTHX_ SV *sv) SvREFCNT_inc_void_NN(sv); } rv = sv_newmortal(); - sv_upgrade(rv, SVt_RV); + sv_upgrade(rv, SVt_IV); SvRV_set(rv, sv); SvROK_on(rv); return rv; @@ -150,7 +150,7 @@ PP(pp_sassign) The gv becomes a(nother) reference to the constant. */ SV *const value = SvRV(cv); - SvUPGRADE((SV *)gv, SVt_RV); + SvUPGRADE((SV *)gv, SVt_IV); SvPCS_IMPORTED_on(gv); SvRV_set(gv, value); SvREFCNT_inc_simple_void(value); @@ -2940,8 +2940,8 @@ Perl_vivify_ref(pTHX_ SV *sv, U32 to_what) if (!SvOK(sv)) { if (SvREADONLY(sv)) Perl_croak(aTHX_ PL_no_modify); - if (SvTYPE(sv) < SVt_RV || SvTYPE(sv) == SVt_NV) - sv_upgrade(sv, SVt_RV); + if (SvTYPE(sv) < SVt_PV && SvTYPE(sv) != SVt_IV) + sv_upgrade(sv, SVt_IV); else if (SvTYPE(sv) >= SVt_PV) { SvPV_free(sv); SvLEN_set(sv, 0); @@ -890,9 +890,6 @@ static const struct body_details bodies_by_type[] = { FIT_ARENA(0, sizeof(struct ptr_tbl_ent)) }, - /* RVs are in the head now. */ - { 0, 0, 0, SVt_RV, FALSE, NONV, NOARENA, 0 }, - /* 8 bytes on most ILP32 with IEEE doubles */ { sizeof(NV), sizeof(NV), 0, SVt_NV, FALSE, HADNV, HASARENA, FIT_ARENA(0, sizeof(NV)) }, @@ -918,7 +915,10 @@ static const struct body_details bodies_by_type[] = { /* 28 */ { sizeof(XPVMG), copy_length(XPVMG, xmg_stash), 0, SVt_PVMG, FALSE, HADNV, HASARENA, FIT_ARENA(0, sizeof(XPVMG)) }, - + + /* There are plans for this */ + { 0, 0, 0, SVt_ORANGE, FALSE, NONV, NOARENA, 0 }, + /* 48 */ { sizeof(XPVGV), sizeof(XPVGV), 0, SVt_PVGV, TRUE, HADNV, HASARENA, FIT_ARENA(0, sizeof(XPVGV)) }, @@ -1115,6 +1115,7 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type) const struct body_details *new_type_details; const struct body_details *const old_type_details = bodies_by_type + old_type; + SV *referant = NULL; if (new_type != SVt_PV && SvIsCOW(sv)) { sv_force_normal_flags(sv, 0); @@ -1123,12 +1124,6 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type) if (old_type == new_type) return; - if (old_type == SVt_RV) { - /* Verify my assumption that no-one upgrades a scalar which has a - referant but isn't flagged as a reference. */ - assert(!(!SvROK(sv) && SvRV(sv))); - } - old_body = SvANY(sv); /* Copying structures onto other structures that have been neatly zeroed @@ -1173,9 +1168,18 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type) case SVt_NULL: break; case SVt_IV: - if (new_type < SVt_PVIV) { - new_type = (new_type == SVt_NV) - ? SVt_PVNV : SVt_PVIV; + if (SvROK(sv)) { + referant = SvRV(sv); + if (new_type < SVt_PVIV) { + new_type = SVt_PVIV; + /* FIXME to check SvROK(sv) ? SVt_PV : and fake up + old_body_details */ + } + } else { + if (new_type < SVt_PVIV) { + new_type = (new_type == SVt_NV) + ? SVt_PVNV : SVt_PVIV; + } } break; case SVt_NV: @@ -1183,8 +1187,6 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type) new_type = SVt_PVNV; } break; - case SVt_RV: - break; case SVt_PV: assert(new_type > SVt_PV); assert(SVt_IV < SVt_PV); @@ -1233,15 +1235,6 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type) SvANY(sv) = new_XNV(); SvNV_set(sv, 0); return; - case SVt_RV: - assert(old_type == SVt_NULL); - SvANY(sv) = (XPVIV*)((char*)&(sv->sv_u.svu_iv) - STRUCT_OFFSET(XPVIV, xiv_iv)); - /* Could leave this in, but changing it happens to make the next step - clearler. The key part is that SvANY(sv) is not NULL: - SvANY(sv) = &sv->sv_u.svu_rv; - */ - SvRV_set(sv, 0); - return; case SVt_PVHV: case SVt_PVAV: assert(new_type_details->body_size); @@ -1290,7 +1283,9 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type) The target created by newSVrv also is, and it can have magic. However, it never has SvPVX set. */ - if (old_type == SVt_RV || old_type >= SVt_PV) { + if (old_type == SVt_IV) { + assert(!SvROK(sv)); + } else if (old_type >= SVt_PV) { assert(SvPVX_const(sv) == 0); } @@ -1361,8 +1356,11 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type) if (new_type == SVt_PVIO) IoPAGE_LEN(sv) = 60; - if (old_type < SVt_RV || old_type == SVt_NV) - SvPV_set(sv, NULL); + if (old_type < SVt_PV) { + /* referant will be NULL unless the old type was SVt_IV emulating + SVt_RV */ + sv->sv_u.svu_rv = referant; + } break; default: Perl_croak(aTHX_ "panic: sv_upgrade to unknown type %lu", @@ -1498,7 +1496,6 @@ Perl_sv_setiv(pTHX_ register SV *sv, IV i) case SVt_NV: sv_upgrade(sv, SVt_IV); break; - case SVt_RV: case SVt_PV: sv_upgrade(sv, SVt_PVIV); break; @@ -1596,7 +1593,6 @@ Perl_sv_setnv(pTHX_ register SV *sv, NV num) case SVt_IV: sv_upgrade(sv, SVt_NV); break; - case SVt_RV: case SVt_PV: case SVt_PVIV: sv_upgrade(sv, SVt_PVNV); @@ -3440,7 +3436,6 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags) sv_upgrade(dstr, SVt_IV); break; case SVt_NV: - case SVt_RV: case SVt_PV: sv_upgrade(dstr, SVt_PVIV); break; @@ -3458,7 +3453,11 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags) assert(!SvTAINTED(sstr)); return; } - goto undef_sstr; + if (!SvROK(sstr)) + goto undef_sstr; + if (dtype < SVt_PV && dtype != SVt_IV) + sv_upgrade(dstr, SVt_IV); + break; case SVt_NV: if (SvNOK(sstr)) { @@ -3467,7 +3466,6 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags) case SVt_IV: sv_upgrade(dstr, SVt_NV); break; - case SVt_RV: case SVt_PV: case SVt_PVIV: sv_upgrade(dstr, SVt_PVNV); @@ -3486,10 +3484,6 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags) } goto undef_sstr; - case SVt_RV: - if (dtype < SVt_PV && dtype != SVt_RV) - sv_upgrade(dstr, SVt_RV); - break; case SVt_PVFM: #ifdef PERL_OLD_COPY_ON_WRITE if ((SvFLAGS(sstr) & CAN_COW_MASK) == CAN_COW_FLAGS) { @@ -5056,13 +5050,9 @@ Perl_sv_replace(pTHX_ register SV *sv, register SV *nsv) #else StructCopy(nsv,sv,SV); #endif - /* Currently could join these into one piece of pointer arithmetic, but - it would be unclear. */ - if(SvTYPE(sv) == SVt_IV) + if(SvTYPE(sv) == SVt_IV) { SvANY(sv) = (XPVIV*)((char*)&(sv->sv_u.svu_iv) - STRUCT_OFFSET(XPVIV, xiv_iv)); - else if (SvTYPE(sv) == SVt_RV) { - SvANY(sv) = &sv->sv_u.svu_rv; } @@ -5124,6 +5114,15 @@ Perl_sv_clear(pTHX_ register SV *sv) /* See the comment in sv.h about the collusion between this early return and the overloading of the NULL and IV slots in the size table. */ + if (SvROK(sv)) { + SV * const target = SvRV(sv); + if (SvWEAKREF(sv)) + sv_del_backref(target, sv); + else + SvREFCNT_dec(target); + } + SvFLAGS(sv) &= SVf_BREAK; + SvFLAGS(sv) |= SVTYPEMASK; return; } @@ -5254,7 +5253,6 @@ Perl_sv_clear(pTHX_ register SV *sv) /* Don't even bother with turning off the OOK flag. */ } case SVt_PV: - case SVt_RV: if (SvROK(sv)) { SV * const target = SvRV(sv); if (SvWEAKREF(sv)) @@ -7302,7 +7300,7 @@ SV * Perl_newRV_noinc(pTHX_ SV *tmpRef) { dVAR; - register SV *sv = newSV_type(SVt_RV); + register SV *sv = newSV_type(SVt_IV); SvTEMP_off(tmpRef); SvRV_set(sv, tmpRef); SvROK_on(sv); @@ -7746,7 +7744,6 @@ Perl_sv_reftype(pTHX_ const SV *sv, int ob) case SVt_NULL: case SVt_IV: case SVt_NV: - case SVt_RV: case SVt_PV: case SVt_PVIV: case SVt_PVNV: @@ -7857,12 +7854,12 @@ Perl_newSVrv(pTHX_ SV *rv, const char *classname) SvFLAGS(rv) = 0; SvREFCNT(rv) = refcnt; - sv_upgrade(rv, SVt_RV); + sv_upgrade(rv, SVt_IV); } else if (SvROK(rv)) { SvREFCNT_dec(SvRV(rv)); - } else if (SvTYPE(rv) < SVt_RV || SvTYPE(rv) == SVt_NV) - sv_upgrade(rv, SVt_RV); - else if (SvTYPE(rv) > SVt_RV) { + } else if (SvTYPE(rv) < SVt_PV && SvTYPE(rv) != SVt_IV) + sv_upgrade(rv, SVt_IV); + else if (SvTYPE(rv) >= SVt_PV) { SvPV_free(rv); SvCUR_set(rv, 0); SvLEN_set(rv, 0); @@ -10023,10 +10020,7 @@ Perl_rvpv_dup(pTHX_ SV *dstr, const SV *sstr, CLONE_PARAMS* param) } else { /* Copy the NULL */ - if (SvTYPE(dstr) == SVt_RV) - SvRV_set(dstr, NULL); - else - SvPV_set(dstr, NULL); + SvPV_set(dstr, NULL); } } @@ -10092,16 +10086,16 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param) break; case SVt_IV: SvANY(dstr) = (XPVIV*)((char*)&(dstr->sv_u.svu_iv) - STRUCT_OFFSET(XPVIV, xiv_iv)); - SvIV_set(dstr, SvIVX(sstr)); + if(SvROK(sstr)) { + Perl_rvpv_dup(aTHX_ dstr, sstr, param); + } else { + SvIV_set(dstr, SvIVX(sstr)); + } break; case SVt_NV: SvANY(dstr) = new_XNV(); SvNV_set(dstr, SvNVX(sstr)); break; - case SVt_RV: - SvANY(dstr) = &(dstr->sv_u.svu_rv); - Perl_rvpv_dup(aTHX_ dstr, sstr, param); - break; /* case SVt_BIND: */ default: { @@ -47,12 +47,13 @@ typedef enum { SVt_NULL, /* 0 */ SVt_BIND, /* 1 */ SVt_IV, /* 2 */ - SVt_RV, /* 3 */ - SVt_NV, /* 4 */ - SVt_PV, /* 5 */ - SVt_PVIV, /* 6 */ - SVt_PVNV, /* 7 */ - SVt_PVMG, /* 8 */ + SVt_NV, /* 3 */ + /* RV was here, before it was merged with IV. */ + SVt_PV, /* 4 */ + SVt_PVIV, /* 5 */ + SVt_PVNV, /* 6 */ + SVt_PVMG, /* 7 */ + SVt_ORANGE, /* 8 */ /* PVBM was here, before BIND replaced it. */ SVt_PVGV, /* 9 */ SVt_PVLV, /* 10 */ @@ -69,6 +70,9 @@ typedef enum { purposes eternal code wanting to consider PVBM probably needs to think of PVMG instead. */ # define SVt_PVBM SVt_PVMG +/* Anything wanting to create a reference from clean should ensure that it has + a scalar of type SVt_IV now: */ +# define SVt_RV SVt_IV #endif /* There is collusion here with sv_clear - sv_clear exits early for SVt_NULL @@ -1298,7 +1302,7 @@ the scalar's value cannot change unless written to. })) # define SvRV(sv) \ (*({ SV *const _svi = (SV *) (sv); \ - assert(SvTYPE(_svi) >= SVt_PV || SvTYPE(_svi) == SVt_RV); \ + assert(SvTYPE(_svi) >= SVt_PV || SvTYPE(_svi) == SVt_IV); \ assert(SvTYPE(_svi) != SVt_PVAV); \ assert(SvTYPE(_svi) != SVt_PVHV); \ assert(SvTYPE(_svi) != SVt_PVCV); \ @@ -1383,7 +1387,7 @@ the scalar's value cannot change unless written to. assert(!isGV_with_GP(sv)); \ (((XPVUV*)SvANY(sv))->xuv_uv = (val)); } STMT_END #define SvRV_set(sv, val) \ - STMT_START { assert(SvTYPE(sv) >= SVt_PV || SvTYPE(sv) == SVt_RV); \ + STMT_START { assert(SvTYPE(sv) >= SVt_PV || SvTYPE(sv) == SVt_IV); \ assert(SvTYPE(sv) != SVt_PVAV); \ assert(SvTYPE(sv) != SVt_PVHV); \ assert(SvTYPE(sv) != SVt_PVCV); \ |