| Subject: | memory leaks |
Hello,
I found that Perl-RPM suffers memory leaks.
Even opening RPM database introduces a leak:
$ perl -MRPM::Database -e 'RPM::Database->new while 1'
Now you can launch top(1) and see ever increasing memory usage.
Thanks to Devel::Leak, I think I managed to fix some leaks.
The patch is attached.
$ lsdiff perl-RPM-0.40-alt-fix-memleaks.patch
Perl-RPM-0.40/t/09_leaks.t
Perl-RPM-0.40/RPM/Database.xs
Perl-RPM-0.40/RPM/Header.xs
Perl-RPM-0.40/typemap
$
Note that I also disabled database cache (dbstruct->storage). This is
because quering a lot of packages (and some algorithms may want to query
each package in the database) makes the whole database to be cached into
memory. After all, Berkeley DB seems to have its own caching
algorithms.
Even with this, 09_leaks.t takes more than 100M to run. So there seems
to be other leaks (or sort of caching), but hopefully not on the side of
Perl-RPM.
--
Alexey Tourbin
ALT Linux Team
--- Perl-RPM-0.40/t/09_leaks.t- 2005-04-02 19:07:11 +0400
+++ Perl-RPM-0.40/t/09_leaks.t 2005-04-02 19:11:46 +0400
@@ -0,0 +1,48 @@
+#!/usr/bin/perl
+use strict;
+use Devel::Leak;
+use Test::More tests => 8;
+
+sub test_leak (&$;$) {
+ my ($code, $descr, $maxleak) = (@_, 0);
+ my $n1 = Devel::Leak::NoteSV(my $handle);
+ $code->() for 0..3;
+ my $n2 = Devel::Leak::CheckSV($handle);
+ cmp_ok($n1 + $maxleak, '>=', $n2, $descr);
+}
+
+use RPM::Database;
+
+test1: test_leak { my $db = RPM::Database->new or die }
+ "rpmdb_TIEHASH", 1; # XXX
+
+test2: test_leak { my $db = RPM::Database->new(root => "/dev/null") }
+ "rpmdb_TIEHASH w/ invalid args (errSV set OK)", 1;
+
+test3: test_leak { my $db = RPM::Database->new or die;
+ for (0..3) { my $hdr = $$db{rpm} or die; } }
+ "rpmdb_FETCH";
+
+test4: test_leak { my $db = RPM::Database->new or die;
+ for (0..3) { my $hdr = $$db{rpm} or die;
+ for (0..3) {
+ my $name = $$hdr{NAME} or die;
+ my $summary = $$hdr{SUMMARY} or die; } } }
+ "rpmhdr_FETCH";
+
+test5: test_leak { my $db = RPM::Database->new or die;
+ for (0..3) { $db->find_by_file("/usr/bin/perl") or die; } }
+ "find_by_file";
+
+test6: test_leak { my $db = RPM::Database->new or die;
+ for (0..3) { $db->find_what_provides("libc.so.6") or die; } }
+ "find_what_provides";
+
+# expensive tests
+test7: test_leak { my $db = RPM::Database->new or die;
+ for (0..3) { $db->find_what_requires("libc.so.6") or die; } }
+ "find_what_requires";
+
+test8: test_leak { my $db = RPM::Database->new or die;
+ while (my ($k, $v) = each %$db) { die if $k eq $v; } }
+ "rpmdb_NEXTKEY";
--- Perl-RPM-0.40/RPM/Database.xs- 2002-05-10 09:53:48 +0400
+++ Perl-RPM-0.40/RPM/Database.xs 2005-04-02 19:16:53 +0400
@@ -56,8 +56,11 @@
/* The retvalp is used for the C-level rpmlib information on databases */
Newz(0, retvalp, 1, RPM_Database);
if (rpmdbOpen(root, &retvalp->dbp, mode, perms) != 0)
+ {
+ Safefree(retvalp);
/* rpm lib will have set the error already */
return (Null(RPM__Database));
+ }
else
{
retvalp->current_rec = 0;
@@ -100,11 +103,13 @@
{
name = SvPV(key, namelen);
+#if 0
/* Step 1: Check to see if this has already been requested and is
thus cached on the hash itself */
svp = hv_fetch(dbstruct->storage, (char *)name, namelen, FALSE);
if (svp && SvROK(*svp))
return newSVsv(*svp);
+#endif
offset = -1;
lasthdr = NULL;
@@ -155,14 +160,18 @@
FETCHp = rpmhdr_TIEHASH(aTHX_ "RPM::Header",
sv_2mortal(newSViv((unsigned)hdr)),
RPM_HEADER_FROM_REF | RPM_HEADER_READONLY);
+#if 0
if (name == Null(const char *))
name = SvPV(rpmhdr_FETCH(aTHX_ FETCHp,
- sv_2mortal(newSVpv("NAME", 4)),
+ sv_2mortal(newSVpvn("NAME", 4)),
Null(const char *), 0, 0), namelen);
+#endif
FETCH = sv_bless(newRV_noinc((SV*)FETCHp),
gv_stashpv("RPM::Header", TRUE));
+#if 0
hv_store(dbstruct->storage, (char *)name, namelen, newSVsv(FETCH),
FALSE);
+#endif
}
rpmdbFreeIterator(mi);
@@ -173,7 +182,7 @@
{
SV* tmp;
- tmp = rpmdb_FETCH(aTHX_ self, key);
+ tmp = sv_2mortal(rpmdb_FETCH(aTHX_ self, key));
return (tmp != &PL_sv_undef);
}
@@ -194,14 +203,14 @@
Header h;
if (dbstruct->offsets)
- free(dbstruct->offsets);
+ free(dbstruct->offsets); /* realloc */
dbstruct->offsets = NULL;
dbstruct->noffs = 0;
mi = rpmdbInitIterator(dbstruct->dbp, RPMDBI_PACKAGES, NULL, 0);
while ((h = rpmdbNextIterator(mi)) != NULL)
{
dbstruct->noffs++;
- dbstruct->offsets =
+ dbstruct->offsets = /* XXX realloc? */
realloc(dbstruct->offsets,
dbstruct->noffs * sizeof(dbstruct->offsets[0]));
dbstruct->offsets[dbstruct->noffs-1] = rpmdbGetIteratorOffset(mi);
@@ -215,8 +224,8 @@
dbstruct->offx = 0;
dbstruct->current_rec = dbstruct->offsets[dbstruct->offx++];
- *value = rpmdb_FETCH(aTHX_ self, newSViv(dbstruct->current_rec));
- *key = rpmhdr_FETCH(aTHX_ (RPM__Header)SvRV(*value), newSVpv("name", 4),
+ *value = rpmdb_FETCH(aTHX_ self, sv_2mortal(newSViv(dbstruct->current_rec)));
+ *key = rpmhdr_FETCH(aTHX_ (RPM__Header)SvRV(*value), sv_2mortal(newSVpvn("name", 4)),
Nullch, 0, 0);
return 1;
@@ -236,9 +245,9 @@
dbstruct->current_rec = dbstruct->offsets[dbstruct->offx++];
- *nextvalue = rpmdb_FETCH(aTHX_ self, newSViv(dbstruct->current_rec));
+ *nextvalue = rpmdb_FETCH(aTHX_ self, sv_2mortal(newSViv(dbstruct->current_rec)));
*nextkey = rpmhdr_FETCH(aTHX_ (RPM__Header)SvRV(*nextvalue),
- newSVpv("name", 4), Nullch, 0, 0);
+ sv_2mortal(newSVpvn("name", 4)), Nullch, 0, 0);
return 1;
}
@@ -251,11 +260,13 @@
rpmdbClose(dbstruct->dbp);
if (dbstruct->offsets)
- Safefree(dbstruct->offsets);
+ free(dbstruct->offsets); /* realloc */
hv_undef(dbstruct->storage);
+ sv_free((SV*) dbstruct->storage);
Safefree(dbstruct);
- hv_undef(self);
+/* CLEAR: operation not permitted
+ hv_undef(self); */
}
int rpmdb_init(SV* class, const char* root, int perms)
@@ -312,7 +323,7 @@
{
idx = rpmdbGetIteratorOffset(mi);
tmp_hdr = rpmdb_FETCH(aTHX_ self, sv_2mortal(newSViv(idx)));
- av_store(return_val, loop++, sv_2mortal(newSVsv(tmp_hdr)));
+ av_store(return_val, loop++, newSVsv(sv_2mortal(tmp_hdr)));
}
}
rpmdbFreeIterator(mi);
@@ -410,7 +421,7 @@
EXTEND(SP, 2);
PUSHs(sv_2mortal(value));
- PUSHs(sv_2mortal(newSVsv(key)));
+ PUSHs(sv_2mortal(key));
}
void
@@ -431,7 +442,7 @@
EXTEND(SP, 2);
PUSHs(sv_2mortal(nextvalue));
- PUSHs(sv_2mortal(newSVsv(nextkey)));
+ PUSHs(sv_2mortal(nextkey));
}
void
@@ -503,5 +514,7 @@
else
size = 0;
+ av_undef(matches);
+ sv_free((SV*) matches);
XSRETURN(size);
}
--- Perl-RPM-0.40/RPM/Header.xs- 2002-05-10 11:37:08 +0400
+++ Perl-RPM-0.40/RPM/Header.xs 2005-04-02 18:39:16 +0400
@@ -203,6 +203,7 @@
{
new_item = newSVsv(*av_fetch(new_list, 0, FALSE));
av_undef(new_list);
+ sv_free((SV *) new_list);
}
else
new_item = newRV_noinc((SV *)new_list);
@@ -368,6 +370,8 @@
return FETCH;
}
+ sv_free(FETCH);
+
/* Check the three keys that are cached directly on the struct itself: */
if (! strcmp(uc_name, "NAME"))
FETCH = newSVpv((char *)hdr->name, 0);
@@ -409,6 +413,7 @@
"RPM::Header::FETCH: no tag '%s' in header", uc_name);
rpm_error(aTHX_ RPMERR_BADARG, errmsg);
Safefree(uc_name);
+ FETCH = newSVsv(&PL_sv_undef);
return FETCH;
}
FETCH = rpmhdr_create(aTHX_ new_item_p, new_item_type, size,
@@ -954,10 +959,12 @@
headerFree(hdr->hdr);
hv_undef(hdr->storage);
+ sv_free((SV *) hdr->storage);
if (hdr->source_name)
Safefree(hdr->source_name);
Safefree(hdr);
- hv_undef(self);
+/* CLEAR: operation not permitted
+ hv_undef(self); */
}
unsigned int rpmhdr_size(pTHX_ RPM__Header self)
@@ -1382,10 +1389,9 @@
snprintf(errmsg, 256,
"RPM::Header::scalar_tag: unknown tag %s", uc_name);
rpm_error(aTHX_ RPMERR_BADARG, errmsg);
- Safefree(uc_name);
RETVAL = 0;
}
-
+ Safefree(uc_name);
RETVAL = scalar_tag(aTHX_ self, tag_value);
}
}
--- Perl-RPM-0.40/typemap- 2000-11-10 11:49:57 +0300
+++ Perl-RPM-0.40/typemap 2005-04-02 15:16:17 +0400
@@ -18,7 +18,7 @@
}
else
{
- $arg = newSVsv(&PL_sv_undef);
+ $arg = &PL_sv_undef;
}
O_RPM_Blessed
@@ -29,7 +29,7 @@
}
else
{
- $arg = newSVsv(&PL_sv_undef);
+ $arg = &PL_sv_undef;
}
INPUT
@@ -54,4 +54,4 @@
rpm_error(aTHX_ RPMERR_BADARG,
\"$var is not of type ${ntype}\");
XSRETURN_UNDEF;
- }
\ No newline at end of file
+ }