diff options
-rw-r--r-- | doop.c | 2 | ||||
-rw-r--r-- | embed.fnc | 1 | ||||
-rw-r--r-- | embed.h | 1 | ||||
-rw-r--r-- | mg.c | 13 | ||||
-rw-r--r-- | mg_raw.h | 2 | ||||
-rw-r--r-- | mg_vtable.h | 8 | ||||
-rw-r--r-- | pod/perlguts.pod | 2 | ||||
-rw-r--r-- | pp_hot.c | 2 | ||||
-rw-r--r-- | proto.h | 6 | ||||
-rw-r--r-- | regen/mg_vtable.pl | 3 | ||||
-rw-r--r-- | sv.c | 19 | ||||
-rw-r--r-- | sv.h | 2 | ||||
-rw-r--r-- | t/op/ver.t | 7 |
13 files changed, 23 insertions, 45 deletions
@@ -641,7 +641,7 @@ Perl_do_trans(pTHX_ SV *sv) if (!len) return 0; if (!(PL_op->op_private & OPpTRANS_IDENTICAL)) { - if (!SvPOKp(sv)) + if (!SvPOKp(sv) || SvTHINKFIRST(sv)) (void)SvPV_force_nomg(sv, len); (void)SvPOK_only_UTF8(sv); } @@ -775,7 +775,6 @@ p |int |magic_settaint |NN SV* sv|NN MAGIC* mg p |int |magic_setuvar |NN SV* sv|NN MAGIC* mg p |int |magic_setvec |NN SV* sv|NN MAGIC* mg p |int |magic_setutf8 |NN SV* sv|NN MAGIC* mg -p |int |magic_setvstring|NN SV* sv|NN MAGIC* mg p |int |magic_set_all_env|NN SV* sv|NN MAGIC* mg p |U32 |magic_sizepack |NN SV* sv|NN MAGIC* mg p |int |magic_wipepack |NN SV* sv|NN MAGIC* mg @@ -1152,7 +1152,6 @@ #define magic_setutf8(a,b) Perl_magic_setutf8(aTHX_ a,b) #define magic_setuvar(a,b) Perl_magic_setuvar(aTHX_ a,b) #define magic_setvec(a,b) Perl_magic_setvec(aTHX_ a,b) -#define magic_setvstring(a,b) Perl_magic_setvstring(aTHX_ a,b) #define magic_sizepack(a,b) Perl_magic_sizepack(aTHX_ a,b) #define magic_wipepack(a,b) Perl_magic_wipepack(aTHX_ a,b) #define mg_localize(a,b,c) Perl_mg_localize(aTHX_ a,b,c) @@ -2326,19 +2326,6 @@ Perl_magic_setvec(pTHX_ SV *sv, MAGIC *mg) } int -Perl_magic_setvstring(pTHX_ SV *sv, MAGIC *mg) -{ - PERL_ARGS_ASSERT_MAGIC_SETVSTRING; - - if (SvPOKp(sv)) { - SV * const vecsv = sv_newmortal(); - scan_vstring(mg->mg_ptr, mg->mg_ptr + mg->mg_len, vecsv); - if (sv_eq_flags(vecsv, sv, 0 /*nomg*/)) return 0; - } - return sv_unmagic(sv, mg->mg_type); -} - -int Perl_magic_getdefelem(pTHX_ SV *sv, MAGIC *mg) { dVAR; @@ -68,7 +68,7 @@ "/* taint 't' Taintedness */" }, { 'U', "want_vtbl_uvar", "/* uvar 'U' Available for use by extensions */" }, - { 'V', "want_vtbl_vstring | PERL_MAGIC_VALUE_MAGIC", + { 'V', "magic_vtable_max | PERL_MAGIC_VALUE_MAGIC", "/* vstring 'V' SV was vstring literal */" }, { 'v', "want_vtbl_vec | PERL_MAGIC_VALUE_MAGIC", "/* vec 'v' vec() lvalue */" }, diff --git a/mg_vtable.h b/mg_vtable.h index 3c73c2beff..2490394895 100644 --- a/mg_vtable.h +++ b/mg_vtable.h @@ -86,7 +86,6 @@ enum { /* pass one of these to get_vtbl */ want_vtbl_utf8, want_vtbl_uvar, want_vtbl_vec, - want_vtbl_vstring, magic_vtable_max }; @@ -120,8 +119,7 @@ EXTCONST char *PL_magic_vtable_names[magic_vtable_max] = { "taint", "utf8", "uvar", - "vec", - "vstring" + "vec" }; #else EXTCONST char *PL_magic_vtable_names[magic_vtable_max]; @@ -182,8 +180,7 @@ EXT_MGVTBL PL_magic_vtables[magic_vtable_max] = { { Perl_magic_gettaint, Perl_magic_settaint, 0, 0, 0, 0, 0, 0 }, { 0, Perl_magic_setutf8, 0, 0, 0, 0, 0, 0 }, { Perl_magic_getuvar, Perl_magic_setuvar, 0, 0, 0, 0, 0, 0 }, - { Perl_magic_getvec, Perl_magic_setvec, 0, 0, 0, 0, 0, 0 }, - { 0, Perl_magic_setvstring, 0, 0, 0, 0, 0, 0 } + { Perl_magic_getvec, Perl_magic_setvec, 0, 0, 0, 0, 0, 0 } }; #else EXT_MGVTBL PL_magic_vtables[magic_vtable_max]; @@ -223,6 +220,5 @@ EXT_MGVTBL PL_magic_vtables[magic_vtable_max]; #define PL_vtbl_utf8 PL_magic_vtables[want_vtbl_utf8] #define PL_vtbl_uvar PL_magic_vtables[want_vtbl_uvar] #define PL_vtbl_vec PL_magic_vtables[want_vtbl_vec] -#define PL_vtbl_vstring PL_magic_vtables[want_vtbl_vstring] /* ex: set ro: */ diff --git a/pod/perlguts.pod b/pod/perlguts.pod index 8f3ed0c1de..33bf00733c 100644 --- a/pod/perlguts.pod +++ b/pod/perlguts.pod @@ -1103,7 +1103,7 @@ will be lost. extensions u PERL_MAGIC_uvar_elem (none) Reserved for use by extensions - V PERL_MAGIC_vstring vtbl_vstring SV was vstring literal + V PERL_MAGIC_vstring (none) SV was vstring literal v PERL_MAGIC_vec vtbl_vec vec() lvalue w PERL_MAGIC_utf8 vtbl_utf8 Cached UTF-8 information x PERL_MAGIC_substr vtbl_substr substr() lvalue @@ -2116,7 +2116,7 @@ PP(pp_subst) setup_match: s = SvPV_mutable(TARG, len); - if (!SvPOKp(TARG) || SvTYPE(TARG) == SVt_PVGV) + if (!SvPOKp(TARG) || SvTYPE(TARG) == SVt_PVGV || SvVOK(TARG)) force_on_match = 1; /* only replace once? */ @@ -2345,12 +2345,6 @@ PERL_CALLCONV int Perl_magic_setvec(pTHX_ SV* sv, MAGIC* mg) #define PERL_ARGS_ASSERT_MAGIC_SETVEC \ assert(sv); assert(mg) -PERL_CALLCONV int Perl_magic_setvstring(pTHX_ SV* sv, MAGIC* mg) - __attribute__nonnull__(pTHX_1) - __attribute__nonnull__(pTHX_2); -#define PERL_ARGS_ASSERT_MAGIC_SETVSTRING \ - assert(sv); assert(mg) - PERL_CALLCONV U32 Perl_magic_sizepack(pTHX_ SV* sv, MAGIC* mg) __attribute__nonnull__(pTHX_1) __attribute__nonnull__(pTHX_2); diff --git a/regen/mg_vtable.pl b/regen/mg_vtable.pl index f96c7a0fa5..5fcdc4c78f 100644 --- a/regen/mg_vtable.pl +++ b/regen/mg_vtable.pl @@ -84,7 +84,7 @@ my %mg = unknown_to_sv_magic => 1 }, vec => { char => 'v', vtable => 'vec', value_magic => 1, desc => 'vec() lvalue' }, - vstring => { char => 'V', value_magic => 1, vtable => 'vstring', + vstring => { char => 'V', value_magic => 1, desc => 'SV was vstring literal' }, utf8 => { char => 'w', vtable => 'utf8', value_magic => 1, desc => 'Cached UTF-8 information' }, @@ -142,7 +142,6 @@ my %sig = cond => '#ifdef USE_LOCALE_COLLATE'}, 'hintselem' => {set => 'sethint', clear => 'clearhint'}, 'hints' => {clear => 'clearhints'}, - 'vstring' => {set => 'setvstring'}, 'checkcall' => {copy => 'copycallchecker'}, ); @@ -3035,7 +3035,8 @@ Perl_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *const lp) { PERL_ARGS_ASSERT_SV_2PVBYTE; - if ((SvTHINKFIRST(sv) && !SvIsCOW(sv)) || isGV_with_GP(sv)) { + if (((SvREADONLY(sv) || SvFAKE(sv)) && !SvIsCOW(sv)) + || isGV_with_GP(sv) || SvROK(sv)) { SV *sv2 = sv_newmortal(); sv_copypv(sv2,sv); sv = sv2; @@ -3061,7 +3062,8 @@ Perl_sv_2pvutf8(pTHX_ register SV *sv, STRLEN *const lp) { PERL_ARGS_ASSERT_SV_2PVUTF8; - if ((SvTHINKFIRST(sv) && !SvIsCOW(sv)) || isGV_with_GP(sv)) + if (((SvREADONLY(sv) || SvFAKE(sv)) && !SvIsCOW(sv)) + || isGV_with_GP(sv) || SvROK(sv)) sv = sv_mortalcopy(sv); else SvGETMAGIC(sv); @@ -3937,12 +3939,6 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags) stype = SvTYPE(sstr); dtype = SvTYPE(dstr); - if ( SvVOK(dstr) ) - { - /* need to nuke the magic */ - sv_unmagic(dstr, PERL_MAGIC_vstring); - } - /* There's a lot of redundancy below but we're going for speed here */ switch (stype) { @@ -4719,10 +4715,12 @@ S_sv_release_COW(pTHX_ register SV *sv, const char *pvx, SV *after) /* =for apidoc sv_force_normal_flags -Undo various types of fakery on an SV: if the PV is a shared string, make +Undo various types of fakery on an SV, where fakery means +"more than" a string: if the PV is a shared string, make a private copy; if we're a ref, stop refing; if we're a glob, downgrade to an xpvmg; if we're a copy-on-write scalar, this is the on-write time when -we do the copy, and is also used locally. If C<SV_COW_DROP_PV> is set +we do the copy, and is also used locally; if this is a +vstring, drop the vstring magic. If C<SV_COW_DROP_PV> is set then a copy-on-write scalar drops its PV buffer (if any) and becomes SvPOK_off rather than making a copy. (Used where this scalar is about to be set to some other value.) In addition, @@ -4849,6 +4847,7 @@ Perl_sv_force_normal_flags(pTHX_ register SV *const sv, const U32 flags) SvREFCNT_dec(temp); } + else if (SvVOK(sv)) sv_unmagic(sv, PERL_MAGIC_vstring); } /* @@ -348,7 +348,7 @@ perform the upgrade if necessary. See C<svtype>. -#define SVf_THINKFIRST (SVf_READONLY|SVf_ROK|SVf_FAKE) +#define SVf_THINKFIRST (SVf_READONLY|SVf_ROK|SVf_FAKE|SVs_RMG) #define SVf_OK (SVf_IOK|SVf_NOK|SVf_POK|SVf_ROK| \ SVp_IOK|SVp_NOK|SVp_POK|SVpgv_GP) diff --git a/t/op/ver.t b/t/op/ver.t index fa94d5ed78..5fca6267a5 100644 --- a/t/op/ver.t +++ b/t/op/ver.t @@ -11,7 +11,7 @@ $DOWARN = 1; # enable run-time warnings now use Config; -plan( tests => 55 ); +plan( tests => 57 ); eval 'use v5.5.640'; is( $@, '', "use v5.5.640; $@"); @@ -270,6 +270,11 @@ ok( exists $h{chr(65).chr(66).chr(67)}, "v-stringness is engaged for X.Y.Z" ); is $|, 1, 'clobbering vstrings does not clobber all magic'; } +$a = v102; $a =~ s/f/f/; +is ref \$a, 'SCALAR', + 's/// flattens vstrings even when the subst results in the same value'; +$a = v102; $a =~ y/f/g/; +is ref \$a, 'SCALAR', 'y/// flattens vstrings'; # The following tests whether v-strings are correctly # interpreted by the tokeniser when it's in a XTERMORDORDOR |