]> Sergey Matveev's repositories - public-inbox.git/blob - t/thread-cycle.t
extindex: guard against false mismatch unrefs
[public-inbox.git] / t / thread-cycle.t
1 # Copyright (C) 2016-2021 all contributors <meta@public-inbox.org>
2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
3 use strict; use v5.10.1; use PublicInbox::TestCommon;
4 use_ok('PublicInbox::SearchThread');
5 my $mt = eval {
6         require Mail::Thread;
7         no warnings 'once';
8         $Mail::Thread::nosubject = 1;
9         $Mail::Thread::noprune = 1;
10         require Email::Simple; # required by Mail::Thread (via Email::Abstract)
11 };
12
13 my $make_objs = sub {
14         my @simples;
15         my $n = 0;
16         my @msgs = map {
17                 my $msg = $_;
18                 $msg->{ds} ||= ++$n;
19                 $msg->{references} =~ s/\s+/ /sg if $msg->{references};
20                 $msg->{blob} = '0'x40; # any dummy value will do, here
21                 if ($mt) {
22                         my $simple = Email::Simple->create(header => [
23                                 'Message-ID' => "<$msg->{mid}>",
24                                 'References' => $msg->{references},
25                         ]);
26                         push @simples, $simple;
27                 }
28                 bless $msg, 'PublicInbox::Smsg'
29         } @_;
30         (\@simples, \@msgs);
31 };
32
33 my ($simples, $smsgs) = $make_objs->(
34 # data from t/testbox-6 in Mail::Thread 2.55:
35         { mid => '20021124145312.GA1759@nlin.net' },
36         { mid => 'slrnau448m.7l4.markj+0111@cloaked.freeserve.co.uk',
37           references => '<20021124145312.GA1759@nlin.net>',
38         },
39         { mid => '15842.10677.577458.656565@jupiter.akutech-local.de',
40           references => '<20021124145312.GA1759@nlin.net>
41                         <slrnau448m.7l4.markj+0111@cloaked.freeserve.co.uk>',
42         },
43         { mid => '20021125171807.GK8236@somanetworks.com',
44           references => '<20021124145312.GA1759@nlin.net>
45                         <slrnau448m.7l4.markj+0111@cloaked.freeserve.co.uk>
46                         <15842.10677.577458.656565@jupiter.akutech-local.de>',
47         },
48         { mid => '15843.12163.554914.469248@jupiter.akutech-local.de',
49           references => '<20021124145312.GA1759@nlin.net>
50                         <slrnau448m.7l4.markj+0111@cloaked.freeserve.co.uk>
51                         <15842.10677.577458.656565@jupiter.akutech-local.de>
52                         <E18GPHf-0000zp-00@cloaked.freeserve.co.uk>',
53         },
54         { mid => 'E18GPHf-0000zp-00@cloaked.freeserve.co.uk',
55           references => '<20021124145312.GA1759@nlin.net>
56                         <slrnau448m.7l4.markj+0111@cloaked.freeserve.co.uk>
57                         <15842.10677.577458.656565@jupiter.akutech-local.de>'
58         }
59 );
60
61 my $st = thread_to_s($smsgs);
62
63 SKIP: {
64         skip 'Mail::Thread missing', 1 unless $mt;
65         check_mt($st, $simples, 'Mail::Thread output matches');
66 }
67
68 my @backwards = (
69         { mid => 1, references => '<2> <3> <4>' },
70         { mid => 4, references => '<2> <3>' },
71         { mid => 5, references => '<6> <7> <8> <3> <2>' },
72         { mid => 9, references => '<6> <3>' },
73         { mid => 10, references => '<8> <7> <6>' },
74         { mid => 2, references => '<6> <7> <8> <3>' },
75         { mid => 3, references => '<6> <7> <8>' },
76         { mid => 6, references => '<8> <7>' },
77         { mid => 7, references => '<8>' },
78         { mid => 8, references => '' }
79 );
80
81 ($simples, $smsgs) = $make_objs->(@backwards);
82 my $backward = thread_to_s($smsgs);
83 SKIP: {
84         skip 'Mail::Thread missing', 1 unless $mt;
85         check_mt($backward, $simples, 'matches Mail::Thread backwards');
86 }
87 ($simples, $smsgs) = $make_objs->(reverse @backwards);
88 my $forward = thread_to_s($smsgs);
89 unless ('Mail::Thread sorts by Date') {
90         SKIP: {
91                 skip 'Mail::Thread missing', 1 unless $mt;
92                 check_mt($forward, $simples, 'matches Mail::Thread forwards');
93         }
94 }
95 if ('sorting by Date') {
96         is("\n".$backward, "\n".$forward, 'forward and backward matches');
97 }
98
99 SKIP: {
100         require_mods 'Devel::Cycle', 1;
101         Devel::Cycle->import('find_cycle');
102         my @dup = (
103                 { mid => 5, references => '<6>' },
104                 { mid => 5, references => '<6> <1>' },
105         );
106         open my $fh, '+>', \(my $out = '') or xbail "open: $!";
107         (undef, $smsgs) = $make_objs->(@dup);
108         eval 'package EmptyInbox; sub smsg_by_mid { undef }';
109         my $ctx = { ibx => bless {}, 'EmptyInbox' };
110         my $rootset = PublicInbox::SearchThread::thread($smsgs, sub {
111                 [ sort { $a->{mid} cmp $b->{mid} } @{$_[0]} ] }, $ctx);
112         my $oldout = select $fh;
113         find_cycle($rootset);
114         select $oldout;
115         is($out, '', 'nothing from find_cycle');
116 } # Devel::Cycle check
117
118 done_testing;
119
120 sub thread_to_s {
121         my ($msgs) = @_;
122         my $rootset = PublicInbox::SearchThread::thread($msgs, sub {
123                 [ sort { $a->{mid} cmp $b->{mid} } @{$_[0]} ] });
124         my $st = '';
125         my @q = map { (0, $_) } @$rootset;
126         while (@q) {
127                 my $level = shift @q;
128                 my $node = shift @q or next;
129                 $st .= (" "x$level). "$node->{mid}\n";
130                 my $cl = $level + 1;
131                 unshift @q, map { ($cl, $_) } @{$node->{children}};
132         }
133         $st;
134 }
135
136 sub check_mt {
137         my ($st, $simples, $msg) = @_;
138         my $mt = Mail::Thread->new(@$simples);
139         $mt->thread;
140         $mt->order(sub { sort { $a->messageid cmp $b->messageid } @_ });
141         my $check = '';
142         my @q = map { (0, $_) } $mt->rootset;
143         while (@q) {
144                 my $level = shift @q;
145                 my $node = shift @q or next;
146                 $check .= (" "x$level) . $node->messageid . "\n";
147                 unshift @q, $level + 1, $node->child, $level, $node->next;
148         }
149         is("\n".$check, "\n".$st, $msg);
150 }