import Devel-Size 0.67 from CPAN

[p5sagit/Devel-Size.git] / Size.xs

diff --git a/Size.xs b/Size.xs
old mode 100755 (executable)
new mode 100644 (file)
index 76a4f55..4fd7559
--- a/Size.xs
+++ b/Size.xs
@@ -40,7 +40,7 @@ cc_opclass(OP *o)
        return OPc_PADOP;
 #endif
 
-    if (o->op_type = OP_TRANS) {
+    if ((o->op_type = OP_TRANS)) {
       return OPc_BASEOP;
     }
 
@@ -360,7 +360,7 @@ UV op_size(OP *baseop, HV *tracking_hash) {
 UV thing_size(SV *orig_thing, HV *tracking_hash) {
   SV *thing = orig_thing;
   UV total_size = sizeof(SV);
-  
+
   switch (SvTYPE(thing)) {
     /* Is it undef? */
   case SVt_NULL:
@@ -394,32 +394,36 @@ UV thing_size(SV *orig_thing, HV *tracking_hash) {
        much has been allocated */
   case SVt_PV:
     total_size += sizeof(XPV);
-    total_size += SvLEN(thing);
+    total_size += SvROK(thing) ? thing_size( SvRV(thing), tracking_hash) : SvLEN(thing);
     break;
     /* A string with an integer part? */
   case SVt_PVIV:
     total_size += sizeof(XPVIV);
-    total_size += SvLEN(thing);
-    total_size += SvIVX(thing);
+    total_size += SvROK(thing) ? thing_size( SvRV(thing), tracking_hash) : SvLEN(thing);
+    if(SvOOK(thing)) {
+        total_size += SvIVX(thing);
+       }
     break;
     /* A string with a float part? */
   case SVt_PVNV:
     total_size += sizeof(XPVNV);
-    total_size += SvLEN(thing);
+    total_size += SvROK(thing) ? thing_size( SvRV(thing), tracking_hash) : SvLEN(thing);
     break;
   case SVt_PVMG:
     total_size += sizeof(XPVMG);
-    total_size += SvLEN(thing);
+    total_size += SvROK(thing) ? thing_size( SvRV(thing), tracking_hash) : SvLEN(thing);
     total_size += magic_size(thing, tracking_hash);
     break;
+#if PERL_VERSION <= 8
   case SVt_PVBM:
     total_size += sizeof(XPVBM);
-    total_size += SvLEN(thing);
+    total_size += SvROK(thing) ? thing_size( SvRV(thing), tracking_hash) : SvLEN(thing);
     total_size += magic_size(thing, tracking_hash);
     break;
+#endif
   case SVt_PVLV:
     total_size += sizeof(XPVLV);
-    total_size += SvLEN(thing);
+    total_size += SvROK(thing) ? thing_size( SvRV(thing), tracking_hash) : SvLEN(thing);
     total_size += magic_size(thing, tracking_hash);
     break;
     /* How much space is dedicated to the array? Not counting the
@@ -431,7 +435,16 @@ UV thing_size(SV *orig_thing, HV *tracking_hash) {
       total_size += sizeof(SV *) * AvMAX(thing);
     }
     /* Add in the bits on the other side of the beginning */
-    total_size += (sizeof(SV *) * (AvARRAY(thing) - AvALLOC(thing)));
+
+    /* 
+      printf ("total_size %li, sizeof(SV *) %li, AvARRAY(thing) %li, AvALLOC(thing)%li , sizeof(ptr) %li \n", 
+       total_size, sizeof(SV*), AvARRAY(thing), AvALLOC(thing), sizeof( thing )); */
+
+    /* under Perl 5.8.8 64bit threading, AvARRAY(thing) was a pointer while AvALLOC was 0,
+       resulting in grossly overstated sized for arrays. Technically, this shouldn't happen... */
+    if (AvALLOC(thing) != 0) {
+      total_size += (sizeof(SV *) * (AvARRAY(thing) - AvALLOC(thing)));
+      }
     /* Is there something hanging off the arylen element? */
     if (AvARYLEN(thing)) {
       if (check_new(tracking_hash, AvARYLEN(thing))) {
@@ -512,22 +525,22 @@ UV thing_size(SV *orig_thing, HV *tracking_hash) {
        total_size += sizeof(GP);
        {
          SV *generic_thing;
-         if (generic_thing = (SV *)(GvGP(thing)->gp_sv)) {
+         if ((generic_thing = (SV *)(GvGP(thing)->gp_sv))) {
            total_size += thing_size(generic_thing, tracking_hash);
          }
-         if (generic_thing = (SV *)(GvGP(thing)->gp_form)) {
+         if ((generic_thing = (SV *)(GvGP(thing)->gp_form))) {
            total_size += thing_size(generic_thing, tracking_hash);
          }
-         if (generic_thing = (SV *)(GvGP(thing)->gp_av)) {
+         if ((generic_thing = (SV *)(GvGP(thing)->gp_av))) {
            total_size += thing_size(generic_thing, tracking_hash);
          }
-         if (generic_thing = (SV *)(GvGP(thing)->gp_hv)) {
+         if ((generic_thing = (SV *)(GvGP(thing)->gp_hv))) {
            total_size += thing_size(generic_thing, tracking_hash);
          }
-         if (generic_thing = (SV *)(GvGP(thing)->gp_egv)) {
+         if ((generic_thing = (SV *)(GvGP(thing)->gp_egv))) {
            total_size += thing_size(generic_thing, tracking_hash);
          }
-         if (generic_thing = (SV *)(GvGP(thing)->gp_cv)) {
+         if ((generic_thing = (SV *)(GvGP(thing)->gp_cv))) {
            total_size += thing_size(generic_thing, tracking_hash);
          }
        }
@@ -644,8 +657,6 @@ CODE:
   IV size = 0;
   SV *warn_flag;
 
-  IV count = 0;
-
   /* Size starts at zero */
   RETVAL = 0;
 
@@ -681,6 +692,14 @@ CODE:
          av_push(pending_array, SvRV(thing));
          break;
 
+       /* fix for bug #24846 (Does not correctly recurse into references in a PVNV-type scalar) */
+       case SVt_PVNV:
+         if (SvROK(thing))
+           {
+           av_push(pending_array, SvRV(thing));
+           }
+         break;
+
        case SVt_PVAV:
          {
            /* Quick alias to cut down on casting */
@@ -693,7 +712,7 @@ CODE:
              /* Run through them all */
              for (index = 0; index <= av_len(tempAV); index++) {
                /* Did we get something? */
-               if (tempSV = av_fetch(tempAV, index, 0)) {
+               if ((tempSV = av_fetch(tempAV, index, 0))) {
                  /* Was it undef? */
                  if (*tempSV != &PL_sv_undef) {
                    /* Apparently not. Save it for later */
@@ -709,7 +728,7 @@ CODE:
          /* Is there anything in here? */
          if (hv_iterinit((HV *)thing)) {
            HE *temp_he;
-           while (temp_he = hv_iternext((HV *)thing)) {
+           while ((temp_he = hv_iternext((HV *)thing))) {
              av_push(pending_array, hv_iterval((HV *)thing, temp_he));
            }
          }