In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/c2cb6f778e2defab008b04bfbd775d54b4bcb5b4?hp=f0bb87ff23759a68400cea2b5cca249af1f69725>
- Log ----------------------------------------------------------------- commit c2cb6f778e2defab008b04bfbd775d54b4bcb5b4 Author: Father Chrysostomos <[email protected]> Date: Mon Sep 24 08:46:56 2012 -0700 Donât crash with existent but undefined &DB::DB This is a follow-up to 432d4561c48, which fixed *DB::DB without &DB::DB, but not &DB::DB without body. M pp_ctl.c M t/run/switchd.t commit 1802449202fea1afd3584bbd6203d82b0dd52ac1 Author: Father Chrysostomos <[email protected]> Date: Sun Sep 23 23:56:40 2012 -0700 A better fix for leaking array assignment Instead of filling up the mortals stack with as many SVs as there are elements, just call get-magic before creating the new SV. (This is not so easy for hashes, as we have keys as well, and hv_common always calls get-magic on keys.) See commits 9c744f4f4d7 and 39984de3a8, which fixed leaking bugs, but inefficiently. M pp_hot.c ----------------------------------------------------------------------- Summary of changes: pp_ctl.c | 2 +- pp_hot.c | 8 +++++--- t/run/switchd.t | 13 +++++++++++-- 3 files changed, 17 insertions(+), 6 deletions(-) diff --git a/pp_ctl.c b/pp_ctl.c index b26e557..3faa9b0 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -1969,7 +1969,7 @@ PP(pp_dbstate) if (gv && isGV_with_GP(gv)) cv = GvCV(gv); - if (!cv) + if (!cv || (!CvROOT(cv) && !CvXSUB(cv))) DIE(aTHX_ "No DB::DB routine defined"); if (CvDEPTH(cv) >= 1 && !(PL_debug & DEBUG_DB_RECURSE_FLAG)) diff --git a/pp_hot.c b/pp_hot.c index a8d762b..302f47e 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -982,12 +982,14 @@ PP(pp_aassign) while (relem <= lastrelem) { /* gobble up all the rest */ SV **didstore; assert(*relem); - sv = sv_newmortal(); - sv_setsv(sv, *relem); + SvGETMAGIC(*relem); /* before newSV, in case it dies */ + sv = newSV(0); + sv_setsv_nomg(sv, *relem); *(relem++) = sv; didstore = av_store(ary,i++,sv); - if (didstore) SvREFCNT_inc_simple_void_NN(sv); if (magic) { + if (!didstore) + sv_2mortal(sv); if (SvSMAGICAL(sv)) mg_set(sv); } diff --git a/t/run/switchd.t b/t/run/switchd.t index 1dffb2d..9194062 100644 --- a/t/run/switchd.t +++ b/t/run/switchd.t @@ -9,7 +9,7 @@ BEGIN { require "./test.pl"; } # This test depends on t/lib/Devel/switchd*.pm. -plan(tests => 8); +plan(tests => 9); my $r; @@ -119,5 +119,14 @@ like( stderr => 1, ), qr/^No DB::DB routine defined/, - "No crash when DB::DB isn't actually defined", + "No crash when *DB::DB exists but not &DB::DB", +); +like( + runperl( + switches => [ '-Ilib' ], + prog => 'sub DB::DB; BEGIN { $^P = 0x22; } for(0..9){ warn }', + stderr => 1, + ), + qr/^No DB::DB routine defined/, + "No crash when &DB::DB exists but isn't actually defined", ); -- Perl5 Master Repository
