]> git.vpit.fr Git - perl/modules/Sub-Nary.git/blobdiff - Nary.xs
projects / perl / modules / Sub-Nary.git / blobdiff
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
With cheating a bit, we get 100% XS code coverage
[perl/modules/Sub-Nary.git] / Nary.xs
diff --git a/Nary.xs b/Nary.xs
index c3f1bc59e1ec590ba587842e815de37a6950bd28..285bfc39973766318639023337c2f0916e90fb0f 100644 (file)
--- a/Nary.xs
+++ b/Nary.xs
@@ -15,6 +15,17 @@ typedef struct {
  NV v;
 } sn_combcache;
 
+STATIC void sn_store(pTHX_ HV *tb, const char *key, I32 klen, SV *val, U32 hash) {
+#define sn_store(T, K, KL, V, H) sn_store(aTHX_ (T), (K), (KL), (V), (H))
+ if (!hv_store(tb, key, klen, val, hash)) SvREFCNT_dec(val);
+}
+
+STATIC void sn_store_ent(pTHX_ HV *tb, SV *key, SV *val, U32 hash) {
+#define sn_store_ent(T, K, V, H) sn_store_ent(aTHX_ (T), (K), (V), (H))
+ if (!hv_store_ent(tb, key, val, hash)) SvREFCNT_dec(val);
+}
+
+
 STATIC U32 sn_hash_list = 0;
 
 /* --- XS ------------------------------------------------------------------ */
@@ -62,23 +73,6 @@ CODE:
  res = hv_iterinit(hv) == 1 && hv_exists(hv, "0", 1);
  XSRETURN_IV(res);
 
-void
-list(SV *sv)
-PROTOTYPE: $
-PREINIT:
- HV *hv;
- IV res;
-CODE:
- if (!SvOK(sv))
-  XSRETURN_IV(0);
- if (!SvROK(sv)) {
-  res = strEQ(SvPV_nolen(sv), "list");
-  XSRETURN_IV(res);
- }
- hv = (HV *) SvRV(sv);
- res = hv_iterinit(hv) == 1 && hv_exists(hv, "list", 4);
- XSRETURN_IV(res);
-
 void
 count(SV *sv)
 PROTOTYPE: $
@@ -104,31 +98,24 @@ PROTOTYPE: $
 PREINIT:
  HV *hv, *res;
  HE *key;
- SV *val;
  NV c = 0;
 CODE:
  if (!SvOK(sv))
   XSRETURN_UNDEF;
  res = newHV();
  if (!SvROK(sv)) {
-  val = newSVuv(1);
-  if (!hv_store_ent(res, sv, val, 0))
-   SvREFCNT_dec(val);
+  sn_store_ent(res, sv, newSVuv(1), 0);
  } else {
   hv = (HV *) SvRV(sv);
   if (!hv_iterinit(hv)) {
-   val = newSVuv(1);
-   if (!hv_store(res, "0", 1, val, 0))
-    SvREFCNT_dec(val);
+   sn_store(res, "0", 1, newSVuv(1), 0);
   } else {
-   while (key = hv_iternext(hv)) {
+   while (key = hv_iternext(hv))
     c += SvNV(HeVAL(key));
-   }
    hv_iterinit(hv);
    while (key = hv_iternext(hv)) {
-    val = newSVnv(SvNV(HeVAL(key)) / c);
-    if (!hv_store_ent(res, HeSVKEY_force(key), val, HeHASH(key)))
-     SvREFCNT_dec(val);
+    SV *val = newSVnv(SvNV(HeVAL(key)) / c);
+    sn_store_ent(res, HeSVKEY_force(key), val, HeHASH(key));
    }
   }
  }
@@ -141,7 +128,6 @@ PROTOTYPE: $;$
 PREINIT:
  HV *hv, *res;
  HE *key;
- SV *val;
  NV c = 1;
 CODE:
  if (!SvOK(sv))
@@ -150,21 +136,16 @@ CODE:
   c = SvNV(csv);
  res = newHV();
  if (!SvROK(sv)) {
-  val = newSVnv(c);
-  if (!hv_store_ent(res, sv, val, 0))
-   SvREFCNT_dec(val);
+  sn_store_ent(res, sv, newSVnv(c), 0);
  } else {
   hv = (HV *) SvRV(sv);
   if (!hv_iterinit(hv)) {
-   val = newSVnv(c);
-   if (!hv_store(res, "0", 1, val, 0))
-    SvREFCNT_dec(val);
+   sn_store(res, "0", 1, newSVnv(c), 0);
   } else {
    hv_iterinit(hv);
    while (key = hv_iternext(hv)) {
-    val = newSVnv(SvNV(HeVAL(key)) * c);
-    if (!hv_store_ent(res, HeSVKEY_force(key), val, HeHASH(key)))
-     SvREFCNT_dec(val);
+    SV *val = newSVnv(SvNV(HeVAL(key)) * c);
+    sn_store_ent(res, HeSVKEY_force(key), val, HeHASH(key));
    }
   }
  }
@@ -188,21 +169,11 @@ CODE:
   if (!SvOK(cur))
    continue;
   if (!SvROK(cur)) {
-   if (strEQ(SvPV_nolen(cur), "list")) {
-    hv_clear(res);
-    val = newSVuv(1);
-    if (!hv_store(res, "list", 4, val, sn_hash_list))
-     SvREFCNT_dec(val);
-    break;
-   } else {
-    NV v = 1;
-    if ((old = hv_fetch_ent(res, cur, 1, 0)) && SvOK(val = HeVAL(old)))
-     v += SvNV(val);
-    val = newSVnv(v);
-    if (!hv_store_ent(res, cur, val, 0))
-     SvREFCNT_dec(val);
-    continue;
-   }
+   NV v = 1;
+   if ((old = hv_fetch_ent(res, cur, 1, 0)) && SvOK(val = HeVAL(old)))
+    v += SvNV(val);
+   sn_store_ent(res, cur, newSVnv(v), 0);
+   continue;
   }
   cur = SvRV(cur);
   hv_iterinit((HV *) cur);
@@ -211,9 +182,7 @@ CODE:
    NV  v = SvNV(HeVAL(key));
    if ((old = hv_fetch_ent(res, k, 1, 0)) && SvOK(val = HeVAL(old)))
     v += SvNV(val);
-   val = newSVnv(v);
-   if (!hv_store_ent(res, k, val, 0))
-    SvREFCNT_dec(val);
+   sn_store_ent(res, k, newSVnv(v), 0);
   }
  }
  if (!hv_iterinit(res)) {
@@ -228,7 +197,6 @@ cumulate(SV *sv, SV *nsv, SV *csv)
 PROTOTYPE: $$$
 PREINIT:
  HV *res;
- SV *val;
  HE *key;
  NV c0, c, a;
  UV i, n;
@@ -248,20 +216,23 @@ CODE:
  sv = SvRV(sv);
  if (!hv_iterinit((HV *) sv))
   XSRETURN_UNDEF;
- c = 1;
- a = c0;
- for (; n > 0; n /= 2) {
-  if (n % 2)
-   c *= a;
-  a *= a;
+ if (c0 == 1 || (SvIOK(csv) && SvIV(csv) == 1)) {
+  c = n;
+ } else {
+  c = 1;
+  a = c0;
+  for (; n > 0; n /= 2) {
+   if (n % 2)
+    c *= a;
+   a *= a;
+  }
+  c = (1 - c) / (1 - c0);
  }
- c = (1 - c) / (1 - c0);
  res = newHV();
  while (key = hv_iternext((HV *) sv)) {
-  SV *k = HeSVKEY_force(key);
-  val = newSVnv(c * SvNV(HeVAL(key)));
-  if (!hv_store_ent(res, k, val, 0))
-   SvREFCNT_dec(val);
+  SV *k   = HeSVKEY_force(key);
+  SV *val = newSVnv(c * SvNV(HeVAL(key)));
+  sn_store_ent(res, k, val, 0);
  }
  ST(0) = sv_2mortal(newRV_noinc((SV *) res));
  XSRETURN(1);
@@ -293,9 +264,7 @@ CODE:
    if (strEQ(SvPV_nolen(cur), "list")) {
     res[0] = newHV();
     n      = 0;
-    val    = newSVuv(1);
-    if (!hv_store(res[0], "list", 4, val, sn_hash_list))
-     SvREFCNT_dec(val);
+    sn_store(res[0], "list", 4, newSVuv(1), sn_hash_list);
     i = items;
     if (!shift)
      do_shift = 0;
@@ -308,11 +277,8 @@ CODE:
   }
   cur    = SvRV(cur);
   res[0] = newHV();
-  while (key = hv_iternext((HV *) cur)) {
-   val = newSVsv(HeVAL(key));
-   if (!hv_store_ent(res[0], HeSVKEY_force(key), val, 0))
-    SvREFCNT_dec(val);
-  }
+  while (key = hv_iternext((HV *) cur))
+   sn_store_ent(res[0], HeSVKEY_force(key), newSVsv(HeVAL(key)), 0);
   n = 0;
   if (!shift)
    do_shift = 0;
@@ -326,9 +292,7 @@ CODE:
   if (!SvROK(cur)) {
    if (strEQ(SvPV_nolen(cur), "list")) {
     hv_clear(res[n]);
-    val = newSVuv(1);
-    if (!hv_store(res[n], "list", 4, val, sn_hash_list))
-     SvREFCNT_dec(val);
+    sn_store(res[n], "list", 4, newSVuv(1), sn_hash_list);
     shift = 0;
     do_shift = 0;
     break;
@@ -348,17 +312,14 @@ CODE:
   list2 = hv_delete(res[n],     "list", 4, 0);
   n2    = hv_iterinit(res[n]);
   if ((list1 && !n1) || (list2 && !n2)) {
-   val = newSViv(1);
-   if (!hv_store(res[o], "list", 4, val, sn_hash_list))
-    SvREFCNT_dec(val);
+   sn_store(res[o], "list", 4, newSViv(1), sn_hash_list);
    n = o;
    break;
   } else if (list1 || list2) {
    NV l1 = list1 ? SvNV(list1) : 0;
    NV l2 = list2 ? SvNV(list2) : 0;
    val = newSVnv(l1 + l2 - l1 * l2);
-   if (!hv_store(res[o], "list", 4, val, sn_hash_list))
-    SvREFCNT_dec(val);
+   sn_store(res[o], "list", 4, val, sn_hash_list);
   }
   if (n2 > cachelen) {
    Renew(cache, n2, sn_combcache);
@@ -380,8 +341,7 @@ CODE:
     } else {
      val = newSVnv(v * cache[j].v);
     }
-    if (!hv_store_ent(res[o], temp, val, 0))
-     SvREFCNT_dec(val);
+    sn_store_ent(res[o], temp, val, 0);
    }
   }
   n = o;
@@ -391,9 +351,7 @@ CODE:
   if (!res[n]) {
    res[n] = newHV();
    sv_setiv(temp, shift);
-   val = newSViv(1);
-   if (!hv_store_ent(res[n], temp, val, 0))
-    SvREFCNT_dec(val);
+   sn_store_ent(res[n], temp, newSViv(1), 0);
   } else {
    o = 1 - n;
    if (!res[o])
@@ -404,15 +362,10 @@ CODE:
    hv_iterinit(res[n]);
    while (key = hv_iternext(res[n])) {
     sv_setiv(temp, SvUV(HeSVKEY_force(key)) + shift);
-    val = newSVsv(HeVAL(key));
-    if (!hv_store_ent(res[o], temp, val, 0))
-     SvREFCNT_dec(val);
-   }
-   if (list1) {
-    val = newSVsv(list1);
-    if (!hv_store(res[o], "list", 4, val, sn_hash_list))
-     SvREFCNT_dec(val);
+    sn_store_ent(res[o], temp, newSVsv(HeVAL(key)), 0);
    }
+   if (list1)
+    sn_store(res[o], "list", 4, newSVsv(list1), sn_hash_list);
    n = o;
   }
  } else if (!res[0] && !res[1])
A Perl extension that tries to count how many elements a subroutine can return in list context.