Change 29976 by [EMAIL PROTECTED] on 2007/01/25 17:25:09
Integrate:
[ 28135]
allow exit during fold_constants
eg BEGIN { $SIG{__WARN__} = sub{exit};} "a" == "b"
[ 28148]
disable WARN and DIE hooks during constant folding
Affected files ...
... //depot/maint-5.8/perl/op.c#179 integrate
... //depot/maint-5.8/perl/t/comp/fold.t#2 integrate
... //depot/maint-5.8/perl/util.c#128 integrate
... //depot/maint-5.8/perl/warnings.h#7 integrate
... //depot/maint-5.8/perl/warnings.pl#18 integrate
Differences ...
==== //depot/maint-5.8/perl/op.c#179 (text) ====
Index: perl/op.c
--- perl/op.c#178~29974~ 2007-01-25 09:04:16.000000000 -0800
+++ perl/op.c 2007-01-25 09:25:09.000000000 -0800
@@ -2103,6 +2103,8 @@
int ret = 0;
I32 oldscope;
OP *old_next;
+ SV * const oldwarnhook = PL_warnhook;
+ SV * const olddiehook = PL_diehook;
dJMPENV;
if (PL_opargs[type] & OA_RETSCALAR)
@@ -2164,6 +2166,8 @@
oldscope = PL_scopestack_ix;
create_eval_scope(G_FAKINGEVAL);
+ PL_warnhook = PERL_WARNHOOK_FATAL;
+ PL_diehook = NULL;
#ifdef PERL_FLEXIBLE_EXCEPTIONS
CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_vcall_runops));
@@ -2192,10 +2196,15 @@
default:
JMPENV_POP;
/* Don't expect 1 (setjmp failed) or 2 (something called my_exit) */
+ PL_warnhook = oldwarnhook;
+ PL_diehook = olddiehook;
+ /* XXX note that this croak may fail as we've already blown away
+ * the stack - eg any nested evals */
Perl_croak(aTHX_ "panic: fold_constants JMPENV_PUSH returned %d", ret);
}
-
JMPENV_POP;
+ PL_warnhook = oldwarnhook;
+ PL_diehook = olddiehook;
if (PL_scopestack_ix > oldscope)
delete_eval_scope();
==== //depot/maint-5.8/perl/t/comp/fold.t#2 (text) ====
Index: perl/t/comp/fold.t
--- perl/t/comp/fold.t#1~27742~ 2006-04-08 10:28:28.000000000 -0700
+++ perl/t/comp/fold.t 2007-01-25 09:25:09.000000000 -0800
@@ -8,7 +8,7 @@
use strict;
use warnings;
-plan (8);
+plan (13);
# Historically constant folding was performed by evaluating the ops, and if
# they threw an exception compilation failed. This was seen as buggy, because
@@ -17,6 +17,7 @@
# making constant folding consistent with many other languages, and purely an
# optimisation rather than a behaviour change.
+
my $a;
$a = eval '$b = 0/0 if 0; 3';
is ($a, 3);
@@ -36,3 +37,20 @@
is ($a, 5);
is ($@, "");
+# warn and die hooks should be disabled during constant folding
+
+{
+ my $c = 0;
+ local $SIG{__WARN__} = sub { $c++ };
+ local $SIG{__DIE__} = sub { $c+= 2 };
+ eval q{
+ is($c, 0, "premature warn/die: $c");
+ my $x = "a"+5;
+ is($c, 1, "missing warn hook");
+ is($x, 5, "a+5");
+ $c = 0;
+ $x = 1/0;
+ };
+ like ($@, qr/division/, "eval caught division");
+ is($c, 2, "missing die hook");
+}
==== //depot/maint-5.8/perl/util.c#128 (text) ====
Index: perl/util.c
--- perl/util.c#127~29962~ 2007-01-24 14:51:14.000000000 -0800
+++ perl/util.c 2007-01-25 09:25:09.000000000 -0800
@@ -1447,7 +1447,7 @@
void
Perl_vwarner(pTHX_ U32 err, const char* pat, va_list* args)
{
- if (ckDEAD(err)) {
+ if (PL_warnhook == PERL_WARNHOOK_FATAL || ckDEAD(err)) {
SV * const msv = vmess(pat, args);
STRLEN msglen;
const char * const message = SvPV_const(msv, msglen);
==== //depot/maint-5.8/perl/warnings.h#7 (text+w) ====
Index: perl/warnings.h
--- perl/warnings.h#6~28128~ 2006-05-08 12:22:03.000000000 -0700
+++ perl/warnings.h 2007-01-25 09:25:09.000000000 -0800
@@ -24,6 +24,9 @@
#define specialWARN(x) ((x) == pWARN_STD || (x) == pWARN_ALL ||
\
(x) == pWARN_NONE)
+/* if PL_warnhook is set to this value, then warnings die */
+#define PERL_WARNHOOK_FATAL (((SV*)0) + 1)
+
/* Warnings Categories added in Perl 5.008 */
#define WARN_ALL 0
==== //depot/maint-5.8/perl/warnings.pl#18 (text) ====
Index: perl/warnings.pl
--- perl/warnings.pl#17~28128~ 2006-05-08 12:22:03.000000000 -0700
+++ perl/warnings.pl 2007-01-25 09:25:09.000000000 -0800
@@ -281,6 +281,9 @@
#define specialWARN(x) ((x) == pWARN_STD || (x) == pWARN_ALL ||
\
(x) == pWARN_NONE)
+
+/* if PL_warnhook is set to this value, then warnings die */
+#define PERL_WARNHOOK_FATAL (((SV*)0) + 1)
EOM
my $offset = 0 ;
End of Patch.
