r19797 - in /trunk/libdevel-leak-perl: ./ Leak.pm Leak.xs MANIFEST MANIFEST.SKIP Makefile.PL README debian/ debian/changelog debian/compat debian/control debian/copyright debian/rules debian/watch t/ t/basic.t typemap
efaistos-guest at users.alioth.debian.org
efaistos-guest at users.alioth.debian.org
Fri May 9 16:27:15 UTC 2008
Author: efaistos-guest
Date: Fri May 9 16:27:14 2008
New Revision: 19797
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=19797
Log:
[svn-inject] Installing original source of libdevel-leak-perl
Added:
trunk/libdevel-leak-perl/
trunk/libdevel-leak-perl/Leak.pm
trunk/libdevel-leak-perl/Leak.xs
trunk/libdevel-leak-perl/MANIFEST
trunk/libdevel-leak-perl/MANIFEST.SKIP
trunk/libdevel-leak-perl/Makefile.PL
trunk/libdevel-leak-perl/README
trunk/libdevel-leak-perl/debian/
trunk/libdevel-leak-perl/debian/changelog
trunk/libdevel-leak-perl/debian/compat
trunk/libdevel-leak-perl/debian/control
trunk/libdevel-leak-perl/debian/copyright
trunk/libdevel-leak-perl/debian/rules (with props)
trunk/libdevel-leak-perl/debian/watch
trunk/libdevel-leak-perl/t/
trunk/libdevel-leak-perl/t/basic.t
trunk/libdevel-leak-perl/typemap
Added: trunk/libdevel-leak-perl/Leak.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-leak-perl/Leak.pm?rev=19797&op=file
==============================================================================
--- trunk/libdevel-leak-perl/Leak.pm (added)
+++ trunk/libdevel-leak-perl/Leak.pm Fri May 9 16:27:14 2008
@@ -1,0 +1,61 @@
+package 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<NoteSV> and C<CheckSV>.
+
+C<NoteSV> 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<CheckSV> is passed argument which holds a pointer to a table created by
+C<NoteSV>. It re-walks the perl-internals and calls sv_dump() for any "things"
+which did not exist when C<NoteSV> 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<have> been created, C<CheckSV> 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 <nick at ni-s.u-net.com>
+
+=cut
+
Added: trunk/libdevel-leak-perl/Leak.xs
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-leak-perl/Leak.xs?rev=19797&op=file
==============================================================================
--- trunk/libdevel-leak-perl/Leak.xs (added)
+++ trunk/libdevel-leak-perl/Leak.xs Fri May 9 16:27:14 2008
@@ -1,0 +1,218 @@
+/*
+ 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 <EXTERN.h>
+#include <perl.h>
+#include <XSUB.h>
+
+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()
+
+
Added: trunk/libdevel-leak-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-leak-perl/MANIFEST?rev=19797&op=file
==============================================================================
--- trunk/libdevel-leak-perl/MANIFEST (added)
+++ trunk/libdevel-leak-perl/MANIFEST Fri May 9 16:27:14 2008
@@ -1,0 +1,8 @@
+Leak.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
Added: trunk/libdevel-leak-perl/MANIFEST.SKIP
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-leak-perl/MANIFEST.SKIP?rev=19797&op=file
==============================================================================
--- trunk/libdevel-leak-perl/MANIFEST.SKIP (added)
+++ trunk/libdevel-leak-perl/MANIFEST.SKIP Fri May 9 16:27:14 2008
@@ -1,0 +1,4 @@
+\bblib\b
+%$
+\.(bak|old|o|c|bs|gz)$
+\b(pm_to_blib|Makefile)$
Added: trunk/libdevel-leak-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-leak-perl/Makefile.PL?rev=19797&op=file
==============================================================================
--- trunk/libdevel-leak-perl/Makefile.PL (added)
+++ trunk/libdevel-leak-perl/Makefile.PL Fri May 9 16:27:14 2008
@@ -1,0 +1,15 @@
+use 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'
+);
+
Added: trunk/libdevel-leak-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-leak-perl/README?rev=19797&op=file
==============================================================================
--- trunk/libdevel-leak-perl/README (added)
+++ trunk/libdevel-leak-perl/README Fri May 9 16:27:14 2008
@@ -1,0 +1,15 @@
+Copyright (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.
Added: trunk/libdevel-leak-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-leak-perl/debian/changelog?rev=19797&op=file
==============================================================================
--- trunk/libdevel-leak-perl/debian/changelog (added)
+++ trunk/libdevel-leak-perl/debian/changelog Fri May 9 16:27:14 2008
@@ -1,0 +1,5 @@
+libdevel-leak-perl (0.03-1) unstable; urgency=low
+
+ * Initial Release.
+
+ -- Edi Stojicevic <estojicevic at debianworld.org> Fri, 09 May 2008 15:49:19 +0100
Added: trunk/libdevel-leak-perl/debian/compat
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-leak-perl/debian/compat?rev=19797&op=file
==============================================================================
--- trunk/libdevel-leak-perl/debian/compat (added)
+++ trunk/libdevel-leak-perl/debian/compat Fri May 9 16:27:14 2008
@@ -1,0 +1,1 @@
+5
Added: trunk/libdevel-leak-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-leak-perl/debian/control?rev=19797&op=file
==============================================================================
--- trunk/libdevel-leak-perl/debian/control (added)
+++ trunk/libdevel-leak-perl/debian/control Fri May 9 16:27:14 2008
@@ -1,0 +1,27 @@
+Source: libdevel-leak-perl
+Section: perl
+Priority: optional
+Build-Depends: debhelper (>= 5)
+Build-Depends-Indep: perl (>= 5.6.10-12)
+Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debia.org>
+Uploaders: Edi Stojicevic <estojicevic at debianworld.org>
+Standards-Version: 3.7.3
+Homepage: http://search.cpan.org/dist/Devel::Leak/
+
+Package: libdevel-leak-perl
+Architecture: all
+Depends: ${perl:Depends}, ${misc:Depends}
+Description: Utility for looking for perl objects that are not reclaimed.
+ Devel::Leak has two functions NoteSV and CheckSV.
+ .
+ NoteSV 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.
+ .
+ CheckSV is passed argument which holds a pointer to a table created by
+ NoteSV. It re-walks the perl-internals and calls sv_dump() for any "things"
+ which did not exist when NoteSV was called. It returns a count of the number
+ of "things" now allocated.
+ .
+ This description was automagically extracted from the module by dh-make-perl.
Added: trunk/libdevel-leak-perl/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-leak-perl/debian/copyright?rev=19797&op=file
==============================================================================
--- trunk/libdevel-leak-perl/debian/copyright (added)
+++ trunk/libdevel-leak-perl/debian/copyright Fri May 9 16:27:14 2008
@@ -1,0 +1,21 @@
+This is the debian package for the Devel::Leak module.
+
+Upstream author : Nick Ing-Simmons <nick at ni-s.u-net.com>.
+Upstream source location : http://search.cpan.org/dist/Devel::Leak/
+
+Licence and copyright:
+
+Copyright Nick Ing-Simmons <nick at ni-s.u-net.com>, all rights reserved.
+
+This module is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+Perl is distributed under your choice of the GNU General Public License or
+the Artistic License.
+On Debian GNU/Linux systems, the complete text of the GNU General Public License
+can be found in `/usr/share/common-licenses/GPL' and the Artistic Licence in
+`/usr/share/common-licenses/Artistic'.
+
+
+The Debian packaging is (C) 2008, Edi Stojicevic <estojicevic at debianworld.org> and
+is licensed under the same terms as the software itself (see above).
Added: trunk/libdevel-leak-perl/debian/rules
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-leak-perl/debian/rules?rev=19797&op=file
==============================================================================
--- trunk/libdevel-leak-perl/debian/rules (added)
+++ trunk/libdevel-leak-perl/debian/rules Fri May 9 16:27:14 2008
@@ -1,0 +1,60 @@
+#!/usr/bin/make -f
+# This debian/rules file is provided as a template for normal perl
+# packages. It was created by Marc Brockschmidt <marc at dch-faq.de> for
+# the Debian Perl Group (http://pkg-perl.alioth.debian.org/) but may
+# be used freely wherever it is useful.
+
+# Uncomment this to turn on verbose mode.
+#export DH_VERBOSE=1
+
+# If set to a true value then MakeMaker's prompt function will
+# always return the default without waiting for user input.
+export PERL_MM_USE_DEFAULT=1
+
+PERL ?= /usr/bin/perl
+PACKAGE = $(shell dh_listpackages)
+TMP = $(CURDIR)/debian/$(PACKAGE)
+
+build: build-stamp
+build-stamp:
+ dh_testdir
+ $(PERL) Makefile.PL INSTALLDIRS=vendor
+ $(MAKE)
+ $(MAKE) test
+ touch $@
+
+clean:
+ dh_testdir
+ dh_testroot
+ dh_clean build-stamp install-stamp
+ [ ! -f Makefile ] || $(MAKE) realclean
+
+install: install-stamp
+install-stamp: build-stamp
+ dh_testdir
+ dh_testroot
+ dh_clean -k
+ $(MAKE) install DESTDIR=$(TMP) PREFIX=/usr
+ [ ! -d $(TMP)/usr/lib/perl5 ] || \
+ rmdir --ignore-fail-on-non-empty --parents --verbose \
+ $(TMP)/usr/lib/perl5
+ touch $@
+
+binary-arch:
+# We have nothing to do here for an architecture-independent package
+
+binary-indep: build install
+ dh_testdir
+ dh_testroot
+ dh_installdocs README
+ dh_installchangelogs
+ dh_perl
+ dh_compress
+ dh_fixperms
+ dh_installdeb
+ dh_gencontrol
+ dh_md5sums
+ dh_builddeb
+
+binary: binary-indep binary-arch
+.PHONY: build clean binary-indep binary-arch binary install
Propchange: trunk/libdevel-leak-perl/debian/rules
------------------------------------------------------------------------------
svn:executable =
Added: trunk/libdevel-leak-perl/debian/watch
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-leak-perl/debian/watch?rev=19797&op=file
==============================================================================
--- trunk/libdevel-leak-perl/debian/watch (added)
+++ trunk/libdevel-leak-perl/debian/watch Fri May 9 16:27:14 2008
@@ -1,0 +1,4 @@
+# format version number, currently 3; this line is compulsory!
+version=3
+# URL to the package page followed by a regex to search
+http://search.cpan.org/dist/Devel::Leak/ .*/Devel::Leak-v?(\d[\d_.-]+)\.(?:tar(?:\.gz|\.bz2)?|tgz|zip)$
Added: trunk/libdevel-leak-perl/t/basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-leak-perl/t/basic.t?rev=19797&op=file
==============================================================================
--- trunk/libdevel-leak-perl/t/basic.t (added)
+++ trunk/libdevel-leak-perl/t/basic.t Fri May 9 16:27:14 2008
@@ -1,0 +1,16 @@
+use Test;
+plan test => 3;
+eval { require Devel::Leak };
+ok($@, "", "loading module");
+eval { import Devel::Leak };
+ok($@, "", "running import");
+ at 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");
+
Added: trunk/libdevel-leak-perl/typemap
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-leak-perl/typemap?rev=19797&op=file
==============================================================================
--- trunk/libdevel-leak-perl/typemap (added)
+++ trunk/libdevel-leak-perl/typemap Fri May 9 16:27:14 2008
@@ -1,0 +1,2 @@
+hash_ptr * T_PTR
+
More information about the Pkg-perl-cvs-commits
mailing list