A substitution forces its target to a string upon successful substitu-
tion, even if the substitution did nothing:
$ ./perl -Ilib -le '$a = *f; $a =~ s/f/f/; print ref \$a'
SCALAR
Notice that $a is no longer a glob after s///.
But vstrings are different:
$ ./perl -Ilib -le '$a = v102; $a =~ s/f/f/; print ref \$a'
VSTRING
I fixed this in 5.16 (
1e6bda93) for those cases where the vstring ends
up with a value that doesn’t correspond to the actual string:
$ ./perl -Ilib -le '$a = v102; $a =~ s/f/o/; print ref \$a'
SCALAR
It works through vstring set-magic, that does the check and removes
the magic if it doesn’t match.
I did it that way because I couldn’t think of any other way to fix
bug #29070, and I didn’t realise at the time that I hadn’t fixed
all the bugs.
By making SvTHINKFIRST true on a vstring, we force it through
sv_force_normal before any in-place string operations. We can also
make sv_force_normal handle vstrings as well. This fixes all the lin-
gering-vstring-magic bugs in just two lines, making the vstring set-
magic (which is also slow) redundant. It also allows the special case
in sv_setsv_flags to be removed.
Or at least that was what I had hoped.
It turns out that pp_subst, twists and turns in tortuous ways, and
needs special treatment for things like this.
And do_trans functions wasn’t checking SvTHINKFIRST when arguably it
should have.
I tweaked sv_2pv{utf8,byte} to avoid copying magic variables that do
not need copying.
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);
}
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
#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)
}
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;
"/* 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 */" },
want_vtbl_utf8,
want_vtbl_uvar,
want_vtbl_vec,
- want_vtbl_vstring,
magic_vtable_max
};
"taint",
"utf8",
"uvar",
- "vec",
- "vstring"
+ "vec"
};
#else
EXTCONST char *PL_magic_vtable_names[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];
#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: */
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
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? */
#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);
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' },
cond => '#ifdef USE_LOCALE_COLLATE'},
'hintselem' => {set => 'sethint', clear => 'clearhint'},
'hints' => {clear => 'clearhints'},
- 'vstring' => {set => 'setvstring'},
'checkcall' => {copy => 'copycallchecker'},
);
{
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;
{
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);
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) {
/*
=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,
SvREFCNT_dec(temp);
}
+ else if (SvVOK(sv)) sv_unmagic(sv, PERL_MAGIC_vstring);
}
/*
-#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)
use Config;
-plan( tests => 55 );
+plan( tests => 57 );
eval 'use v5.5.640';
is( $@, '', "use v5.5.640; $@");
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
https://perl5.git.perl.org / perl5.git / commitdiff