Really include Test::Leaner 0.02

[perl/modules/Scope-Upper.git] / Upper.xs

diff --git a/Upper.xs b/Upper.xs
index 47dab2b2100ea76d5b2ec5f68e268ee3aaf7df2b..999eabaed83fc506825a7dc6659a6934c3e76c0b 100644 (file)
--- a/Upper.xs
+++ b/Upper.xs
@@ -48,6 +48,10 @@
 # define SvREFCNT_inc_simple_void(sv) SvREFCNT_inc(sv)
 #endif
 
+#ifndef GvCV_set
+# define GvCV_set(G, C) (GvCV(G) = (C))
+#endif
+
 #ifndef HvNAME_get
 # define HvNAME_get(H) HvNAME(H)
 #endif
@@ -167,8 +171,10 @@ START_MY_CXT
 # define SU_SAVE_GP_SIZE 6
 #elif !SU_HAS_PERL(5, 13, 0) || (SU_RELEASE && SU_HAS_PERL_EXACT(5, 13, 0))
 # define SU_SAVE_GP_SIZE 3
-#else
+#elif !SU_HAS_PERL(5, 13, 8)
 # define SU_SAVE_GP_SIZE 4
+#else
+# define SU_SAVE_GP_SIZE 3
 #endif
 
 #ifndef SvCANEXISTDELETE
@@ -310,6 +316,45 @@ STATIC void su_save_helem(pTHX_ HV *hv, SV *keysv, SV *val) {
  }
 }
 
+/* ... Saving code slots from a glob ....................................... */
+
+#if SU_HAS_PERL(5, 13, 10)
+
+/* Since perl 5.13.10, GvCV() is only a rvalue so we no longer can store a
+ * pointer to the gvcv member of the gv. */
+
+typedef struct {
+ GV *gv;
+ CV *old_cv;
+} su_save_gvcv_ud;
+
+STATIC void su_restore_gvcv(pTHX_ void *ud_) {
+ su_save_gvcv_ud *ud = ud_;
+
+ GvCV_set(ud->gv, ud->old_cv);
+
+ Safefree(ud);
+}
+
+STATIC void su_save_gvcv(pTHX_ GV *gv) {
+#define su_save_gvcv(gv) su_save_gvcv(aTHX_ (gv))
+ su_save_gvcv_ud *ud;
+
+ Newx(ud, 1, su_save_gvcv_ud);
+ ud->gv     = gv;
+ ud->old_cv = GvCV(gv);
+
+ GvCV_set(gv, NULL);
+
+ SAVEDESTRUCTOR_X(su_restore_gvcv, ud);
+}
+
+#else
+
+#define su_save_gvcv(gv) SAVESPTR(GvCV(gv)), GvCV_set((gv), NULL)
+
+#endif
+
 /* --- Actions ------------------------------------------------------------- */
 
 typedef struct {
@@ -543,8 +588,7 @@ STATIC void su_localize(pTHX_ void *ud_) {
    save_gp(gv, 1); /* hide previous entry in symtab */
    break;
   case SVt_PVCV:
-   SAVESPTR(GvCV(gv));
-   GvCV(gv) = NULL;
+   su_save_gvcv(gv);
    break;
   default:
    gv = (GV *) save_scalar(gv);