diff options
| author | Father Chrysostomos <sprout@cpan.org> | 2016-07-11 14:49:17 -0700 |
|---|---|---|
| committer | Steve Hay <steve.m.hay@googlemail.com> | 2017-08-09 08:06:25 +0100 |
| commit | e38784fd0407f657ecbd5cba8d4b8dafd34deb56 (patch) | |
| tree | 6fa72a7bef2101e69007a9a054353d7ac5edc985 | |
| parent | 07f0edfcb5a97def4aa61ab608716c584c73fa21 (diff) | |
| download | perl-e38784fd0407f657ecbd5cba8d4b8dafd34deb56.tar.gz | |
[perl #128597] Crash from gp_free/ckWARN_d
See the explanation in the test added and in the RT ticket.
The solution is to make the warn macros check that PL_curcop
is non-null.
(cherry picked from commit a2637ca0a3fec01b80d7ea5ba62802354fd5e6f3)
| -rw-r--r-- | regen/warnings.pl | 6 | ||||
| -rw-r--r-- | t/op/gv.t | 18 | ||||
| -rw-r--r-- | warnings.h | 6 |
3 files changed, 25 insertions, 5 deletions
diff --git a/regen/warnings.pl b/regen/warnings.pl index 22c9c1531f..dae0cf1a30 100644 --- a/regen/warnings.pl +++ b/regen/warnings.pl @@ -358,8 +358,10 @@ EOM print $warn <<'EOM'; -#define isLEXWARN_on cBOOL(PL_curcop->cop_warnings != pWARN_STD) -#define isLEXWARN_off cBOOL(PL_curcop->cop_warnings == pWARN_STD) +#define isLEXWARN_on \ + cBOOL(PL_curcop && PL_curcop->cop_warnings != pWARN_STD) +#define isLEXWARN_off \ + cBOOL(!PL_curcop || PL_curcop->cop_warnings == pWARN_STD) #define isWARN_ONCE (PL_dowarn & (G_WARN_ON|G_WARN_ONCE)) #define isWARN_on(c,x) (IsSet((U8 *)(c + 1), 2*(x))) #define isWARNf_on(c,x) (IsSet((U8 *)(c + 1), 2*(x)+1)) @@ -12,7 +12,7 @@ BEGIN { use warnings; -plan(tests => 276 ); +plan(tests => 277 ); # type coercion on assignment $foo = 'foo'; @@ -1153,6 +1153,22 @@ pass "No crash due to CvGV pointing to glob copy in the stash"; is($c_125840, 1, 'RT #125840: $c=$d'); } +# [perl #128597] Crash when gp_free calls ckWARN_d +# I am not sure this test even belongs in this file, as the crash was the +# result of various features interacting. But a call to ckWARN_d from +# gv.c:gp_free triggered the crash, so this seems as good a place as any. +# ‘die’ (or any abnormal scope exit) can cause the current cop to be freed, +# if the subroutine containing the ‘die’ gets freed as a result. That +# causes PL_curcop to be set to NULL. If a writable handle gets freed +# while PL_curcop is NULL, then gp_free will call ckWARN_d while that con- +# dition still holds, so ckWARN_d needs to know about PL_curcop possibly +# being NULL. +SKIP: { + skip_if_miniperl("No PerlIO::scalar on miniperl", 1); + runperl(prog => 'open my $fh, q|>|, \$buf;' + .'my $sub = eval q|sub {exit 0}|; $sub->()'); + is ($? & 127, 0,"[perl #128597] No crash when gp_free calls ckWARN_d"); +} __END__ Perl diff --git a/warnings.h b/warnings.h index 337bef374c..4d137320bb 100644 --- a/warnings.h +++ b/warnings.h @@ -115,8 +115,10 @@ #define WARN_ALLstring "\125\125\125\125\125\125\125\125\125\125\125\125\125\125\125\125\125" #define WARN_NONEstring "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0" -#define isLEXWARN_on cBOOL(PL_curcop->cop_warnings != pWARN_STD) -#define isLEXWARN_off cBOOL(PL_curcop->cop_warnings == pWARN_STD) +#define isLEXWARN_on \ + cBOOL(PL_curcop && PL_curcop->cop_warnings != pWARN_STD) +#define isLEXWARN_off \ + cBOOL(!PL_curcop || PL_curcop->cop_warnings == pWARN_STD) #define isWARN_ONCE (PL_dowarn & (G_WARN_ON|G_WARN_ONCE)) #define isWARN_on(c,x) (IsSet((U8 *)(c + 1), 2*(x))) #define isWARNf_on(c,x) (IsSet((U8 *)(c + 1), 2*(x)+1)) |