In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/32ed16fc7457f21807774447f05a5db39ea198c7?hp=85897674662b45b047282279484f658e686f40ce>
- Log ----------------------------------------------------------------- commit 32ed16fc7457f21807774447f05a5db39ea198c7 Author: Father Chrysostomos <[email protected]> Date: Sat Jul 28 00:17:04 2012 -0700 perldelta for 1eb0b7be2ff1 (B::Deparse and loopex prec) M pod/perldelta.pod commit 6ed07037b4167d32c05549c565e52beedfac68ad Author: Father Chrysostomos <[email protected]> Date: Sat Jul 28 00:15:58 2012 -0700 perldelta for 1f039d60d3 (last $foo) M pod/perldelta.pod commit be28af6e82fe759aa1fa801fc780175dda52f93d Author: Father Chrysostomos <[email protected]> Date: Sat Jul 28 00:12:59 2012 -0700 perldelta for 2ba1f20ac3a (loopex prec docs) M pod/perldelta.pod commit d7f7c5151b019a3c89be79e2867995275ede0b4c Author: Father Chrysostomos <[email protected]> Date: Sat Jul 28 00:10:53 2012 -0700 perldelta for f6894bc8d44 and e52de15a29 M pod/perldelta.pod commit e9f497c4566162243761bd415c835b44bb10e265 Author: Father Chrysostomos <[email protected]> Date: Sat Jul 28 00:09:11 2012 -0700 perldelta for 42409c4069 (truncate FILENAME) M pod/perldelta.pod commit 3e81bef20efc82dfe52a462a69492310d7ea3459 Author: Father Chrysostomos <[email protected]> Date: Sat Jul 28 00:07:17 2012 -0700 perldelta for 9a0c99494c and 06b58b76f31 M pod/perldelta.pod commit 77f5d5391b62a789859420c91301d6d3d27a122f Author: Father Chrysostomos <[email protected]> Date: Sat Jul 28 00:04:25 2012 -0700 perldelta for c9df4fdaad9 (dump LABEL leak) M pod/perldelta.pod commit deaf58b8802900d0a53e4faca7896971ce9a9dad Author: Father Chrysostomos <[email protected]> Date: Fri Jul 27 23:59:19 2012 -0700 doop.c: Simplify do_transâ un-cow logic Since it calls SvPV_force_nomg a little further on, there is no need for a separate sv_force_normal call to handle COWs. M doop.c commit 1ec4f607b95237e7d3022e1f5df41f1167be4523 Author: Father Chrysostomos <[email protected]> Date: Fri Jul 27 23:51:59 2012 -0700 Fix C++ build broken by 1f039d60d3 The goto was bypassing initialisation. Avoiding goto altogether actu- ally simplifies things. M op.c commit 4499db7385adf05fc8c5f6e28aa920d268b63435 Author: Father Chrysostomos <[email protected]> Date: Fri Jul 27 23:46:07 2012 -0700 Flatten vstrings modified in place 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. M doop.c M embed.fnc M embed.h M mg.c M mg_raw.h M mg_vtable.h M pod/perlguts.pod M pp_hot.c M proto.h M regen/mg_vtable.pl M sv.c M sv.h M t/op/ver.t commit 5bbe7184a7198d6334733fd9eb3ca7db21bf04f2 Author: Father Chrysostomos <[email protected]> Date: Fri Jul 27 18:05:02 2012 -0700 pp.c:pp_trans: avoid redundant sv in transr I think I added the if (OP_TRANSR) block to the wrong spot, because the mortal scalar created just before it is only used for y/// without /r. M pp.c ----------------------------------------------------------------------- Summary of changes: doop.c | 6 ++---- embed.fnc | 1 - embed.h | 1 - mg.c | 13 ------------- mg_raw.h | 2 +- mg_vtable.h | 8 ++------ op.c | 16 +++++++--------- pod/perldelta.pod | 39 +++++++++++++++++++++++++++++++++++++-- pod/perlguts.pod | 2 +- pp.c | 6 ++++-- pp_hot.c | 2 +- proto.h | 6 ------ regen/mg_vtable.pl | 3 +-- sv.c | 19 +++++++++---------- sv.h | 2 +- t/op/ver.t | 7 ++++++- 16 files changed, 72 insertions(+), 61 deletions(-) diff --git a/doop.c b/doop.c index 1593d19..9d75b3d 100644 --- a/doop.c +++ b/doop.c @@ -632,16 +632,14 @@ Perl_do_trans(pTHX_ SV *sv) PERL_ARGS_ASSERT_DO_TRANS; if (SvREADONLY(sv) && !(PL_op->op_private & OPpTRANS_IDENTICAL)) { - if (SvIsCOW(sv)) - sv_force_normal_flags(sv, 0); - if (SvREADONLY(sv)) + if (!SvIsCOW(sv)) Perl_croak_no_modify(aTHX); } (void)SvPV_const(sv, len); 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 dd4daef..b3f757c 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 5e9f6eb..50d2344 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 f4979f1..3b4ed1c 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 76cf42f..f577087 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 3c73c2b..2490394 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/op.c b/op.c index d24ea4d..41bea3b 100644 --- a/op.c +++ b/op.c @@ -6377,7 +6377,7 @@ OP* Perl_newLOOPEX(pTHX_ I32 type, OP *label) { dVAR; - OP *o; + OP *o = NULL; PERL_ARGS_ASSERT_NEWLOOPEX; @@ -6387,7 +6387,6 @@ Perl_newLOOPEX(pTHX_ I32 type, OP *label) /* "last()" means "last" */ if (label->op_type == OP_STUB && (label->op_flags & OPf_PARENS)) { o = newOP(type, OPf_SPECIAL); - goto free_label; } } else { @@ -6407,18 +6406,17 @@ Perl_newLOOPEX(pTHX_ I32 type, OP *label) SvUTF8(((SVOP*)label)->op_sv), savesharedpv( SvPV_nolen_const(((SVOP*)label)->op_sv))); - free_label: + } + } + + /* If we have already created an op, we do not need the label. */ + if (o) #ifdef PERL_MAD op_getmad(label,o,'L'); #else op_free(label); #endif - label = NULL; - } - } - - /* If we still have a label op, we need to create a stacked unop. */ - if (label) o = newUNOP(type, OPf_STACKED, label); + else o = newUNOP(type, OPf_STACKED, label); PL_hints |= HINT_BLOCK_SCOPE; return o; diff --git a/pod/perldelta.pod b/pod/perldelta.pod index eb4bc06..b0637d1 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -28,6 +28,13 @@ here, but most should go in the L</Performance Enhancements> section. [ List each enhancement as a =head2 entry ] +=head2 Computed Labels + +The loop controls C<next>, C<last> and C<redo>, and the special C<dump> +operator, now allow arbitrary expressions to be used to compute labels at +run time. Previously, any argument that was not a constant was treated as +the empty string. + =head1 Security XXX Any security-related notices go here. In particular, any security @@ -110,6 +117,11 @@ C<GVf_*> and more SV-related flag values are now provided as constants in the C<B::> namespace and available for export. The default export list has not changed. +=item * + +L<B::Deparse> has been upgraded from version 1.15 to 1.16. It now deparses +loop controls with the correct precedence. + =back =head2 Removed Modules and Pragmata @@ -141,13 +153,15 @@ XXX Changes which significantly change existing files in F<pod/> go here. However, any changes to F<pod/perldiag.pod> should go in the L</Diagnostics> section. -=head3 L<XXX> +=head3 L<perlfunc>, L<perlop> =over 4 =item * -XXX Description of the change here +Loop control verbs (C<dump>, C<goto>, C<next>, C<last> and C<redo>) have +always had the same precedence as assignment operators, but this was never +documented until now. =back @@ -348,6 +362,27 @@ C<\w> now matches the code points U+200C (ZERO WIDTH NON-JOINER) and U+200D (ZERO WIDTH JOINER). C<\W> no longer matches these. This change is because Unicode corrected their definition of what C<\w> should match. +=item * + +C<dump LABEL> no longer leaks its label. + +=item * + +Constant folding no longer changes the behaviour of functions like C<stat> +and C<truncate> that can take either filenames or handles. +C<stat 1 ? foo : bar> nows treats its argument as a file name (since it is +an arbitrary expression), rather than the handle "foo". + +=item * + +C<truncate FOO, $len> no longer falls back to treating "FOO" as a file name +if the filehandle has been deleted. This was broken in Perl 5.16.0. + +=item * + +Subroutine redefinitions after sub-to-glob and glob-to-glob assignments no +longer cause double frees or panic messages. + =back =head1 Known Problems diff --git a/pod/perlguts.pod b/pod/perlguts.pod index 8f3ed0c..33bf007 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.c b/pp.c index 0def4ac..a57f609 100644 --- a/pp.c +++ b/pp.c @@ -676,7 +676,6 @@ PP(pp_trans) sv = DEFSV; EXTEND(SP,1); } - TARG = sv_newmortal(); if(PL_op->op_type == OP_TRANSR) { STRLEN len; const char * const pv = SvPV(sv,len); @@ -684,7 +683,10 @@ PP(pp_trans) do_trans(newsv); PUSHs(newsv); } - else PUSHi(do_trans(sv)); + else { + TARG = sv_newmortal(); + PUSHi(do_trans(sv)); + } RETURN; } diff --git a/pp_hot.c b/pp_hot.c index e04d5ca..72a812e 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 1930ff3..3447f6c 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 f96c7a0..5fcdc4c 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 7022ce1..b5950d6 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 291ef3d..4c58ee4 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 fa94d5e..5fca626 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 -- Perl5 Master Repository
