[perl #51370] length($@)>0 for empty $@ if utf8 is in use

From: "Bram via RT" <perlbug-followup@perl.org>
Message-ID: <rt-3.6.HEAD-18229-1213179984-1708.51370-15-0@perl.org>

(The first patch)

p4raw-id: //depot/perl@34068

diff --git a/op.c b/op.c
index c314caf..d18e6da 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (executable)
--- 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 = <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 \$@";
+}