Use cmp_ok() in place of ok() with a < comparison, for better diagnostics.

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

diff --git a/Size.xs b/Size.xs
index f1155a2..45a23a4 100644 (file)
--- a/Size.xs
+++ b/Size.xs
@@ -1,15 +1,19 @@
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
-
+#include "ppport.h"
 
 #ifdef _MSC_VER 
-#   include <excpt.h>
-#   define try __try
-#   define catch __except
-#   define EXCEPTION EXCEPTION_EXECUTE_HANDLER
+/* "structured exception" handling is a Microsoft extension to C and C++.
+   It's *not* C++ exception handling - C++ exception handling can't capture
+   SEGVs and suchlike, whereas this can. There's no known analagous
+    functionality on other platforms.  */
+#  include <excpt.h>
+#  define TRY_TO_CATCH_SEGV __try
+#  define CAUGHT_EXCEPTION __except(EXCEPTION EXCEPTION_EXECUTE_HANDLER)
 #else
-#   define EXCEPTION ...
+#  define TRY_TO_CATCH_SEGV if(1)
+#  define CAUGHT_EXCEPTION else
 #endif
 
 #ifdef __GNUC__
@@ -43,17 +47,19 @@ typedef char* TRACKING[ TRACKING_SLOTS ];
     Returns true or false, and
     notes thing in the segmented bitstring.
  */
-IV check_new( TRACKING *tv, void *p ) {
+static bool
+check_new(TRACKING *tv, const void *const p) {
     unsigned long slot =  (unsigned long)p >> (SLOT_BITS + BIT_BITS + ALIGN_BITS);
     unsigned int  byte = ((unsigned long)p >> (ALIGN_BITS + BIT_BITS)) & 0x00003fffU;
     unsigned int  bit  = ((unsigned long)p >> ALIGN_BITS) & 0x00000007U;
     unsigned int  nop  =  (unsigned long)p & 0x3U;
     
-    if (NULL == p || NULL == tv) return FALSE;
-    try { 
-        char c = *(char *)p;
+    assert(tv);
+    if (NULL == p) return FALSE;
+    TRY_TO_CATCH_SEGV { 
+        const char c = *(const char *)p;
     }
-    catch ( EXCEPTION ) {
+    CAUGHT_EXCEPTION {
         if( dangle_whine ) 
             warn( "Devel::Size: Encountered invalid pointer: %p\n", p );
         return FALSE;
@@ -101,7 +107,7 @@ cc_opclass(const OP * const o)
 {
     if (!o)
     return OPc_NULL;
-    try {
+    TRY_TO_CATCH_SEGV {
         if (o->op_type == 0)
         return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
 
@@ -205,7 +211,7 @@ cc_opclass(const OP * const o)
         warn("Devel::Size: Can't determine class of operator %s, assuming BASEOP\n",
          PL_op_name[o->op_type]);
     }
-    catch( EXCEPTION ) { }
+    CAUGHT_EXCEPTION { }
     return OPc_BASEOP;
 }
 
@@ -235,7 +241,7 @@ IV magic_size(const SV * const thing, TRACKING *tv) {
   while (magic_pointer && check_new(tv, magic_pointer)) {
     total_size += sizeof(MAGIC);
 
-    try {
+    TRY_TO_CATCH_SEGV {
         /* Have we seen the magic vtable? */
         if (magic_pointer->mg_virtual &&
         check_new(tv, magic_pointer->mg_virtual)) {
@@ -245,7 +251,7 @@ IV magic_size(const SV * const thing, TRACKING *tv) {
         /* Get the next in the chain */ // ?try
         magic_pointer = magic_pointer->mg_moremagic;
     }
-    catch( EXCEPTION ) { 
+    CAUGHT_EXCEPTION { 
         if( dangle_whine ) 
             warn( "Devel::Size: Encountered bad magic at: %p\n", magic_pointer );
     }
@@ -276,7 +282,7 @@ UV regex_size(const REGEXP * const baseregex, TRACKING *tv) {
 
 UV op_size(const OP * const baseop, TRACKING *tv) {
   UV total_size = 0;
-  try {
+  TRY_TO_CATCH_SEGV {
       TAG;
       if (check_new(tv, baseop->op_next)) {
            total_size += op_size(baseop->op_next, tv);
@@ -422,7 +428,7 @@ UV op_size(const OP * const baseop, TRACKING *tv) {
         TAG;break;
       }
   }
-  catch( EXCEPTION ) {
+  CAUGHT_EXCEPTION {
       if( dangle_whine ) 
           warn( "Devel::Size: Encountered dangling pointer in opcode at: %p\n", baseop );
   }
@@ -548,12 +554,17 @@ UV thing_size(const SV * const orig_thing, TRACKING *tv) {
     if (AvALLOC(thing) != 0) {
       total_size += (sizeof(SV *) * (AvARRAY(thing) - AvALLOC(thing)));
       }
-    /* Is there something hanging off the arylen element? */
+#if (PERL_VERSION < 9)
+    /* Is there something hanging off the arylen element?
+       Post 5.9.something this is stored in magic, so will be found there,
+       and Perl_av_arylen_p() takes a non-const AV*, hence compilers rightly
+       complain about AvARYLEN() passing thing to it.  */
     if (AvARYLEN(thing)) {
       if (check_new(tv, AvARYLEN(thing))) {
     total_size += thing_size(AvARYLEN(thing), tv);
       }
     }
+#endif
     total_size += magic_size(thing, tv);
     TAG;break;
   case SVt_PVHV: TAG;
@@ -668,7 +679,7 @@ UV thing_size(const SV * const orig_thing, TRACKING *tv) {
   case SVt_PVIO: TAG;
     total_size += sizeof(XPVIO);
     total_size += magic_size(thing, tv);
-    if (check_new(tv, (SvPVX(thing)))) {
+    if (check_new(tv, (SvPVX_const(thing)))) {
       total_size += ((XPVIO *) SvANY(thing))->xpv_cur;
     }
     /* Some embedded char pointers */