In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/216d99a62babbdb59330c3c4cc503329fb65e88b?hp=f28d8eb1c114895944de593e05ba8271fe1b4fdf>
- Log ----------------------------------------------------------------- commit 216d99a62babbdb59330c3c4cc503329fb65e88b Author: Father Chrysostomos <[email protected]> Date: Fri Aug 17 16:44:57 2012 -0700 perldelta entries M pod/perldelta.pod commit 4a7239ff0b409a13fa6982413ce503f8e5fa07c3 Author: Father Chrysostomos <[email protected]> Date: Fri Aug 17 14:45:29 2012 -0700 [perl #114040] Allow pod in quoted constructs When the case = in toke.c:yylex is reached and PL_lex_state is not LEX_NORMAL, that means we are in some sort of quoted construct, and the entire constructâs content is in the current line buffer (which, consequently contains more than one line). So we need to check that when encountering pod. Quoted constructs need to be treated the same way as string eval, which also puts all the code in the line buffer. M t/comp/parser.t M toke.c commit 7c93c29bad5a630df394ef899b8f995cc29154c8 Author: Father Chrysostomos <[email protected]> Date: Fri Aug 17 14:24:05 2012 -0700 Donât leak formats defined inside subs I made them leak inadvertently in 5.17.2 with commit e09ac076a1da. This was unfortunately backported to 5.16.1 (as 3149499832) without anybody noticing the bug. M pad.c M t/op/write.t commit 84eea98055f218b655619db1600f75f511c33e3d Author: Father Chrysostomos <[email protected]> Date: Fri Aug 17 13:39:27 2012 -0700 pad.c: Document pad_add_anonâs refcounting M pad.c commit fe79b1b662bc3e34b73e5b207dbf472afbc1b3ac Author: Father Chrysostomos <[email protected]> Date: Fri Aug 17 13:28:46 2012 -0700 perldelta: Clarify note about B::PADLIST M pod/perldelta.pod commit ee62b5872fcaa0eebd452a940ede4d506653bd81 Author: Father Chrysostomos <[email protected]> Date: Thu Aug 16 23:44:11 2012 -0700 pp_ctl.c:pp_dbstate: Donât adjust CvDEPTH for XSUBs Commit c127bd3aaa5c5 made XS DB::DB subs work. Before that, pp_dbstate assumed DB::DB was written it perl. It adjusts CvDEPTH when calling the XSUB, which serves no purpose. It was presumably just copied from the pure-Perl-calling code. pp_entersub does- nât do this. M pp_ctl.c ----------------------------------------------------------------------- Summary of changes: pad.c | 4 +++- pod/perldelta.pod | 11 ++++++++++- pp_ctl.c | 2 -- t/comp/parser.t | 21 ++++++++++++++++++++- t/op/write.t | 14 +++++++++++++- toke.c | 3 ++- 6 files changed, 48 insertions(+), 7 deletions(-) diff --git a/pad.c b/pad.c index 6dee52e..d248921 100644 --- a/pad.c +++ b/pad.c @@ -784,6 +784,8 @@ currently-compiling function. The function I<func> is linked into the pad, and its C<CvOUTSIDE> link to the outer scope is weakened to avoid a reference loop. +One reference count is stolen, so you may need to do C<SvREFCNT_inc(func)>. + I<optype> should be an opcode indicating the type of operation that the pad entry is to support. This doesn't affect operational semantics, but is used for debugging. @@ -812,7 +814,7 @@ Perl_pad_add_anon(pTHX_ CV* func, I32 optype) if (SvTYPE(func) == SVt_PVCV || !CvOUTSIDE(func)) av_store(PL_comppad, ix, (SV*)func); else { - SV *rv = newRV_inc((SV *)func); + SV *rv = newRV_noinc((SV *)func); sv_rvweaken(rv); assert (SvTYPE(func) == SVt_PVFM); av_store(PL_comppad, ix, rv); diff --git a/pod/perldelta.pod b/pod/perldelta.pod index ec532ed..f20edd5 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -132,7 +132,7 @@ a sub and a format share the same name, it will dump both. =item * L<B::Debug> has been upgraded from version 1.17 to 1.18. This adds support -(experimentally) for the new C<B::PADLIST>. +(experimentally) for C<B::PADLIST>, which will be added in Perl 5.17.4. =item * @@ -681,6 +681,15 @@ the pattern hasn't changed (i.e. C</$unchanging/>). This has now been fixed. A bug in the compilation of a C</(?{})/> expression which affected the TryCatch test suite has been fixed [perl #114242]. +=item * + +Formats no longer leak. They started leaking in 5.17.2. + +=item * + +Pod can now be nested in code inside a quoted construct outside of a string +eval. This used to work only within string evals [perl #114040]. + =back =head1 Known Problems diff --git a/pp_ctl.c b/pp_ctl.c index 55d9c89..b9b26e5 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -1973,10 +1973,8 @@ PP(pp_dbstate) SPAGAIN; if (CvISXSUB(cv)) { - CvDEPTH(cv)++; PUSHMARK(SP); (void)(*CvXSUB(cv))(aTHX_ cv); - CvDEPTH(cv)--; FREETMPS; LEAVE; return NORMAL; diff --git a/t/comp/parser.t b/t/comp/parser.t index d22e9b3..09f2d1c 100644 --- a/t/comp/parser.t +++ b/t/comp/parser.t @@ -3,7 +3,7 @@ # Checks if the parser behaves correctly in edge cases # (including weird syntax errors) -print "1..139\n"; +print "1..140\n"; sub failed { my ($got, $expected, $name) = @_; @@ -397,6 +397,25 @@ $_ write }).*/; +eval ' +"${; + +=pod + +=cut + +}"; +'; +is $@, "", 'pod inside string in string eval'; +"${; + +=pod + +=cut + +}"; +print "ok ", ++$test, " - pod inside string outside of string eval\n"; + sub 'Hello'_he_said (_); is prototype "Hello::_he_said", '_', 'initial tick in sub declaration'; diff --git a/t/op/write.t b/t/op/write.t index 5706e49..3fafc20 100644 --- a/t/op/write.t +++ b/t/op/write.t @@ -61,7 +61,7 @@ for my $tref ( @NumTests ){ my $bas_tests = 21; # number of tests in section 3 -my $bug_tests = 8 + 3 * 3 * 5 * 2 * 3 + 2 + 66 + 4 + 2 + 3 + 96 + 10; +my $bug_tests = 8 + 3 * 3 * 5 * 2 * 3 + 2 + 66 + 4 + 2 + 3 + 96 + 11; # number of tests in section 4 my $hmb_tests = 35; @@ -1102,6 +1102,18 @@ write STRICT; close STRICT or die "Could not close: $!"; is cat('Op_write.tmp'), "oof:\n", 'pragmata on format line'; +SKIP: { + skip "no weak refs" unless eval { require Scalar::Util }; + sub Potshriggley { +format Potshriggley = +. + } + Scalar::Util::weaken(my $x = *Potshriggley{FORMAT}); + undef *Potshriggley; + is $x, undef, 'formats in subs do not leak'; + use Devel::Peek; Dump $x if $x; +} + ############################# ## Section 4 diff --git a/toke.c b/toke.c index aecd7f1..d0c9087 100644 --- a/toke.c +++ b/toke.c @@ -6001,7 +6001,8 @@ Perl_yylex(pTHX) if (PL_expect == XSTATE && isALPHA(tmp) && (s == PL_linestart+1 || s[-2] == '\n') ) { - if (PL_in_eval && !PL_rsfp && !PL_parser->filtered) { + if ((PL_in_eval && !PL_rsfp && !PL_parser->filtered) + || PL_lex_state != LEX_NORMAL) { d = PL_bufend; while (s < d) { if (*s++ == '\n') { -- Perl5 Master Repository
