import Devel-Size 0.59 from CPAN

git-cpan-module:   Devel-Size
git-cpan-version:  0.59
git-cpan-authorid: DSUGAL
git-cpan-file:     authors/id/D/DS/DSUGAL/Devel-Size-0.59.tar.gz

diff --git a/Changes b/Changes
old mode 100644 (file)
new mode 100755 (executable)
index 8d56e3a..5e10260
--- a/Changes
+++ b/Changes
@@ -27,4 +27,8 @@ Revision history for Perl extension Devel::Size.
 0.58  Fri Jul 18 11:42:32 2003
         - Fix for problems triggered by perl 5.8.0 and up, more tests, and
          removal of an "our" for better backwards compatibility. (Courtesy
-         of Marcus Holland-Moritz <mhx-perl@gmx.net>)
\ No newline at end of file
+         of Marcus Holland-Moritz <mhx-perl@gmx.net>)
+
+0.59  Sat Nov 27 16:42:42 2004
+        - Applied documentation and sane warning patch from Nigel Sandever
+        - Taught Devel::Size how to size up IO and globs properly

diff --git a/MANIFEST b/MANIFEST
old mode 100644 (file)
new mode 100755 (executable)
index e3c1321..21b8387
--- a/MANIFEST
+++ b/MANIFEST
@@ -4,3 +4,4 @@ Makefile.PL
 Size.pm
 Size.xs
 t/basic.t
+META.yml                                Module meta-data (added by MakeMaker)

diff --git a/META.yml b/META.yml
new file mode 100644 (file)
index 0000000..8391a0e
--- /dev/null
+++ b/META.yml
@@ -0,0 +1,9 @@
+#XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
+name:         Devel-Size
+version:      0.59
+version_from: Size.pm
+installdirs:  site
+requires:
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.12

diff --git a/Makefile.PL b/Makefile.PL
old mode 100644 (file)
new mode 100755 (executable)

diff --git a/Size.pm b/Size.pm
old mode 100644 (file)
new mode 100755 (executable)
index 1a86667..6b2b987
--- a/Size.pm
+++ b/Size.pm
@@ -24,7 +24,7 @@ require DynaLoader;
 @EXPORT = qw(
        
 );
-$VERSION = '0.58';
+$VERSION = '0.59';
 
 bootstrap Devel::Size $VERSION;
 
@@ -201,6 +201,39 @@ potential alignment and bucket overhead, per thing it looks at. This
 memory is released at the end, but it may fragment your free pool,
 and will definitely expand your process' memory footprint.
 
+=head1 Messages: texts originating from this module.
+
+=head2 Errors
+
+=over 4
+
+=item  "Devel::Size: Unknown variable type"
+
+The thing (or something contained within it) that you gave to 
+total_size() was unrecognisable as a Perl entity.
+
+=back
+
+=head2 warnings
+
+These messages warn you that for some types, the sizes calculated may not include 
+everything that could be associated with those types. The differences are usually 
+insignificant for most uses of this module.
+
+These may be disabled by setting
+
+       $Devel::Size::warn = 0
+
+=over 4
+
+=item  "Devel::Size: Calculated sizes for CVs are incomplete"
+
+=item  "Devel::Size: Calculated sizes for FMs are incomplete"
+
+=item  "Devel::Size: Calculated sizes for IOs are incomplete"
+
+=back
+
 =head1 BUGS
 
 Doesn't currently walk all the bits for code refs, formats, and

diff --git a/Size.xs b/Size.xs
old mode 100644 (file)
new mode 100755 (executable)
index dbe1878..6cc21a5
--- a/Size.xs
+++ b/Size.xs
@@ -168,7 +168,7 @@ UV thing_size(SV *orig_thing, HV *tracking_hash) {
     total_size += sizeof(XPVCV);
     total_size += magic_size(thing, tracking_hash);
     if (go_yell) {
-      carp("CV isn't complete");
+      carp("Devel::Size: Calculated sizes for CVs are incomplete");
     }
     break;
   case SVt_PVGV:
@@ -187,23 +187,76 @@ UV thing_size(SV *orig_thing, HV *tracking_hash) {
     if (GvGP(thing)) {
       if (check_new(tracking_hash, GvGP(thing))) {
        total_size += sizeof(GP);
+       {
+         SV *generic_thing;
+         if (generic_thing = (SV *)(GvGP(thing)->gp_sv)) {
+           total_size += thing_size(generic_thing, tracking_hash);
+         }
+         if (generic_thing = (SV *)(GvGP(thing)->gp_form)) {
+           total_size += thing_size(generic_thing, tracking_hash);
+         }
+         if (generic_thing = (SV *)(GvGP(thing)->gp_av)) {
+           total_size += thing_size(generic_thing, tracking_hash);
+         }
+         if (generic_thing = (SV *)(GvGP(thing)->gp_hv)) {
+           total_size += thing_size(generic_thing, tracking_hash);
+         }
+         if (generic_thing = (SV *)(GvGP(thing)->gp_egv)) {
+           total_size += thing_size(generic_thing, tracking_hash);
+         }
+         if (generic_thing = (SV *)(GvGP(thing)->gp_cv)) {
+           total_size += thing_size(generic_thing, tracking_hash);
+         }
+       }
       }
     }
     break;
   case SVt_PVFM:
     total_size += sizeof(XPVFM);
     if (go_yell) {
-      carp("FM isn't complete");
+      carp("Devel::Size: Calculated sizes for FMs are incomplete");
     }
     break;
   case SVt_PVIO:
     total_size += sizeof(XPVIO);
-    if (go_yell) {
-      carp("IO isn't complete");
+    total_size += magic_size(thing, tracking_hash);
+    if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xpv_pv)) {
+      total_size += ((XPVIO *) SvANY(thing))->xpv_cur;
     }
+    /* Some embedded char pointers */
+    if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xio_top_name)) {
+      total_size += strlen(((XPVIO *) SvANY(thing))->xio_top_name);
+    }
+    if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xio_fmt_name)) {
+      total_size += strlen(((XPVIO *) SvANY(thing))->xio_fmt_name);
+    }
+    if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xio_bottom_name)) {
+      total_size += strlen(((XPVIO *) SvANY(thing))->xio_bottom_name);
+    }
+    /* Throw the GVs on the list to be walked if they're not-null */
+    if (((XPVIO *) SvANY(thing))->xio_top_gv) {
+      total_size += thing_size((SV *)((XPVIO *) SvANY(thing))->xio_top_gv, 
+                              tracking_hash);
+    }
+    if (((XPVIO *) SvANY(thing))->xio_bottom_gv) {
+      total_size += thing_size((SV *)((XPVIO *) SvANY(thing))->xio_bottom_gv, 
+                              tracking_hash);
+    }
+    if (((XPVIO *) SvANY(thing))->xio_fmt_gv) {
+      total_size += thing_size((SV *)((XPVIO *) SvANY(thing))->xio_fmt_gv, 
+                              tracking_hash);
+    }
+
+    /* Only go trotting through the IO structures if they're really
+       trottable. If USE_PERLIO is defined we can do this. If
+       not... we can't, so we don't even try */
+#ifdef USE_PERLIO
+    /* Dig into xio_ifp and xio_ofp here */
+    croak("Devel::Size: Can't size up perlio layers yet");
+#endif
     break;
   default:
-    croak("Unknown variable type");
+    croak("Devel::Size: Unknown variable type");
   }
   return total_size;
 }

diff --git a/t/basic.t b/t/basic.t
old mode 100644 (file)
new mode 100755 (executable)
index 7bd3c10..4221cdd
--- a/t/basic.t
+++ b/t/basic.t
@@ -6,7 +6,7 @@
 # Change 1..1 below to 1..last_test_to_print .
 # (It may become useful if the test is moved to ./t subdirectory.)
 
-BEGIN { $| = 1; print "1..7\n"; }
+BEGIN { $| = 1; print "1..8\n"; }
 END {print "not ok 1\n" unless $loaded;}
 use Devel::Size qw(size total_size);
 $loaded = 1;
@@ -18,6 +18,10 @@ print "ok 1\n";
 # (correspondingly "not ok 13") depending on the success of chunk 13
 # of the test code):
 
+use vars qw($foo @foo %foo);
+$foo = "12";
+@foo = (1,2,3);
+%foo = (a => 1, b => 2);
 
 my $x = "A string";
 my $y = "A longer string";
@@ -70,3 +74,8 @@ if( total_size($c1) == total_size($c2) ) {
     print "not ok 7\n";
 }
 
+if (total_size(*foo)) {
+   print "ok 8\n";
+} else {
+  print "not ok 8\n";
+}