Change 34262 by [EMAIL PROTECTED] on 2008/09/04 07:37:07
Integrate:
[ 34068]
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)
[ 34069]
Rename the new macro clear_errsv() from last patch to CLEAR_ERRSV()
Affected files ...
... //depot/maint-5.10/perl/op.c#15 integrate
... //depot/maint-5.10/perl/perl.c#16 integrate
... //depot/maint-5.10/perl/perl.h#14 integrate
... //depot/maint-5.10/perl/pp_ctl.c#17 integrate
... //depot/maint-5.10/perl/t/op/eval.t#2 integrate
Differences ...
==== //depot/maint-5.10/perl/op.c#15 (text) ====
Index: perl/op.c
--- perl/op.c#14~33972~ 2008-05-31 16:40:24.000000000 -0700
+++ perl/op.c 2008-09-04 00:37:07.000000000 -0700
@@ -2444,7 +2444,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/maint-5.10/perl/perl.c#16 (text) ====
Index: perl/perl.c
--- perl/perl.c#15~34260~ 2008-09-03 22:17:21.000000000 -0700
+++ perl/perl.c 2008-09-04 00:37:07.000000000 -0700
@@ -2653,8 +2653,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;
@@ -2752,8 +2753,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;
@@ -3525,7 +3527,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/maint-5.10/perl/perl.h#14 (text) ====
Index: perl/perl.h
--- perl/perl.h#13~33946~ 2008-05-28 16:09:01.000000000 -0700
+++ perl/perl.h 2008-09-04 00:37:07.000000000 -0700
@@ -5985,6 +5985,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/maint-5.10/perl/pp_ctl.c#17 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#16~33972~ 2008-05-31 16:40:24.000000000 -0700
+++ perl/pp_ctl.c 2008-09-04 00:37:07.000000000 -0700
@@ -2102,8 +2102,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;
}
@@ -2941,7 +2942,7 @@
if (saveop && (saveop->op_type != OP_REQUIRE) && (saveop->op_flags &
OPf_SPECIAL))
PL_in_eval |= EVAL_KEEPERR;
else
- sv_setpvn(ERRSV,"",0);
+ CLEAR_ERRSV();
if (yyparse() || PL_parser->error_count || !PL_eval_root) {
SV **newsp; /* Used by POPBLOCK. */
PERL_CONTEXT *cx = &cxstack[cxstack_ix];
@@ -3695,8 +3696,9 @@
}
else {
LEAVE;
- if (!(save_flags & OPf_SPECIAL))
- sv_setpvn(ERRSV,"",0);
+ if (!(save_flags & OPf_SPECIAL)) {
+ CLEAR_ERRSV();
+ }
}
RETURNOP(retop);
@@ -3740,7 +3742,7 @@
if (flags & G_KEEPERR)
PL_in_eval |= EVAL_KEEPERR;
else
- sv_setpvn(ERRSV,"",0);
+ CLEAR_ERRSV();
if (flags & G_FAKINGEVAL) {
PL_eval_root = PL_op; /* Only needed so that goto works right. */
}
@@ -3799,7 +3801,7 @@
PL_curpm = newpm; /* Don't pop $1 et al till now */
LEAVE;
- sv_setpvn(ERRSV,"",0);
+ CLEAR_ERRSV();
RETURN;
}
==== //depot/maint-5.10/perl/t/op/eval.t#2 (xtext) ====
Index: perl/t/op/eval.t
--- perl/t/op/eval.t#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/t/op/eval.t 2008-09-04 00:37:07.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.