X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=xs-src%2FMouseUtil.xs;h=ae5fb39ac3d5bd220bb8432d917014696af0397a;hb=f0e1969bc2752f79154513a6df9b46571ee3e8ba;hp=c0e1d80dfdc803d049e253b5b6dc1f6cf77b81fd;hpb=5433f84558b602c30288e7694d7597774ce49313;p=gitmo%2FMouse.git diff --git a/xs-src/MouseUtil.xs b/xs-src/MouseUtil.xs index c0e1d80..ae5fb39 100644 --- a/xs-src/MouseUtil.xs +++ b/xs-src/MouseUtil.xs @@ -120,46 +120,28 @@ mouse_throw_error(SV* const metaobject, SV* const data /* not used */, const cha } } -static I32 -S_dopoptosub(pTHX_ I32 const startingblock) -{ - const PERL_CONTEXT* const cxstk = cxstack; - I32 i; - for (i = startingblock; i >= 0; i--) { - const PERL_CONTEXT* const cx = &cxstk[i]; - - switch (CxTYPE(cx)) { - case CXt_EVAL: - case CXt_SUB: - case CXt_FORMAT: - return i; - } - } - 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 ); + I32 count; + ENTER; + /* Don't do SAVETMPS */ - //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)) { - I32 count; - //SAVESPTR(ERRSV); - //ERRSV = sv_newmortal(); + SAVESPTR(ERRSV); + ERRSV = sv_newmortal(); - count = Perl_call_sv(aTHX_ sv, flags | G_EVAL); + count = Perl_call_sv(aTHX_ sv, flags | G_EVAL); - if(sv_true(ERRSV)){ - croak(NULL); /* rethrow */ - } - return count; - } - else { - return Perl_call_sv(aTHX_ sv, flags); + if(sv_true(ERRSV)){ + SV* const err = sv_mortalcopy(ERRSV); + LEAVE; + sv_setsv(ERRSV, err); + croak(NULL); /* rethrow */ } + + LEAVE; + + return count; } void