From: Bram Date: Wed, 11 Jun 2008 03:26:26 +0000 (-0700) Subject: [perl #51370] length($@)>0 for empty $@ if utf8 is in use X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8433848b134d4e61d5135fd8a70d8106025ac6a6;p=p5sagit%2Fp5-mst-13.2.git [perl #51370] length($@)>0 for empty $@ if utf8 is in use From: "Bram via RT" Message-ID: (The first patch) p4raw-id: //depot/perl@34068 --- diff --git a/op.c b/op.c index c314caf..d18e6da 100644 --- a/op.c +++ b/op.c @@ -2521,7 +2521,7 @@ Perl_fold_constants(pTHX_ register OP *o) 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: diff --git a/perl.c b/perl.c index 291021c..fe01ec0 100644 --- a/perl.c +++ b/perl.c @@ -2679,8 +2679,9 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags) 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 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags) 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 @@ S_init_main_stash(pTHX) 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)); diff --git a/perl.h b/perl.h index 8e48b6d..aa3df96 100644 --- a/perl.h +++ b/perl.h @@ -6008,6 +6008,8 @@ extern void moncontrol(int); #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 diff --git a/pp_ctl.c b/pp_ctl.c index 261b1be..38e171f 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -2148,8 +2148,9 @@ PP(pp_return) 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 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq) 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 @@ PP(pp_leaveeval) } else { LEAVE; - if (!(save_flags & OPf_SPECIAL)) - sv_setpvn(ERRSV,"",0); + if (!(save_flags & OPf_SPECIAL)) { + clear_errsv(); + } } RETURNOP(retop); @@ -3816,8 +3819,9 @@ Perl_create_eval_scope(pTHX_ U32 flags) 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 @@ PP(pp_leavetry) PL_curpm = newpm; /* Don't pop $1 et al till now */ LEAVE; - sv_setpvn(ERRSV,"",0); + clear_errsv(); RETURN; } diff --git a/t/op/eval.t b/t/op/eval.t index 2eb9b1e..d3241e6 100755 --- a/t/op/eval.t +++ b/t/op/eval.t @@ -5,7 +5,7 @@ BEGIN { @INC = '../lib'; } -print "1..95\n"; +print "1..98\n"; eval 'print "ok 1\n";'; @@ -485,4 +485,63 @@ print "ok $test - eval and last\n"; $test++; } +# [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 = ; + 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 \$@\n"; + + $test++; + 1 while unlink("peek_eval_$$.t"); +} +else { + print "ok $test # skipped - eval { 1 } completly resets \$@"; +}