X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=xs-src%2FMouseUtil.xs;fp=xs-src%2FMouseUtil.xs;h=925d3d4da1ac4f17d0fbbca683ce430d1087a62d;hp=c0e1d80dfdc803d049e253b5b6dc1f6cf77b81fd;hb=8fcdb9973a1df1958b61059c8cef572780daf91d;hpb=5433f84558b602c30288e7694d7597774ce49313 diff --git a/xs-src/MouseUtil.xs b/xs-src/MouseUtil.xs index c0e1d80..925d3d4 100644 --- a/xs-src/MouseUtil.xs +++ b/xs-src/MouseUtil.xs @@ -138,28 +138,36 @@ S_dopoptosub(pTHX_ I32 const startingblock) return i; } -/* workaround RT #69939 */ +/* workaround Perl-RT #69939 */ I32 mouse_call_sv_safe(pTHX_ SV* const sv, I32 const flags) { const PERL_CONTEXT* const cx = &cxstack[S_dopoptosub(aTHX_ cxstack_ix)]; assert( (flags & G_EVAL) == 0 ); //warn("cx_type=0x%02x PL_eval=0x%02x (%"SVf")", (unsigned)cx->cx_type, (unsigned)PL_in_eval, sv); - if(!(cx->cx_type & CXp_TRYBLOCK)) { + if(cx->cx_type & CXp_TRYBLOCK) { + return Perl_call_sv(aTHX_ sv, flags); + } + else { I32 count; - //SAVESPTR(ERRSV); - //ERRSV = sv_newmortal(); + ENTER; + /* Don't do SAVETMPS */ + + SAVESPTR(ERRSV); + ERRSV = sv_newmortal(); count = Perl_call_sv(aTHX_ sv, flags | G_EVAL); if(sv_true(ERRSV)){ - croak(NULL); /* rethrow */ + SV* const err = sv_mortalcopy(ERRSV); + LEAVE; + croak("Exception caught: %"SVf, err); /* rethrow */ } + + LEAVE; + return count; } - else { - return Perl_call_sv(aTHX_ sv, flags); - } } void