in reply to Help Diagnosing Memory Leak

In case you are thinking it might be in the calling code, I used it exactly as the file handle example.

Not so friendly. I knocked together the following from your two posts:

#! perl -slw
use strict;
use List::Util 'first';

sub gen_merger {
    my( $list, $fetch, $compare, $finish ) = @_;
    my @item = map $fetch->($_), @$list;

    my $done;
    return sub {
        return $finish if $done;
        my $idx  = first{ $item[ $_ ] ne $finish } 0 .. $#item;
        my $next = $item[ $idx ];
        for( $idx + 1 .. $#item ) {
            next if $item[ $_ ] eq $finish;
            my $result = $compare->( $next, $item[$_] );
            #$next = $item[$_] if $result == 1;
            # Need to keep track of which one we use not just value

            ( $idx, $next ) = ( $_, $item[$_] ) if $result == 1;
        }
        $item[ $idx ] = $fetch->( $list->[ $idx ] );
        #$done = 1 if ! first {$item[$_] ne $finish} $idx .. $#item;
        # First element of array is 0 so use defined instead of truth
        $done = 1 if ! defined first {$item[$_] ne $finish} $idx .. $#
+item;
        return $next;
    };
}

my $finish   = 'A val that is guaranteed not to be present in any list
+';
my @list;

open $list[ $_-1 ], '<', "file$_" or die $! for 1 .. 9;

my $fetch    = sub {
    my $fh = shift @_;
    return $finish if eof $fh;
    return scalar <$fh>;
};

my $compare  = sub {
    my( $line1, $line2) = @_;
    my( $stamp1 ) = $line1 =~ /^(\d+)/;
    my( $stamp2 ) = $line2 =~ /^(\d+)/;
    return $stamp1 <=> $stamp2;
};

my $next = gen_merger( \@list, $fetch, $compare, $finish );

while( 1 ) {
    my $item = $next->();
    last if defined $item && $item eq $finish;
    printf "$item";
}

[download]

Gen'd 9 sorted files of 100,000 integers each, and merged them:  C:\test\890799>..\890799 >merged. The merge completed successfully and correctly and used a rock steady 3.1MB from start to finish.

There is something in your calling code that is different from your old post.

Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.

Replies are listed 'Best First'.
Re^2: Help Diagnosing Memory Leak
by Limbic~Region (Chancellor) on Mar 02, 2011 at 15:22 UTC
    BrowserUk,
    Not so friendly.

    I had already overwritten the offending code with a procedural version which is why I didn't provide it. I have however re-produced the problem below with a much less complex compare routine. I generated a file of 1 .. 100_000_000. I then split that into ten 10_000_000 line files. Then I ran perl merge.pl > source.merged and watched the memory usage continue to climb. 

    #!/usr/bin/perl
use strict;
use warnings;
use List::Util 'first';

my $finish = 'The end is near';

my @list;
for (glob('source_part_??')) {
    open(my $fh, '<', $_) or die "Unable to open '$_' for reading: $!"
+;
    push @list, $fh;
}

my $fetch = sub {
    my ($fh) = @_;
    return $finish if eof $fh;
    return scalar <$fh>;
};

my $compare = sub {$_[0] <=> $_[1]};

my $next = gen_merger(\@list, $fetch, $compare, $finish);
while (1) {
    my $item = $next->();
    last if defined $item && $item eq $finish;
    print "$item\n";
}

sub gen_merger {
    my ($list, $fetch, $compare, $finish) = @_;
    my @item = map $fetch->($_), @$list;

    my $done;
    return sub {
        return $finish if $done;
        my $idx = first {$item[$_] ne $finish} 0 .. $#item;
        my $next = $item[$idx];
        for ($idx + 1 .. $#item) {
            next if $item[$_] eq $finish;
            my $result = $compare->($next, $item[$_]);
            ($idx, $next) = ($_, $item[$_]) if $result == 1;
        }
        $item[$idx] = $fetch->($list->[$idx]);
        $done = 1 if ! defined first {$item[$_] ne $finish} 0 .. $#ite
+m;
        return $next;
    };
}

    [download]

    Note: This version has one more bug fix in the line immediately preceding return $next. The range was changed from $idx .. $#item to 0 .. $#item.

    Cheers - L~R

[reply]
[d/l]
[select]

      Hm. I cut & pasted your code verbatim, generated a 10 x 10MB datasets and ran it.

      The result on my system is successful completion using 3.2MB.

      So, I guess we need to trade OSs and version:

      C:\test\890799>perl -MList::Util -E" say, for $^O, $], $List::Util::VE
+RSION"
MSWin32
5.010001
1.23

      [download]

      My guess is that you are using a 5.8.x version of Perl and a very old version of List::Util that had leaks associated with closures until quite late into the 5.8x line?

      Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
      "Science is about questioning the status quo. Questioning authority".
      In the absence of evidence, opinion is indistinguishable from prejudice.
[reply]
[d/l]
        BrowserUk,
        I provided OS and version of perl in the root thread but my List::Util is 1.13 so roughly September of 2003. I am glad the problem doesn't appear to be my code nor with the calling code as postulated. Thanks.

        Cheers - L~R

[reply]

In Section Seekers of Perl Wisdom