perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From doomgrinder ...@maz.org>
Subject Re: cvs commit: modperl/Leak Leak.pm Leak.xs Makefile.PL typemap
Date Sat, 07 Nov 1998 18:01:32 GMT

YAY!@#$@#$@#!

Scalars leaked: 1

On 6 Nov 1998 dougm@hyperreal.org wrote:

dougm> dougm       98/11/06 13:07:54
dougm> 
dougm>   Added:       Leak     Leak.pm Leak.xs Makefile.PL typemap
dougm>   Log:
dougm>   new module for tracking memory leaks
dougm>   
dougm>   Revision  Changes    Path
dougm>   1.1                  modperl/Leak/Leak.pm
dougm>   
dougm>   Index: Leak.pm
dougm>   ===================================================================
dougm>   package Apache::Leak;
dougm>   
dougm>   use strict;
dougm>   use DynaLoader ();
dougm>   use Exporter ();
dougm>   *import = \&Exporter::import;
dougm>   {
dougm>       no strict;
dougm>       @EXPORT = qw(leak_test);
dougm>       $VERSION = '1.00';
dougm>       @ISA = qw(DynaLoader);
dougm>       __PACKAGE__->bootstrap($VERSION);
dougm>   }
dougm>   
dougm>   sub LOOP_N () {2}
dougm>   
dougm>   sub leak_test (&;$$) {
dougm>       my($cv, $x, $fh) = @_;
dougm>       $x  ||= LOOP_N;
dougm>       $fh ||= \*STDERR;
dougm>       my $first = $x;
dougm>   
dougm>       while($x--) {
dougm>   	my $handle;
dougm>   	my $enter = NoteSV($handle);
dougm>   	my $leave = 0;
dougm>   	print $fh "ENTER: $enter SVs\n";
dougm>   	{
dougm>   	    $cv->();
dougm>   	}
dougm>   	$leave = CheckSV($handle);
dougm>   	print $fh "\nLEAVE: $leave SVs\n";
dougm>   	if($enter != $leave) {
dougm>   	    my $n = $leave - $enter;
dougm>   	    if($x+1 == $first) {
dougm>   	    }
dougm>   	    else {
dougm>   		print $fh "!!! $n SVs leaked !!!\n";
dougm>   	    }
dougm>   	}
dougm>       }
dougm>   }
dougm>   
dougm>   sub handler {
dougm>       my $r = shift; 
dougm>       my $uri = $r->uri;
dougm>       my $handle;
dougm>       my $count = NoteSV($handle);
dougm>       $r->push_handlers(PerlLogHandler => sub {
dougm>   	warn "Leak test for $uri:\n";
dougm>           warn "  ENTER: $count SVs\n";
dougm>           $count = CheckSV($handle);
dougm>           warn "  LEAVE: $count SVs\n";
dougm>       });
dougm>       0;
dougm>   }
dougm>   
dougm>   1;
dougm>   __END__
dougm>   
dougm>   =head1 NAME
dougm>   
dougm>   Apache::Leak - Module for tracking memory leaks in mod_perl code
dougm>   
dougm>   =head1 SYNOPSIS
dougm>   
dougm>       use Apache::Leak;
dougm>   
dougm>       leak_test {
dougm>   	my $obj = Foo->new;
dougm>   	$obj->thingy;
dougm>       };
dougm>       #now look in error_log for results
dougm>   
dougm>   =head1 DESCRIPTION
dougm>   
dougm>   "Under Construction."
dougm>   
dougm>   =head1 SEE ALSO
dougm>   
dougm>   Devel::Leak
dougm>   
dougm>   =head1 AUTHOR
dougm>   
dougm>   Doug MacEachern
dougm>   Leak.xs derived from Nick Ing-Simmons' Devel::Leak
dougm>   
dougm>   
dougm>   
dougm>   1.1                  modperl/Leak/Leak.xs
dougm>   
dougm>   Index: Leak.xs
dougm>   ===================================================================
dougm>   /*
dougm>     Copyright (c) 1995,1996-1998 Nick Ing-Simmons. All rights reserved.
dougm>     This program is free software; you can redistribute it and/or
dougm>     modify it under the same terms as Perl itself.
dougm>   */
dougm>   /*
dougm>    modified by dougm for use with 5.004_04    
dougm>    future versions may be made special for the mod_perl environment
dougm>   */
dougm>   
dougm>   #include <EXTERN.h>
dougm>   #include <perl.h>
dougm>   #include <XSUB.h>
dougm>   
dougm>   #include "patchlevel.h"
dougm>   #if ((PATCHLEVEL == 4) && (SUBVERSION <= 76))
dougm>   #define PL_sv_arenaroot sv_arenaroot
dougm>   #endif
dougm>   
dougm>   typedef long used_proc _((void *, SV *, long));
dougm>   typedef struct hash_s *hash_ptr;
dougm>   
dougm>   #define MAX_HASH 1009
dougm>   
dougm>   static hash_ptr pile = NULL;
dougm>   
dougm>   static void
dougm>   LangDumpVec(char *who, int count, SV **data)
dougm>   {
dougm>       int i;
dougm>       PerlIO_printf(PerlIO_stderr(), "%s (%d):\n", who, count);
dougm>       for (i = 0; i < count; i++)
dougm>       {
dougm>   	SV *sv = data[i];
dougm>   	if (sv) {
dougm>   	    PerlIO_printf(PerlIO_stderr(), "%2d ", i);
dougm>   	    sv_dump(sv);
dougm>   	}
dougm>       }
dougm>   }
dougm>   
dougm>   struct hash_s {
dougm>       struct hash_s *link;
dougm>       SV *sv;
dougm>       char *tag;
dougm>   };
dougm>   
dougm>   static char *lookup(hash_ptr *ht, SV *sv, void *tag)
dougm>   {
dougm>       unsigned hash = ((unsigned long) sv) % MAX_HASH;
dougm>       hash_ptr p = ht[hash];
dougm>       while (p) {
dougm>   	if (p->sv == sv) {
dougm>   	    char *old = p->tag;
dougm>   	    p->tag = tag;
dougm>   	    return old;
dougm>   	}
dougm>   	p = p->link;
dougm>       }
dougm>       if ((p = pile))
dougm>   	pile = p->link;
dougm>       else
dougm>   	p = (hash_ptr) malloc(sizeof(struct hash_s));
dougm>       p->link  = ht[hash];
dougm>       p->sv    = sv;
dougm>       p->tag   = tag;
dougm>       ht[hash] = p;
dougm>       return NULL;
dougm>   }
dougm>   
dougm>   static void check_arenas()
dougm>   {
dougm>       SV *sva;
dougm>       for (sva = PL_sv_arenaroot; sva; sva = (SV *) SvANY(sva)) {
dougm>   	SV *sv = sva + 1;
dougm>   	SV *svend = &sva[SvREFCNT(sva)];
dougm>   	while (sv < svend) {
dougm>   	    if (SvROK(sv) && ((IV) SvANY(sv)) & 1) {
dougm>   		warn("Odd SvANY for %p @ %p[%d]",sv,sva,(sv-sva));
dougm>   		abort();
dougm>   	    }
dougm>   	    ++sv;
dougm>   	}
dougm>       }
dougm>   }
dougm>   
dougm>   static long int sv_apply_to_used(void *p, used_proc *proc, long int n)
dougm>   {
dougm>       SV *sva;
dougm>       for (sva = PL_sv_arenaroot; sva; sva = (SV *) SvANY(sva)) {
dougm>   	SV *sv = sva + 1;
dougm>   	SV *svend = &sva[SvREFCNT(sva)];
dougm>   
dougm>   	while (sv < svend) {
dougm>   	    if (SvTYPE(sv) != SVTYPEMASK) {
dougm>   		n = (*proc) (p, sv, n);
dougm>   	    }
dougm>   	    ++sv;
dougm>   	}
dougm>       }
dougm>       return n;
dougm>   }
dougm>   
dougm>   static char old[] = "old";
dougm>   static char new[] = "new";
dougm>   
dougm>   static long note_sv(void *p, SV *sv, long int n) {
dougm>       lookup(p, sv, old);
dougm>       return n+1;
dougm>   }
dougm>   
dougm>   static long note_used(hash_ptr **x)
dougm>   {
dougm>       hash_ptr *ht;
dougm>       Newz(603, ht, MAX_HASH, hash_ptr);
dougm>       *x = ht;
dougm>       return sv_apply_to_used(ht, note_sv, 0);
dougm>   }
dougm>   
dougm>   static long check_sv(void *p, SV *sv, long hwm)
dougm>   {
dougm>       char *state = lookup(p,sv,new);
dougm>       if (state != old) {                           
dougm>   	fprintf(stderr, "%s %p : ", state ? state : new, sv);
dougm>   	sv_dump(sv);
dougm>       }
dougm>       return hwm+1;
dougm>   }
dougm>   
dougm>   static long check_used(hash_ptr **x) {
dougm>       hash_ptr *ht = *x;
dougm>       long count = sv_apply_to_used(ht, check_sv, 0);
dougm>       long i;
dougm>       for (i = 0; i < MAX_HASH; i++) {
dougm>   	hash_ptr p = ht[i];
dougm>   	while (p) {
dougm>   	    hash_ptr t = p;
dougm>   	    p = t->link;
dougm>   	    if (t->tag != new) {
dougm>   		LangDumpVec(t->tag ? t->tag : "NUL", 1, &t->sv);
dougm>   	    }
dougm>   	    t->link = pile;
dougm>   	    pile = t;
dougm>   	}
dougm>       }
dougm>       free(ht);
dougm>       *x = NULL;
dougm>       return count;
dougm>   }
dougm>   
dougm>   MODULE = Apache::Leak	PACKAGE = Apache::Leak
dougm>   
dougm>   PROTOTYPES: Enable
dougm>   
dougm>   IV
dougm>   NoteSV(obj)
dougm>       hash_ptr *	obj = NO_INIT
dougm>   
dougm>       CODE:
dougm>       RETVAL = note_used(&obj);
dougm>   
dougm>       OUTPUT:
dougm>       obj
dougm>       RETVAL
dougm>   
dougm>   IV
dougm>   CheckSV(obj)
dougm>       hash_ptr *	obj
dougm>   
dougm>       CODE:
dougm>       RETVAL = check_used(&obj);
dougm>   
dougm>       OUTPUT:
dougm>       RETVAL
dougm>   
dougm>   void
dougm>   check_arenas()
dougm>   
dougm>   
dougm>   
dougm>   
dougm>   
dougm>   1.1                  modperl/Leak/Makefile.PL
dougm>   
dougm>   Index: Makefile.PL
dougm>   ===================================================================
dougm>   use ExtUtils::MakeMaker;
dougm>   
dougm>   WriteMakefile(
dougm>       NAME	=> "Apache::Leak",
dougm>       VERSION_FROM => "Leak.pm",
dougm>   );
dougm>   
dougm>   
dougm>   
dougm>   
dougm>   1.1                  modperl/Leak/typemap
dougm>   
dougm>   Index: typemap
dougm>   ===================================================================
dougm>   hash_ptr *		T_PTR
dougm>   
dougm>   
dougm>   
dougm>   
dougm> 

               Brian Moseley,  Chief Suspect
     ix@maz.org  -*-  http://maz.org/  -*-  Evolve ICB


Mime
View raw message