Workaround RT #69939

diff --git a/mouse.h b/mouse.h
index bfb7836..a30d537 100644 (file)
--- a/mouse.h
+++ b/mouse.h
@@ -70,6 +70,15 @@ mouse_throw_error(SV* const metaobject, SV* const data /* not used */, const cha
     ;
 #endif
 
+/* workaround RT #69939 */
+I32
+mouse_call_sv_safe(pTHX_ SV*, I32);
+
+#define call_sv_safe(sv, flags)     mouse_call_sv_safe(aTHX_ sv, flags)
+#define call_method_safe(m, flags)  mouse_call_sv_safe(aTHX_ newSVpvn_flags(m, strlen(m), SVs_TEMP), flags | G_METHOD)
+#define call_method_safes(m, flags) mouse_call_sv_safe(aTHX_ newSVpvs_flags(m, SVs_TEMP),            flags | G_METHOD)
+
+
 #define is_class_loaded(sv) mouse_is_class_loaded(aTHX_ sv)
 bool mouse_is_class_loaded(pTHX_ SV*);
 

diff --git a/xs-src/Mouse.xs b/xs-src/Mouse.xs
index 979fcd3..955ab2f 100644 (file)
--- a/xs-src/Mouse.xs
+++ b/xs-src/Mouse.xs
@@ -397,7 +397,7 @@ mouse_buildall(pTHX_ AV* const xc, SV* const object, SV* const args) {
         PUSHs(args);
         PUTBACK;
 
-        call_sv(AvARRAY(buildall)[i], G_VOID);
+        call_sv_safe(AvARRAY(buildall)[i], G_VOID);
 
         /* discard a scalar which G_VOID returns */
         SPAGAIN;
@@ -513,6 +513,7 @@ CODE:
     /*  *{$package . '::' . $name} -> *gv */
     gv = gv_fetchpv(form("%"SVf"::%"SVf, package, name), GV_ADDMULTI, SVt_PVCV);
     mouse_install_sub(aTHX_ gv, code_ref);
+    //CvMETHOD_on((CV*)SvRV(code_ref));
     (void)set_slot(methods, name, code); /* $self->{methods}{$name} = $code */
 }
 
@@ -651,9 +652,10 @@ CODE:
         for(i = 0; i < items; i++){
             PUSHs(ST(i));
         }
-        //SP += items;
+
         PUTBACK;
-        call_method("BUILDARGS", G_SCALAR);
+        call_method_safes("BUILDARGS", G_SCALAR);
+
         SPAGAIN;
         args = POPs;
         PUTBACK;
@@ -722,14 +724,16 @@ CODE:
             GvSV(statusvalue) = sv_newmortal();
         }
         SAVESPTR(ERRSV); /* local $@ */
-        ERRSV = newSVpvs_flags("", SVs_TEMP);
+        ERRSV = sv_newmortal();
+
+        EXTEND(SP, 2);
 
         for(i = 0; i < len; i++){
             SPAGAIN;
 
             PUSHMARK(SP);
-            XPUSHs(object);
-            XPUSHs(boolSV(PL_dirty));
+            PUSHs(object);
+            PUSHs(boolSV(PL_dirty));
             PUTBACK;
 
             call_sv(AvARRAY(demolishall)[i], G_VOID | G_EVAL);

diff --git a/xs-src/MouseAccessor.xs b/xs-src/MouseAccessor.xs
index a16b2ae..27be7b9 100644 (file)
--- a/xs-src/MouseAccessor.xs
+++ b/xs-src/MouseAccessor.xs
@@ -156,7 +156,7 @@ mouse_attr_set(pTHX_ SV* const self, MAGIC* const mg, SV* value){
         PUSHs(value);
 
         PUTBACK;
-        call_sv(trigger, G_VOID | G_DISCARD);
+        call_sv_safe(trigger, G_VOID | G_DISCARD);
         /* need not SPAGAIN */
 
         assert(SvTYPE(value) != SVTYPEMASK);

diff --git a/xs-src/MouseUtil.xs b/xs-src/MouseUtil.xs
index 8587b64..5b01e40 100644 (file)
--- a/xs-src/MouseUtil.xs
+++ b/xs-src/MouseUtil.xs
@@ -120,6 +120,28 @@ mouse_throw_error(SV* const metaobject, SV* const data /* not used */, const cha
     }
 }
 
+/* workaround RT #69939 */
+I32
+mouse_call_sv_safe(pTHX_ SV* const sv, I32 const flags) {
+    assert( (flags & G_EVAL) == 0 );
+
+    if(!PL_in_eval) {
+        I32 count;
+        SAVESPTR(ERRSV);
+        ERRSV = sv_newmortal();
+
+        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);
+    }
+}
+
 void
 mouse_must_defined(pTHX_ SV* const value, const char* const name) {
     assert(value);
@@ -199,7 +221,7 @@ mouse_call0 (pTHX_ SV* const self, SV* const method) {
     XPUSHs(self);
     PUTBACK;
 
-    call_sv(method, G_SCALAR | G_METHOD);
+    call_sv_safe(method, G_SCALAR | G_METHOD);
 
     SPAGAIN;
     ret = POPs;
@@ -219,7 +241,7 @@ mouse_call1 (pTHX_ SV* const self, SV* const method, SV* const arg1) {
     PUSHs(arg1);
     PUTBACK;
 
-    call_sv(method, G_SCALAR | G_METHOD);
+    call_sv_safe(method, G_SCALAR | G_METHOD);
 
     SPAGAIN;
     ret = POPs;