diff options
author | rillig <rillig@pkgsrc.org> | 2006-09-18 10:07:21 +0000 |
---|---|---|
committer | rillig <rillig@pkgsrc.org> | 2006-09-18 10:07:21 +0000 |
commit | 37bab7e716635ba9015935ca6d11c292fda44980 (patch) | |
tree | 2409d71ad304f672275e49b1a7ee8c1a5cd0f2fa /pkgtools | |
parent | 6414c4e31b5ca2b8c7c1cfe9d66e8da1e37fa775 (diff) | |
download | pkgsrc-37bab7e716635ba9015935ca6d11c292fda44980.tar.gz |
Fixed a huge memory leak in pkglint. Checking the complete pkgsrc tree
took about 300 MB of memory. Now it takes 27 MB, which is still much,
but quite better.
The cause for the memory leak was that I wrote
my ($result) = @_;
instead of
my ($result) = ($1);
after successfully matching a regular expression. That way, pkglint
created some cyclic data structures, and since Perl does not have
garbage collection, these didn't get cleaned up.
Added some checks so that this cannot easily happen again. Also fixed
some other instances where @_ appeared in the source code.
Diffstat (limited to 'pkgtools')
-rw-r--r-- | pkgtools/pkglint/files/pkglint.pl | 27 |
1 files changed, 21 insertions, 6 deletions
diff --git a/pkgtools/pkglint/files/pkglint.pl b/pkgtools/pkglint/files/pkglint.pl index 769c078076c..8da1659e817 100644 --- a/pkgtools/pkglint/files/pkglint.pl +++ b/pkgtools/pkglint/files/pkglint.pl @@ -1,5 +1,5 @@ #! @PERL@ -# $NetBSD: pkglint.pl,v 1.674 2006/09/15 12:31:49 rillig Exp $ +# $NetBSD: pkglint.pl,v 1.675 2006/09/18 10:07:21 rillig Exp $ # # pkglint - static analyzer and checker for pkgsrc packages @@ -516,6 +516,21 @@ sub get($$) { sub set($$$) { my ($self, $name, $value) = @_; assert(!exists($self->[EXTRA]->{$name}), "Field ${name} already exists."); + + # Make sure that the line does not become a cyclic data structure. + my $type = ref($value); + if ($type eq "") { + # ok + } elsif ($type eq "ARRAY") { + foreach my $element (@{$value}) { + my $element_type = ref($element); + assert($element_type eq "" || $element_type eq "PkgLint::SimpleMatch", + "Invalid array data type: name=${name}, type=${element_type}."); + } + } else { + assert(false, "Invalid data: name=${name}, value=${value}."); + } + $self->[EXTRA]->{$name} = $value; } @@ -984,7 +999,7 @@ sub get_logical_line($$$) { sub load_lines($$) { my ($fname, $fold_backslash_lines) = @_; - my ($physlines, $seen_newline, $loglines) = @_; + my ($physlines, $seen_newline, $loglines); $physlines = load_physical_lines($fname); if (!$physlines) { @@ -1077,7 +1092,7 @@ sub get_folded_string($$$) { sub load_strings($$) { my ($fname, $fold_backslash_lines) = @_; - my ($physlines, $seen_newline, $strings) = @_; + my ($physlines, $seen_newline, $strings); $physlines = load_physical_lines($fname); if (!$physlines) { @@ -3253,7 +3268,7 @@ sub parseline_mk($) { defined($comment) and $line->set("comment", $comment); } elsif ($text =~ regex_mk_shellcmd) { - my ($shellcmd) = @_; + my ($shellcmd) = ($1); # Shell command lines cannot have embedded comments. $line->set("is_shellcmd", true); @@ -3266,7 +3281,7 @@ sub parseline_mk($) { } } elsif ($text =~ regex_mk_comment) { - my ($comment) = @_; + my ($comment) = ($1); $line->set("is_comment", true); $line->set("comment", $comment); @@ -3425,8 +3440,8 @@ sub readmakefile($$$$) { } sub load_package_Makefile($$$) { - my ($subr) = "load_package_Makefile"; my ($fname, $ref_whole, $ref_lines) = @_; + my ($subr) = "load_package_Makefile"; my ($whole, $lines, $all_lines); $opt_debug_trace and log_debug($fname, NO_LINES, "load_package_Makefile()"); |