summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--regen/warnings.pl6
-rw-r--r--t/op/gv.t18
-rw-r--r--warnings.h6
3 files changed, 25 insertions, 5 deletions
diff --git a/regen/warnings.pl b/regen/warnings.pl
index 815c735e37..94cd7a4f04 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))
diff --git a/t/op/gv.t b/t/op/gv.t
index d71fd0a54d..03ae46e46b 100644
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -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))