summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--doop.c2
-rw-r--r--embed.fnc1
-rw-r--r--embed.h1
-rw-r--r--mg.c13
-rw-r--r--mg_raw.h2
-rw-r--r--mg_vtable.h8
-rw-r--r--pod/perlguts.pod2
-rw-r--r--pp_hot.c2
-rw-r--r--proto.h6
-rw-r--r--regen/mg_vtable.pl3
-rw-r--r--sv.c19
-rw-r--r--sv.h2
-rw-r--r--t/op/ver.t7
13 files changed, 23 insertions, 45 deletions
diff --git a/doop.c b/doop.c
index 1593d1942b..bfcdef577e 100644
--- a/doop.c
+++ b/doop.c
@@ -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);
}
diff --git a/embed.fnc b/embed.fnc
index dd4daefe61..b3f757c1bf 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -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
diff --git a/embed.h b/embed.h
index 5e9f6eb31f..50d2344bed 100644
--- a/embed.h
+++ b/embed.h
@@ -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)
diff --git a/mg.c b/mg.c
index f4979f14e2..3b4ed1c052 100644
--- a/mg.c
+++ b/mg.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;
diff --git a/mg_raw.h b/mg_raw.h
index 76cf42f13d..f577087434 100644
--- a/mg_raw.h
+++ b/mg_raw.h
@@ -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
diff --git a/pp_hot.c b/pp_hot.c
index e04d5ca7ed..72a812ea0b 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -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? */
diff --git a/proto.h b/proto.h
index 1930ff3219..3447f6c0ed 100644
--- a/proto.h
+++ b/proto.h
@@ -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'},
);
diff --git a/sv.c b/sv.c
index 7022ce1590..b5950d65f0 100644
--- a/sv.c
+++ b/sv.c
@@ -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);
}
/*
diff --git a/sv.h b/sv.h
index 291ef3db03..4c58ee4354 100644
--- a/sv.h
+++ b/sv.h
@@ -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