From: Rafael Garcia-Suarez <rgs@consttype.org>
Date: Tue, 4 May 2010 13:02:08 +0000 (+0200)
Subject: Merge remote branch 'zefram/zefram/reliable_exception' into blead
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=99782e35be86d92df5daa0659d4cb2351d4a36b9;p=p5sagit%2Fp5-mst-13.2.git

Merge remote branch 'zefram/zefram/reliable_exception' into blead

Conflicts:
	pp_ctl.c
---

99782e35be86d92df5daa0659d4cb2351d4a36b9
diff --cc pp_ctl.c
index 4fc0bdf,1be7b68..37a585c
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@@ -1654,9 -1621,9 +1623,9 @@@ Perl_die_unwind(pTHX_ SV *msv
  	    PL_curcop = cx->blk_oldcop;
  
  	    if (optype == OP_REQUIRE) {
-                 const char* const msg = SvPVx_nolen_const(ERRSV);
+                 const char* const msg = SvPVx_nolen_const(exceptsv);
 -		SV * const nsv = cx->blk_eval.old_namesv;
 -                (void)hv_store(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv),
 +                (void)hv_store(GvHVn(PL_incgv),
 +                               SvPVX_const(namesv), SvCUR(namesv),
                                 &PL_sv_undef, 0);
  		/* note that unlike pp_entereval, pp_require isn't
  		 * supposed to trap errors. So now that we've popped the
@@@ -1665,8 -1632,14 +1634,15 @@@
  		DIE(aTHX_ "%sCompilation failed in require",
  		    *msg ? msg : "Unknown error\n");
  	    }
+ 	    if (in_eval & EVAL_KEEPERR) {
+ 		Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "\t(in cleanup) %s",
+ 			       SvPV_nolen_const(exceptsv));
+ 	    }
+ 	    else {
+ 		sv_setsv(ERRSV, exceptsv);
+ 	    }
  	    assert(CxTYPE(cx) == CXt_EVAL);
 +	    PL_restartjmpenv = cx->blk_eval.cur_top_env;
  	    PL_restartop = cx->blk_eval.retop;
  	    JMPENV_JUMP(3);
  	    /* NOTREACHED */
@@@ -3934,12 -3902,10 +3910,12 @@@ PP(pp_leaveeval
  	!(gimme == G_SCALAR ? SvTRUE(*SP) : SP > newsp))
      {
  	/* Unassume the success we assumed earlier. */
 -	SV * const nsv = cx->blk_eval.old_namesv;
 -	(void)hv_delete(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv), G_DISCARD);
 -	retop = Perl_die(aTHX_ "%"SVf" did not return a true value", SVfARG(nsv));
 +	(void)hv_delete(GvHVn(PL_incgv),
 +			SvPVX_const(namesv), SvCUR(namesv),
 +			G_DISCARD);
 +	retop = Perl_die(aTHX_ "%"SVf" did not return a true value",
 +			       SVfARG(namesv));
- 	/* die_where() did LEAVE, or we won't be here */
+ 	/* die_unwind() did LEAVE, or we won't be here */
      }
      else {
  	LEAVE_with_name("eval");