Harden t/54-unwind-threads.t against stray exits

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

diff --git a/Upper.xs b/Upper.xs
index 8321c56b807fc15a3356a929f23e7e196a4b23c3..0e36df1e98a4cbc7f5b65be2d703442e3b61d2be 100644 (file)
--- a/Upper.xs
+++ b/Upper.xs
@@ -256,6 +256,11 @@ static U8 su_op_gimme_reverse(U8 gimme) {
 # define MY_CXT_CLONE NOOP
 #endif
 
+/* --- Error messages ------------------------------------------------------ */
+
+static const char su_stack_smash[]    = "Cannot target a scope outside of the current stack";
+static const char su_no_such_target[] = "No targetable %s scope in the current stack";
+
 /* --- Unique context ID global storage ------------------------------------ */
 
 /* ... Sequence ID counter ................................................. */
@@ -2038,13 +2043,12 @@ static SV *su_uid_get(pTHX_ I32 cxix) {
  if (!(uid->flags & SU_UID_ACTIVE)) {
   su_ud_uid *ud;
 
-  uid->seq = su_uid_seq_next(depth);
+  uid->seq    = su_uid_seq_next(depth);
   uid->flags |= SU_UID_ACTIVE;
 
   Newx(ud, 1, su_ud_uid);
-  SU_UD_ORIGIN(ud)  = NULL;
-  SU_UD_TYPE(ud)    = SU_UD_TYPE_UID;
-  ud->uid = uid;
+  SU_UD_TYPE(ud) = SU_UD_TYPE_UID;
+  ud->uid        = uid;
   su_init(ud, cxix, SU_SAVE_DESTRUCTOR_SIZE);
  }
 
@@ -2587,6 +2591,8 @@ PPCODE:
   --cxix;
   cxix = su_context_skip_db(cxix);
   cxix = su_context_normalize_up(cxix);
+ } else {
+  warn(su_stack_smash);
  }
  EXTEND(SP, 1);
  mPUSHi(cxix);
@@ -2612,6 +2618,7 @@ PPCODE:
     XSRETURN(1);
   }
  }
+ warn(su_no_such_target, "subroutine");
  XSRETURN_UNDEF;
 
 void
@@ -2632,6 +2639,7 @@ PPCODE:
     XSRETURN(1);
   }
  }
+ warn(su_no_such_target, "eval");
  XSRETURN_UNDEF;
 
 void
@@ -2643,8 +2651,10 @@ PPCODE:
  SU_GET_LEVEL(0, 0);
  cxix = su_context_here();
  while (--level >= 0) {
-  if (cxix <= 0)
+  if (cxix <= 0) {
+   warn(su_stack_smash);
    break;
+  }
   --cxix;
   cxix = su_context_skip_db(cxix);
   cxix = su_context_normalize_up(cxix);
@@ -2674,6 +2684,8 @@ PPCODE:
   }
  }
 done:
+ if (level >= 0)
+  warn(su_stack_smash);
  EXTEND(SP, 1);
  mPUSHi(cxix);
  XSRETURN(1);
@@ -2872,9 +2884,10 @@ CODE:
  SU_GET_CONTEXT(1, 1, su_context_skip_db(cxstack_ix));
  cxix = su_context_normalize_down(cxix);
  Newx(ud, 1, su_ud_reap);
- SU_UD_ORIGIN(ud) = NULL;
- SU_UD_TYPE(ud)   = SU_UD_TYPE_REAP;
- ud->cb = newSVsv(hook);
+ SU_UD_TYPE(ud) = SU_UD_TYPE_REAP;
+ ud->cb         = (SvROK(hook) && SvTYPE(SvRV(hook)) >= SVt_PVCV)
+                  ? SvRV(hook) : hook;
+ SvREFCNT_inc_simple_void(ud->cb);
  su_init(ud, cxix, SU_SAVE_DESTRUCTOR_SIZE);
 
 void
@@ -2888,8 +2901,7 @@ CODE:
  SU_GET_CONTEXT(2, 2, su_context_skip_db(cxstack_ix));
  cxix = su_context_normalize_down(cxix);
  Newx(ud, 1, su_ud_localize);
- SU_UD_ORIGIN(ud) = NULL;
- SU_UD_TYPE(ud)   = SU_UD_TYPE_LOCALIZE;
+ SU_UD_TYPE(ud) = SU_UD_TYPE_LOCALIZE;
  size = su_ud_localize_init(ud, sv, val, NULL);
  su_init(ud, cxix, size);
 
@@ -2906,6 +2918,7 @@ CODE:
  SU_GET_CONTEXT(3, 3, su_context_skip_db(cxstack_ix));
  cxix = su_context_normalize_down(cxix);
  Newx(ud, 1, su_ud_localize);
+ /* Initialize SU_UD_ORIGIN(ud) in case SU_UD_LOCALIZE_FREE(ud) needs it */
  SU_UD_ORIGIN(ud) = NULL;
  SU_UD_TYPE(ud)   = SU_UD_TYPE_LOCALIZE;
  size = su_ud_localize_init(ud, sv, val, elem);
@@ -2926,8 +2939,7 @@ CODE:
  SU_GET_CONTEXT(2, 2, su_context_skip_db(cxstack_ix));
  cxix = su_context_normalize_down(cxix);
  Newx(ud, 1, su_ud_localize);
- SU_UD_ORIGIN(ud) = NULL;
- SU_UD_TYPE(ud)   = SU_UD_TYPE_LOCALIZE;
+ SU_UD_TYPE(ud) = SU_UD_TYPE_LOCALIZE;
  size = su_ud_localize_init(ud, sv, NULL, elem);
  su_init(ud, cxix, size);