Devel-Leak-0.03/0040755000127400001440000000000010026355510012212 5ustar nickusersDevel-Leak-0.03/t/0040755000127400001440000000000010026355510012455 5ustar nickusersDevel-Leak-0.03/t/basic.t0100444000127400001440000000057707743157137013750 0ustar nickusersuse Test; plan test => 3; eval { require Devel::Leak }; ok($@, "", "loading module"); eval { import Devel::Leak }; ok($@, "", "running import"); @somewhere = (); my $count = Devel::Leak::NoteSV($handle); print "$count SVs so far\n"; for my $i (1..10) { @somewhere = qw(one two); } my $now = Devel::Leak::CheckSV($handle); ok($now, $count+2, "Number of SVs created unexpected"); Devel-Leak-0.03/README0100444000127400001440000000063107743157137013106 0ustar nickusersCopyright (c) 1997-1998 Nick Ing-Simmons. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. This module provides a basic way to discover if a piece of perl code is allocating perl data and not releasing them again. You install this package using CPAN.pm or the normal: perl Makefile.PL make make test make install process. Devel-Leak-0.03/MANIFEST.SKIP0100444000127400001440000000007407743157137014125 0ustar nickusers\bblib\b %$ \.(bak|old|o|c|bs|gz)$ \b(pm_to_blib|Makefile)$ Devel-Leak-0.03/Makefile.PL0100444000127400001440000000054307743157137014202 0ustar nickusersuse ExtUtils::MakeMaker; use Config; unless ($Config{'ccflags'} =~ /-DDEBUGGING/) { warn "This perl is not compiled with -DDEBUGGING - functions restricted\n"; } WriteMakefile( 'NAME' => 'Devel::Leak', 'clean' => {FILES => "*% *.bak"}, 'dist' => { COMPRESS => 'gzip -f9', SUFFIX => '.gz' }, 'VERSION_FROM' => 'Leak.pm' ); Devel-Leak-0.03/Leak.pm0100644000127400001440000000302110026355437013425 0ustar nickuserspackage Devel::Leak; use 5.005; use vars qw($VERSION); require DynaLoader; use base qw(DynaLoader); $VERSION = '0.03'; bootstrap Devel::Leak; 1; __END__ =head1 NAME Devel::Leak - Utility for looking for perl objects that are not reclaimed. =head1 SYNOPSIS use Devel::Leak; ... setup code my $count = Devel::Leak::NoteSV($handle); ... code that may leak Devel::Leak::CheckSV($handle); =head1 DESCRIPTION Devel::Leak has two functions C and C. C walks the perl internal table of allocated SVs (scalar values) - (which actually contains arrays and hashes too), and records their addresses in a table. It returns a count of these "things", and stores a pointer to the table (which is obtained from the heap using malloc()) in its argument. C is passed argument which holds a pointer to a table created by C. It re-walks the perl-internals and calls sv_dump() for any "things" which did not exist when C was called. It returns a count of the number of "things" now allocated. =head1 CAVEATS Note that you need a perl built with -DDEBUGGING for sv_dump() to print anything, but counts are valid in any perl. If new "things" I been created, C may (also) report additional "things" which are allocated by the sv_dump() code. =head1 HISTORY This little utility module was part of Tk until the variable renaming in perl5.005 made it clear that Tk had no business knowing this much about the perl internals. =head1 AUTHOR Nick Ing-Simmons =cut Devel-Leak-0.03/Leak.xs0100444000127400001440000000636310026354761013454 0ustar nickusers/* Copyright (c) 1995,1996-1998 Nick Ing-Simmons. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. */ #include #include #include typedef long used_proc _((void *,SV *,long)); typedef struct hash_s *hash_ptr; #ifndef DEBUGGING #define sv_dump(sv) PerlIO_printf(PerlIO_stderr(), "\n") #endif #define MAX_HASH 1009 static hash_ptr pile = NULL; static void LangDumpVec(char *who, int count, SV **data) { int i; PerlIO_printf(PerlIO_stderr(), "%s (%d):\n", who, count); for (i = 0; i < count; i++) { SV *sv = data[i]; if (sv) { PerlIO_printf(PerlIO_stderr(), "%2d ", i); sv_dump(sv); } } } struct hash_s {struct hash_s *link; SV *sv; char *tag; }; static char * lookup(hash_ptr *ht, SV *sv, void *tag) {unsigned hash = ((unsigned long) sv) % MAX_HASH; hash_ptr p = ht[hash]; while (p) { if (p->sv == sv) {char *old = p->tag; p->tag = tag; return old; } p = p->link; } if ((p = pile)) pile = p->link; else p = (hash_ptr) malloc(sizeof(struct hash_s)); p->link = ht[hash]; p->sv = sv; p->tag = tag; ht[hash] = p; return NULL; } void check_arenas() { SV *sva; for (sva = PL_sv_arenaroot; sva; sva = (SV *) SvANY(sva)) { SV *sv = sva + 1; SV *svend = &sva[SvREFCNT(sva)]; while (sv < svend) { if (SvROK(sv) && ((IV) SvANY(sv)) & 1) { warn("Odd SvANY for %p @ %p[%d]",sv,sva,(sv-sva)); abort(); } ++sv; } } } long int sv_apply_to_used(p, proc,n) void *p; used_proc *proc; long int n; { SV *sva; for (sva = PL_sv_arenaroot; sva; sva = (SV *) SvANY(sva)) { SV *sv = sva + 1; SV *svend = &sva[SvREFCNT(sva)]; while (sv < svend) { if (SvTYPE(sv) != SVTYPEMASK) { n = (*proc) (p, sv, n); } ++sv; } } return n; } static char old[] = "old"; static char new[] = "new"; static long note_sv(p,sv, n) void *p; SV *sv; long int n; { lookup(p,sv,old); return n+1; } long note_used(hash_ptr **x) { hash_ptr *ht; Newz(603, ht, MAX_HASH, hash_ptr); *x = ht; return sv_apply_to_used(ht, note_sv, 0); } static long check_sv(void *p, SV *sv, long hwm) { char *state = lookup(p,sv,new); if (state != old) { fprintf(stderr,"%s %p : ", state ? state : new, sv); sv_dump(sv); } return hwm+1; } static long find_object(void *p, SV *sv, long count) { if (sv_isobject(sv)) { sv_dump(sv); count++; } return count; } long check_used(hash_ptr **x) {hash_ptr *ht = *x; long count = sv_apply_to_used(ht, check_sv, 0); long i; for (i = 0; i < MAX_HASH; i++) {hash_ptr p = ht[i]; while (p) { hash_ptr t = p; p = t->link; if (t->tag != new) { LangDumpVec(t->tag ? t->tag : "NUL",1,&t->sv); } t->link = pile; pile = t; } } Safefree(ht); *x = NULL; return count; } MODULE = Devel::Leak PACKAGE = Devel::Leak PROTOTYPES: Enable IV NoteSV(obj) hash_ptr * obj = NO_INIT CODE: { RETVAL = note_used(&obj); } OUTPUT: obj RETVAL IV CheckSV(obj) hash_ptr * obj CODE: { RETVAL = check_used(&obj); } OUTPUT: RETVAL IV FindObjects() CODE: { RETVAL = sv_apply_to_used(NULL, find_object, 0); } OUTPUT: RETVAL void check_arenas() Devel-Leak-0.03/typemap0100444000127400001440000000002307743157137013623 0ustar nickusershash_ptr * T_PTR Devel-Leak-0.03/MANIFEST0100444000127400001440000000041207743157137013354 0ustar nickusersLeak.pm The perl part (with the docs as pod) Leak.xs C code MANIFEST This file MANIFEST.SKIP Things to to list here Makefile.PL How to build it README Description of package t/basic.t A Basic test typemap How our C structures get stored as perl