From: Father Chrysostomos Date: Sun, 9 Dec 2012 14:15:20 +0000 (-0800) Subject: Fix problems with -Dr during global destruction X-Git-Tag: upstream/5.20.0~4521 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=49bb71aec3ca9a185f018c6b8f85bad3580522af;p=platform%2Fupstream%2Fperl.git Fix problems with -Dr during global destruction $ cat foo my $x = '(?{1})'; BEGIN { $^H |= 0x00200000 } # lightweight "use re 'eval'" "a" =~ /a$_/ for $x; If I run this under PERL_DESTRUCT_LEVEL=2 with the -Dr flag on a non- threaded build, the output ends with this: during global destruction. during global destruction. during global destruction. during global destruction. during global destruction. Attempt to free temp prematurely: SV 0x822610 during global destruction. Attempt to free temp prematurely: SV 0x802340 during global destruction. Attempt to free temp prematurely: SV 0x8222d0 during global destruction. Attempt to free temp prematurely: SV 0x822490 during global destruction. Attempt to free temp prematurely: SV 0x8224f0 during global destruction. Scalars leaked: 5 And sometimes I even get assertion failures. (I suspect hash random- isation gives me the inconsistent results.) t/re/recompile.t happened to trigger this bug, producing noisy output. Since the assertion failures were in sub-processes, the tests passed anyway. In this commit I have changed the test to check the status of the sub-processes, too, before reporting a pass. This bug appears to have started happening in v5.17.0-424-gd24ca0c, but I don’t know why. I suspect it was a latent bug waiting to happen. During global destruction, all objects are freed, the main stash is freed, and then various SVs in interpreter variables are also freed. Finally, if PERL_DESTRUCT_LEVEL is set, there is one last sweep of all remaining SVs. It is during that sweep that this bug occurs. When the -Dr flag is present, freeing a regular expression causes the ${^RE_DEBUG_FLAGS} flags variable to be looked up. Symbol lookup can trigger the ‘Global symbol requires package name’ error (which becomes a warning here, due to the way pp_ctl.c:qerror works). The code that produces that error assumes that if there is no stash then the preceding code has detected an attempted stricture violation. The preceding code actually tries to provide PL_defstash (aka %main::) as the stash to look in, since this is a punctuation variable. But PL_defstash has been set to null. The logic that no stash equals a stricture violation is there- fore faulty. The attempt to output that error message uses a temporary scalar which is placed on the mortals stack. Freeing of the items on the mortals stack happens before this SV sweep, and not during or afterwards, so the SV sweep ends up trying to free those mortals itself. There is a check in sv_free2, enabled under debugging builds, to see whether the SV is on the mortals stacking. If it is, a warning is emitted and the SV is not freed. My initial attempt at fixing this was to try to avoid putting a mortal on the stack in this case. The code in question doesn’t actually need to use the mortals stack, since Perl_mess isn’t going to croak, so it can free the SV itself. That takes care of the ‘Attempt to free temp prematurely’ warnings and the final ‘Scalars leaked’. It doesn’t solve the ‘during global destruction’ message, but I decided to leave it in place anyway, since creating an SV and freeing it is a little more efficient that creating it, pushing it on to the mortals stack, and having FREETMPS free it later. That ‘during global destruction’ message is supposed to say ‘Global symbol...’, but diagnostic messages during global destruction use the same SV, so it’s not suprising that it gets stomped on before it makes its way to qerror. I’m not sure where it gets stomped on, but it’s not relevant; we need to get rid of the message altogether. The final solution is to skip the ‘Global symbol...’ error altogether while sv_clean_all (the final SV sweep) is being called, which we can detect based on whether PL_in_clean_all is set. --- diff --git a/gv.c b/gv.c index 6d36a1f..c1618c2 100644 --- a/gv.c +++ b/gv.c @@ -1588,14 +1588,16 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, /* By this point we should have a stash and a name */ if (!stash) { - if (add) { + if (add && !PL_in_clean_all) { + SV * const namesv = newSVpvn_flags(name, len, is_utf8); SV * const err = Perl_mess(aTHX_ "Global symbol \"%s%"SVf"\" requires explicit package name", (sv_type == SVt_PV ? "$" : sv_type == SVt_PVAV ? "@" : sv_type == SVt_PVHV ? "%" - : ""), SVfARG(newSVpvn_flags(name, len, SVs_TEMP | is_utf8))); + : ""), SVfARG(namesv)); GV *gv; + SvREFCNT_dec_NN(namesv); if (USE_UTF8_IN_NAMES) SvUTF8_on(err); qerror(err); diff --git a/t/re/recompile.t b/t/re/recompile.t index 785dcdb..ad00df8 100644 --- a/t/re/recompile.t +++ b/t/re/recompile.t @@ -61,7 +61,7 @@ sub _comp_n { my $status = $?; my $count = () = $results =~ /Final program:/g; - if ($count == $n) { + if ($count == $n && !$status) { pass($desc); } else {