Change 34068 by [EMAIL PROTECTED] on 2008/06/17 11:13:38
Subject: [perl #51370] length($@)>0 for empty $@ if utf8 is in use
From: "Bram via RT" <[EMAIL PROTECTED]>
Date: Wed, 11 Jun 2008 03:26:26 -0700
Message-ID: <[EMAIL PROTECTED]>
(The first patch)
Affected files ...
... //depot/perl/op.c#1005 edit
... //depot/perl/perl.c#871 edit
... //depot/perl/perl.h#838 edit
... //depot/perl/pp_ctl.c#692 edit
... //depot/perl/t/op/eval.t#33 edit
Differences ...
==== //depot/perl/op.c#1005 (text) ====
Index: perl/op.c
--- perl/op.c#1004~33849~ 2008-05-18 00:55:44.000000000 -0700
+++ perl/op.c 2008-06-17 04:13:38.000000000 -0700
@@ -2521,7 +2521,7 @@
case 3:
/* Something tried to die. Abandon constant folding. */
/* Pretend the error never happened. */
- sv_setpvn(ERRSV,"",0);
+ clear_errsv();
o->op_next = old_next;
break;
default:
==== //depot/perl/perl.c#871 (text) ====
Index: perl/perl.c
--- perl/perl.c#870~33683~ 2008-04-14 23:57:32.000000000 -0700
+++ perl/perl.c 2008-06-17 04:13:38.000000000 -0700
@@ -2679,8 +2679,9 @@
redo_body:
CALL_BODY_SUB((OP*)&myop);
retval = PL_stack_sp - (PL_stack_base + oldmark);
- if (!(flags & G_KEEPERR))
- sv_setpvn(ERRSV,"",0);
+ if (!(flags & G_KEEPERR)) {
+ clear_errsv();
+ }
break;
case 1:
STATUS_ALL_FAILURE;
@@ -2780,8 +2781,9 @@
redo_body:
CALL_BODY_EVAL((OP*)&myop);
retval = PL_stack_sp - (PL_stack_base + oldmark);
- if (!(flags & G_KEEPERR))
- sv_setpvn(ERRSV,"",0);
+ if (!(flags & G_KEEPERR)) {
+ clear_errsv();
+ }
break;
case 1:
STATUS_ALL_FAILURE;
@@ -3559,7 +3561,7 @@
gv_SVadd(PL_errgv);
#endif
sv_grow(ERRSV, 240); /* Preallocate - for immediate signals. */
- sv_setpvn(ERRSV, "", 0);
+ clear_errsv();
PL_curstash = PL_defstash;
CopSTASH_set(&PL_compiling, PL_defstash);
PL_debstash = GvHV(gv_fetchpvs("DB::", GV_ADDMULTI, SVt_PVHV));
==== //depot/perl/perl.h#838 (text) ====
Index: perl/perl.h
--- perl/perl.h#837~33762~ 2008-04-28 13:41:31.000000000 -0700
+++ perl/perl.h 2008-06-17 04:13:38.000000000 -0700
@@ -6008,6 +6008,8 @@
#endif /* Include guard */
+#define clear_errsv() STMT_START { sv_setpvn(ERRSV,"",0); if
(SvMAGICAL(ERRSV)) { mg_free(ERRSV); } SvPOK_only(ERRSV); } STMT_END
+
/*
* Local variables:
* c-indentation-style: bsd
==== //depot/perl/pp_ctl.c#692 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#691~33777~ 2008-05-02 04:07:19.000000000 -0700
+++ perl/pp_ctl.c 2008-06-17 04:13:38.000000000 -0700
@@ -2148,8 +2148,9 @@
PL_curpm = newpm; /* ... and pop $1 et al */
LEAVESUB(sv);
- if (clear_errsv)
- sv_setpvn(ERRSV,"",0);
+ if (clear_errsv) {
+ clear_errsv();
+ }
return retop;
}
@@ -3000,8 +3001,9 @@
CopARYBASE_set(PL_curcop, 0);
if (saveop && (saveop->op_type != OP_REQUIRE) && (saveop->op_flags &
OPf_SPECIAL))
PL_in_eval |= EVAL_KEEPERR;
- else
- sv_setpvn(ERRSV,"",0);
+ else {
+ clear_errsv();
+ }
if (yyparse() || PL_parser->error_count || !PL_eval_root) {
SV **newsp; /* Used by POPBLOCK. */
PERL_CONTEXT *cx = &cxstack[cxstack_ix];
@@ -3772,8 +3774,9 @@
}
else {
LEAVE;
- if (!(save_flags & OPf_SPECIAL))
- sv_setpvn(ERRSV,"",0);
+ if (!(save_flags & OPf_SPECIAL)) {
+ clear_errsv();
+ }
}
RETURNOP(retop);
@@ -3816,8 +3819,9 @@
PL_in_eval = EVAL_INEVAL;
if (flags & G_KEEPERR)
PL_in_eval |= EVAL_KEEPERR;
- else
- sv_setpvn(ERRSV,"",0);
+ else {
+ clear_errsv();
+ }
if (flags & G_FAKINGEVAL) {
PL_eval_root = PL_op; /* Only needed so that goto works right. */
}
@@ -3876,7 +3880,7 @@
PL_curpm = newpm; /* Don't pop $1 et al till now */
LEAVE;
- sv_setpvn(ERRSV,"",0);
+ clear_errsv();
RETURN;
}
==== //depot/perl/t/op/eval.t#33 (xtext) ====
Index: perl/t/op/eval.t
--- perl/t/op/eval.t#32~31587~ 2007-07-11 05:02:11.000000000 -0700
+++ perl/t/op/eval.t 2008-06-17 04:13:38.000000000 -0700
@@ -5,7 +5,7 @@
@INC = '../lib';
}
-print "1..95\n";
+print "1..98\n";
eval 'print "ok 1\n";';
@@ -485,4 +485,63 @@
}
+# [perl #51370] eval { die "\x{a10d}" } followed by eval { 1 } did not reset
+# length $@
+$@ = "";
+eval { die "\x{a10d}"; };
+$_ = length $@;
+eval { 1 };
+
+print "not " if ($@ ne "");
+print "ok $test # length of \$@ after eval\n"; $test++;
+
+print "not " if (length $@ != 0);
+print "ok $test # length of \$@ after eval\n"; $test++;
+
+# Check if eval { 1 }; compeltly resets $@
+if (eval "use Devel::Peek; 1;") {
+
+ open PROG, ">", "peek_eval_$$.t" or die "Can't create test file";
+ print PROG <<'END_EVAL_TEST';
+ use Devel::Peek;
+ $! = 0;
+ $@ = $!;
+ my $ok = 0;
+ open(SAVERR, ">&STDERR") or die "Can't dup STDERR: $!";
+ if (open(OUT,">peek_eval$$")) {
+ open(STDERR, ">&OUT") or die "Can't dup OUT: $!";
+ Dump($@);
+ print STDERR "******\n";
+ eval { die "\x{a10d}"; };
+ $_ = length $@;
+ eval { 1 };
+ Dump($@);
+ open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!";
+ close(OUT);
+ if (open(IN, "peek_eval$$")) {
+ local $/;
+ my $in = <IN>;
+ my ($first, $second) = split (/\*\*\*\*\*\*\n/, $in, 2);
+ $first =~ s/,pNOK//;
+ $ok = 1 if ($first eq $second);
+ }
+ }
+
+ print $ok;
+ END {
+ 1 while unlink("peek_eval$$");
+ }
+END_EVAL_TEST
+ close PROG;
+
+ my $ok = runperl(progfile => "peek_eval_$$.t");
+ print "not " unless $ok;
+ print "ok $test # eval { 1 } completly resets [EMAIL PROTECTED]";
+
+ $test++;
+ 1 while unlink("peek_eval_$$.t");
+}
+else {
+ print "ok $test # skipped - eval { 1 } completly resets \$@";
+}
End of Patch.
