]> Sergey Matveev's repositories - public-inbox.git/commitdiff
thread: avoid Perl5 internal scratchpad target cache
authorEric Wong <e@80x24.org>
Sun, 24 Oct 2021 00:20:44 +0000 (18:20 -0600)
committerEric Wong <e@80x24.org>
Sun, 24 Oct 2021 02:20:33 +0000 (02:20 +0000)
The use of array-returning built-ins such as `grep' inside
arrayref declarations appears to result in permanently allocated
scratchpad space for caching according to my malloc inspector.

Thread skeletons get discarded every response, but multiple
skeletons can exist in memory at once, so do what we can to
prevent long-lived allocations from being made, here.

In other words, replacing constructs such as:

my $foo = [ grep(...) ];

with:

my @foo = grep(...);

Seems to ensure the mortality of the underlying array.

lib/PublicInbox/SearchThread.pm
lib/PublicInbox/SearchView.pm
lib/PublicInbox/View.pm
t/thread-cycle.t

index 507f25baab0e04760b3e55c57f116d6a958246a6..f07dd69665623985461df30166cd0c148b4fe7f8 100644 (file)
@@ -83,15 +83,15 @@ sub thread {
                }
        }
        my $ibx = $ctx->{ibx};
-       my $rootset = [ grep { # n.b.: delete prevents cyclic refs
+       my @rootset = grep { # n.b.: delete prevents cyclic refs
                        !delete($_->{parent}) && $_->visible($ibx)
-               } values %id_table ];
-       $rootset = $ordersub->($rootset);
-       $_->order_children($ordersub, $ctx) for @$rootset;
+               } values %id_table;
+       $ordersub->(\@rootset);
+       $_->order_children($ordersub, $ctx) for @rootset;
 
        # parent imposter messages with reused Message-IDs
        unshift(@{$id_table{$_->{mid}}->{children}}, $_) for @imposters;
-       $rootset;
+       \@rootset;
 }
 
 package PublicInbox::SearchThread::Msg;
@@ -172,12 +172,12 @@ sub order_children {
        my @q = ($cur);
        my $ibx = $ctx->{ibx};
        while (defined($cur = shift @q)) {
-               my $c = $cur->{children}; # The hashref here...
-
-               $c = [ grep { !$seen{$_}++ && visible($_, $ibx) } values %$c ];
-               $c = $ordersub->($c) if scalar @$c > 1;
-               $cur->{children} = $c; # ...becomes an arrayref
-               push @q, @$c;
+               # the {children} hashref here...
+               my @c = grep { !$seen{$_}++ && visible($_, $ibx) }
+                       values %{$cur->{children}};
+               $ordersub->(\@c) if scalar(@c) > 1;
+               $cur->{children} = \@c; # ...becomes an arrayref
+               push @q, @c;
        }
 }
 
index a42867c5f577aee444eeacb2681b538dca717dd2..b1cdb480d75d2ef97a76d024ab95ad8736f85f52 100644 (file)
@@ -274,10 +274,10 @@ sub search_nav_bot { # also used by WwwListing for searching extindex miscidx
 }
 
 sub sort_relevance {
-       [ sort {
+       @{$_[0]} = sort {
                (eval { $b->topmost->{pct} } // 0) <=>
                (eval { $a->topmost->{pct} } // 0)
-       } @{$_[0]} ]
+       } @{$_[0]};
 }
 
 sub mset_thread {
index 116aa6418c4404475913b740f8ad373924077b8c..2e9cf7054243897ea0eb84c7d654f9d0add6906d 100644 (file)
@@ -1073,10 +1073,10 @@ sub _skel_ghost {
 }
 
 sub sort_ds {
-       [ sort {
+       @{$_[0]} = sort {
                (eval { $a->topmost->{ds} } || 0) <=>
                (eval { $b->topmost->{ds} } || 0)
-       } @{$_[0]} ];
+       } @{$_[0]};
 }
 
 # accumulate recent topics if search is supported
index e89b18464a5f55335c63320b33e9c172e65f3f79..1e5dfb51ab47a2865f9ab7835eda154291a5e65e 100644 (file)
@@ -108,7 +108,7 @@ SKIP: {
        eval 'package EmptyInbox; sub smsg_by_mid { undef }';
        my $ctx = { ibx => bless {}, 'EmptyInbox' };
        my $rootset = PublicInbox::SearchThread::thread($smsgs, sub {
-               [ sort { $a->{mid} cmp $b->{mid} } @{$_[0]} ] }, $ctx);
+               @{$_[0]} = sort { $a->{mid} cmp $b->{mid} } @{$_[0]} }, $ctx);
        my $oldout = select $fh;
        find_cycle($rootset);
        select $oldout;
@@ -120,7 +120,7 @@ done_testing;
 sub thread_to_s {
        my ($msgs) = @_;
        my $rootset = PublicInbox::SearchThread::thread($msgs, sub {
-               [ sort { $a->{mid} cmp $b->{mid} } @{$_[0]} ] });
+               @{$_[0]} = sort { $a->{mid} cmp $b->{mid} } @{$_[0]} });
        my $st = '';
        my @q = map { (0, $_) } @$rootset;
        while (@q) {