From: Eric Wong Date: Sun, 24 Oct 2021 00:20:44 +0000 (-0600) Subject: thread: avoid Perl5 internal scratchpad target cache X-Git-Tag: v1.7.0~65 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=08b543eb6c67cc19ea8e86afe6b9494df79e2fea;p=thirdparty%2Fpublic-inbox.git thread: avoid Perl5 internal scratchpad target cache 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. --- diff --git a/lib/PublicInbox/SearchThread.pm b/lib/PublicInbox/SearchThread.pm index 507f25baa..f07dd6966 100644 --- a/lib/PublicInbox/SearchThread.pm +++ b/lib/PublicInbox/SearchThread.pm @@ -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; } } diff --git a/lib/PublicInbox/SearchView.pm b/lib/PublicInbox/SearchView.pm index a42867c5f..b1cdb480d 100644 --- a/lib/PublicInbox/SearchView.pm +++ b/lib/PublicInbox/SearchView.pm @@ -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 { diff --git a/lib/PublicInbox/View.pm b/lib/PublicInbox/View.pm index 116aa6418..2e9cf7054 100644 --- a/lib/PublicInbox/View.pm +++ b/lib/PublicInbox/View.pm @@ -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 diff --git a/t/thread-cycle.t b/t/thread-cycle.t index e89b18464..1e5dfb51a 100644 --- a/t/thread-cycle.t +++ b/t/thread-cycle.t @@ -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) {