X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=Size.xs;h=4fd7559ea1bbeb38c126a8b4fb284b94a3a12c0c;hb=b1e5ad85e1c05c8f9a3822664645476e0924ec3e;hp=bd1b20cde8cd228668fd9c21e03810fab89a7c60;hpb=98ecbbc6c212eef2620e62ec70db99bd81160683;p=p5sagit%2FDevel-Size.git

diff --git a/Size.xs b/Size.xs
old mode 100755
new mode 100644
index bd1b20c..4fd7559
--- a/Size.xs
+++ b/Size.xs
@@ -19,9 +19,8 @@ typedef enum {
     OPc_SVOP,	/* 7 */
     OPc_PADOP,	/* 8 */
     OPc_PVOP,	/* 9 */
-    OPc_CVOP,	/* 10 */
-    OPc_LOOP,	/* 11 */
-    OPc_COP	/* 12 */
+    OPc_LOOP,	/* 10 */
+    OPc_COP	/* 11 */
 } opclass;
 
 static opclass
@@ -41,6 +40,10 @@ cc_opclass(OP *o)
 	return OPc_PADOP;
 #endif
 
+    if ((o->op_type = OP_TRANS)) {
+      return OPc_BASEOP;
+    }
+
     switch (PL_opargs[o->op_type] & OA_CLASS_MASK) {
     case OA_BASEOP:
 	return OPc_BASEOP;
@@ -147,7 +150,7 @@ static int go_yell = 1;
    pointer as the length. Perl then uses the four (or eight, on
    64-bit machines) bytes of the address as the string we're using as
    the key */
-IV check_new(HV *tracking_hash, void *thing) {
+IV check_new(HV *tracking_hash, const void *thing) {
   if (NULL == thing) {
     return FALSE;
   }
@@ -316,6 +319,7 @@ UV op_size(OP *baseop, HV *tracking_hash) {
       total_size += op_size(cLOOPx(baseop)->op_lastop, tracking_hash);
     }  
     */
+    break;
   case OPc_COP:
     {
       COP *basecop;
@@ -349,10 +353,14 @@ UV op_size(OP *baseop, HV *tracking_hash) {
   return total_size;
 }
 
+#if PERL_VERSION > 9 || (PERL_VERSION == 9 && PERL_SUBVERSION > 2)
+#  define NEW_HEAD_LAYOUT
+#endif
+
 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:
@@ -360,10 +368,12 @@ UV thing_size(SV *orig_thing, HV *tracking_hash) {
     /* Just a plain integer. This will be differently sized depending
        on whether purify's been compiled in */
   case SVt_IV:
-#ifdef PURIFY
+#ifndef NEW_HEAD_LAYOUT
+#  ifdef PURIFY
     total_size += sizeof(sizeof(XPVIV));
-#else
+#  else
     total_size += sizeof(IV);
+#  endif
 #endif
     break;
     /* Is it a float? Like the int, it depends on purify */
@@ -376,37 +386,44 @@ UV thing_size(SV *orig_thing, HV *tracking_hash) {
     break;
     /* Is it a reference? */
   case SVt_RV:
+#ifndef NEW_HEAD_LAYOUT
     total_size += sizeof(XRV);
+#endif
     break;
     /* 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? */
   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
@@ -418,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))) {
@@ -499,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);
 	  }
 	}
@@ -540,7 +566,7 @@ UV thing_size(SV *orig_thing, HV *tracking_hash) {
   case SVt_PVIO:
     total_size += sizeof(XPVIO);
     total_size += magic_size(thing, tracking_hash);
-    if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xpv_pv)) {
+    if (check_new(tracking_hash, (SvPVX(thing)))) {
       total_size += ((XPVIO *) SvANY(thing))->xpv_cur;
     }
     /* Some embedded char pointers */
@@ -631,8 +657,6 @@ CODE:
   IV size = 0;
   SV *warn_flag;
 
-  IV count = 0;
-
   /* Size starts at zero */
   RETVAL = 0;
 
@@ -668,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 */
@@ -680,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 */
@@ -696,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));
 	    }
 	  }