From: Dan Sugalski Date: Fri, 18 Jul 2003 16:56:24 +0000 (-0800) Subject: import Devel-Size 0.58 from CPAN X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=78dfb4e7ff2bb9a7aa897c60beb0e3579d301714;p=p5sagit%2FDevel-Size.git import Devel-Size 0.58 from CPAN git-cpan-module: Devel-Size git-cpan-version: 0.58 git-cpan-authorid: DSUGAL git-cpan-file: authors/id/D/DS/DSUGAL/Devel-Size-0.58.tar.gz --- diff --git a/Changes b/Changes index 751b540..8d56e3a 100644 --- a/Changes +++ b/Changes @@ -19,4 +19,12 @@ Revision history for Perl extension Devel::Size. - Added in tests from Ken Williams 0.56 Mon Feb 24 12:10:13 2003 - - Chopped out some C++ comments. D'oh! Version incremented for CPAN \ No newline at end of file + - Chopped out some C++ comments. D'oh! Version incremented for CPAN + +0.57 Thu Mar 20 13:21:14 2003 + - setting $Devel::Size::warn to 0 disables not complete warnings + +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 ) \ No newline at end of file diff --git a/Size.pm b/Size.pm index 3ddade8..1a86667 100644 --- a/Size.pm +++ b/Size.pm @@ -1,7 +1,7 @@ package Devel::Size; use strict; -use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD %EXPORT_TAGS); +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD %EXPORT_TAGS $warn); require Exporter; require DynaLoader; @@ -24,11 +24,11 @@ require DynaLoader; @EXPORT = qw( ); -$VERSION = '0.57'; +$VERSION = '0.58'; bootstrap Devel::Size $VERSION; -our $warn = 1; +$warn = 1; # Preloaded methods go here. diff --git a/Size.xs b/Size.xs index a2980d6..dbe1878 100644 --- a/Size.xs +++ b/Size.xs @@ -23,7 +23,7 @@ IV check_new(HV *tracking_hash, void *thing) { if (hv_exists(tracking_hash, (char *)&thing, sizeof(void *))) { return FALSE; } - hv_store(tracking_hash, (char *)&thing, sizeof(void *), &PL_sv_undef, 0); + hv_store(tracking_hash, (char *)&thing, sizeof(void *), &PL_sv_yes, 0); return TRUE; } @@ -175,12 +175,14 @@ UV thing_size(SV *orig_thing, HV *tracking_hash) { total_size += magic_size(thing, tracking_hash); total_size += sizeof(XPVGV); total_size += GvNAMELEN(thing); +#ifdef GvFILE /* Is there a file? */ if (GvFILE(thing)) { if (check_new(tracking_hash, GvFILE(thing))) { total_size += strlen(GvFILE(thing)); } } +#endif /* Is there something hanging off the glob? */ if (GvGP(thing)) { if (check_new(tracking_hash, GvGP(thing))) { @@ -223,7 +225,7 @@ CODE: /* Check warning status */ go_yell = 0; - if (NULL != (warn_flag = get_sv("Devel::Size::warn", FALSE))) { + if (NULL != (warn_flag = perl_get_sv("Devel::Size::warn", FALSE))) { go_yell = SvIV(warn_flag); } @@ -262,7 +264,7 @@ CODE: /* Check warning status */ go_yell = 0; - if (NULL != (warn_flag = get_sv("Devel::Size::warn", FALSE))) { + if (NULL != (warn_flag = perl_get_sv("Devel::Size::warn", FALSE))) { go_yell = SvIV(warn_flag); } diff --git a/t/basic.t b/t/basic.t index 05bdc6a..7bd3c10 100644 --- 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..5\n"; } +BEGIN { $| = 1; print "1..7\n"; } END {print "not ok 1\n" unless $loaded;} use Devel::Size qw(size total_size); $loaded = 1; @@ -48,3 +48,25 @@ if (total_size(\@x) < total_size(\@y)) { print "not ok 5\n"; } +# check that the tracking_hash is working + +my($a,$b) = (1,2); +my @ary1 = (\$a, \$a); +my @ary2 = (\$a, \$b); + +if (total_size(\@ary1) < total_size(\@ary2)) { + print "ok 6\n"; +} else { + print "not ok 6\n"; +} + +# check that circular references don't mess things up + +my($c1,$c2); $c2 = \$c1; $c1 = \$c2; + +if( total_size($c1) == total_size($c2) ) { + print "ok 7\n"; +} else { + print "not ok 7\n"; +} +