]> git.vpit.fr Git - perl/modules/autovivification.git/blobdiff - autovivification.xs
Replace !a_defined() by a_undef()
[perl/modules/autovivification.git] / autovivification.xs
index b56a21a36bc28e80719d3144c8f9874698b16191..cc0de37fb4bdef00e74bddee098d4084da6f9204 100644 (file)
@@ -159,21 +159,12 @@ STATIC void a_ptable_clone(pTHX_ ptable_ent *ent, void *ud_) {
  ptable_hints_store(ud->tbl, ent->key, h2);
 }
 
-STATIC void a_thread_cleanup(pTHX_ void *);
+#include "reap.h"
 
 STATIC void a_thread_cleanup(pTHX_ void *ud) {
int *level = ud;
dMY_CXT;
 
- if (*level) {
-  *level = 0;
-  LEAVE;
-  SAVEDESTRUCTOR_X(a_thread_cleanup, level);
-  ENTER;
- } else {
-  dMY_CXT;
-  PerlMemShared_free(level);
-  ptable_hints_free(MY_CXT.tbl);
- }
+ ptable_hints_free(MY_CXT.tbl);
 }
 
 #endif /* A_THREADSAFE */
@@ -529,30 +520,30 @@ cancel:
  return oi->flags & A_HINT_ROOT ? 0 : flags;
 }
 
-/* ... Lightweight pp_defined() ............................................ */
-
-STATIC bool a_defined(pTHX_ SV *sv) {
-#define a_defined(S) a_defined(aTHX_ (S))
- bool defined = FALSE;
+/* ... Inspired from pp_defined() .......................................... */
 
+STATIC int a_undef(pTHX_ SV *sv) {
+#define a_undef(S) a_undef(aTHX_ (S))
  switch (SvTYPE(sv)) {
+  case SVt_NULL:
+   return 1;
   case SVt_PVAV:
    if (AvMAX(sv) >= 0 || SvGMAGICAL(sv)
                       || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
-    defined = TRUE;
+    return 0;
    break;
   case SVt_PVHV:
    if (HvARRAY(sv) || SvGMAGICAL(sv)
                    || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
-    defined = TRUE;
+    return 0;
    break;
   default:
    SvGETMAGIC(sv);
    if (SvOK(sv))
-    defined = TRUE;
+    return 0;
  }
 
- return defined;
+ return 1;
 }
 
 /* --- PP functions -------------------------------------------------------- */
@@ -574,7 +565,7 @@ STATIC OP *a_pp_rv2av(pTHX) {
  flags = oi.flags;
 
  if (flags & A_HINT_DEREF) {
-  if (!a_defined(TOPs)) {
+  if (a_undef(TOPs)) {
    /* We always need to push an empty array to fool the pp_aelem() that comes
     * later. */
    SV *av;
@@ -601,7 +592,7 @@ STATIC OP *a_pp_rv2hv_simple(pTHX) {
  flags = oi.flags;
 
  if (flags & A_HINT_DEREF) {
-  if (!a_defined(TOPs))
+  if (a_undef(TOPs))
    RETURN;
  } else {
   PL_op->op_ppaddr = oi.old_pp;
@@ -619,7 +610,7 @@ STATIC OP *a_pp_rv2hv(pTHX) {
  flags = oi.flags;
 
  if (flags & A_HINT_DEREF) {
-  if (!a_defined(TOPs)) {
+  if (a_undef(TOPs)) {
    SV *hv;
    POPs;
    hv = sv_2mortal((SV *) newHV());
@@ -655,7 +646,7 @@ deref:
 
   if (flags & (A_HINT_NOTIFY|A_HINT_STORE)) {
    SPAGAIN;
-   if (!a_defined(TOPs)) {
+   if (a_undef(TOPs)) {
     if (flags & A_HINT_STRICT)
      croak("Reference vivification forbidden");
     else if (flags & A_HINT_WARN)
@@ -690,7 +681,7 @@ STATIC OP *a_pp_root_unop(pTHX) {
  a_op_info oi;
  dSP;
 
- if (!a_defined(TOPs)) {
+ if (a_undef(TOPs)) {
   POPs;
   /* Can only be reached by keys or values */
   if (GIMME_V == G_SCALAR) {
@@ -709,7 +700,7 @@ STATIC OP *a_pp_root_binop(pTHX) {
  a_op_info oi;
  dSP;
 
- if (!a_defined(TOPm1s)) {
+ if (a_undef(TOPm1s)) {
   POPs;
   POPs;
   if (PL_op->op_type == OP_EXISTS)
@@ -1124,7 +1115,6 @@ CLONE(...)
 PROTOTYPE: DISABLE
 PREINIT:
  ptable *t;
- int    *level;
 PPCODE:
  {
   my_cxt_t ud;
@@ -1138,13 +1128,7 @@ PPCODE:
   MY_CXT.tbl   = t;
   MY_CXT.owner = aTHX;
  }
- {
-  level = PerlMemShared_malloc(sizeof *level);
-  *level = 1;
-  LEAVEn("sub");
-  SAVEDESTRUCTOR_X(a_thread_cleanup, level);
-  ENTERn("sub");
- }
+ reap(3, a_thread_cleanup, NULL);
  XSRETURN(0);
 
 #endif