Fix compilation under blead, and require at least 5.006

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

diff --git a/Size.xs b/Size.xs
index be6cf53..c69c348 100644 (file)
--- a/Size.xs
+++ b/Size.xs
@@ -198,12 +198,17 @@ UV regex_size(REGEXP *baseregex, HV *tracking_hash) {
   UV total_size = 0;
 
   total_size += sizeof(REGEXP);
-  /* Note hte size of the paren offset thing */
+#if (PERL_VERSION < 11)        
+  /* Note the size of the paren offset thing */
   total_size += sizeof(I32) * baseregex->nparens * 2;
   total_size += strlen(baseregex->precomp);
-
+#else
+  total_size += sizeof(struct regexp);
+  total_size += sizeof(I32) * SvANY(baseregex)->nparens * 2;
+  /*total_size += strlen(SvANY(baseregex)->subbeg);*/
+#endif
   if (go_yell && !regex_whine) {
-    carp("Devel::Size: Calculated sizes for compiled regexes are incomple, and probably always will be");
+    carp("Devel::Size: Calculated sizes for compiled regexes are incompatible, and probably always will be");
     regex_whine = 1;
   }
 
@@ -216,9 +221,6 @@ UV op_size(OP *baseop, HV *tracking_hash) {
   if (check_new(tracking_hash, baseop->op_next)) {
     total_size += op_size(baseop->op_next, tracking_hash);
   }
-  if (check_new(tracking_hash, baseop->op_next)) {
-    total_size += op_size(baseop->op_next, tracking_hash);
-  }
 
   switch (cc_opclass(baseop)) {
   case OPc_BASEOP:
@@ -265,6 +267,7 @@ UV op_size(OP *baseop, HV *tracking_hash) {
     if (check_new(tracking_hash, cPMOPx(baseop)->op_last)) {
       total_size += op_size(cPMOPx(baseop)->op_last, tracking_hash);
     }
+#if PERL_VERSION < 9 || (PERL_VERSION == 9 && PERL_SUBVERSION < 5)
     if (check_new(tracking_hash, cPMOPx(baseop)->op_pmreplroot)) {
       total_size += op_size(cPMOPx(baseop)->op_pmreplroot, tracking_hash);
     }
@@ -274,6 +277,7 @@ UV op_size(OP *baseop, HV *tracking_hash) {
     if (check_new(tracking_hash, cPMOPx(baseop)->op_pmnext)) {
       total_size += op_size((OP *)cPMOPx(baseop)->op_pmnext, tracking_hash);
     }
+#endif
     /* This is defined away in perl 5.8.x, but it is in there for
        5.6.x */
 #ifdef PM_GETRE
@@ -360,7 +364,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:
@@ -384,46 +388,48 @@ UV thing_size(SV *orig_thing, HV *tracking_hash) {
     total_size += sizeof(NV);
 #endif
     break;
+#if (PERL_VERSION < 11)        
     /* Is it a reference? */
   case SVt_RV:
 #ifndef NEW_HEAD_LAYOUT
     total_size += sizeof(XRV);
 #endif
     break;
+#endif
     /* How about a plain string? In which case we need to add in how
        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 += SvROK(thing) ? thing_size( SvRV(thing), tracking_hash) : SvLEN(thing);
     if(SvOOK(thing)) {
         total_size += SvIVX(thing);
        }
     break;
-    /* A string with a float part? */
+    /* A scalar/string/reference 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
@@ -432,16 +438,17 @@ UV thing_size(SV *orig_thing, HV *tracking_hash) {
     total_size += sizeof(XPVAV);
     /* Is there anything in the array? */
     if (AvMAX(thing) != -1) {
-      total_size += sizeof(SV *) * AvMAX(thing);
+      /* an array with 10 slots has AvMax() set to 9 - te 2007-04-22 */
+      total_size += sizeof(SV *) * (AvMAX(thing) + 1);
+      /* printf ("total_size: %li AvMAX: %li av_len: %i\n", total_size, AvMAX(thing), av_len(thing)); */
     }
     /* Add in the bits on the other side of the beginning */
 
-    /* 
-      printf ("total_size %li, sizeof(SV *) %li, AvARRAY(thing) %li, AvALLOC(thing)%li , sizeof(ptr) %li \n", 
+      /* 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 */
+       resulting in grossly overstated sized for arrays. Technically, this shouldn't happen... */
     if (AvALLOC(thing) != 0) {
       total_size += (sizeof(SV *) * (AvARRAY(thing) - AvALLOC(thing)));
       }
@@ -686,12 +693,22 @@ CODE:
     if (check_new(tracking_hash, thing)) {
       /* Is it valid? */
       if (thing) {
+       /* printf ("Found type %i at %p\n", SvTYPE(thing), thing); */
+
        /* Yes, it is. So let's check the type */
        switch (SvTYPE(thing)) {
        case SVt_RV:
          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 */