1#!/usr/bin/perl -w
2
3use strict;
4use warnings;
5use 5.010;
6use utf8;
7use Test::More tests => 257;
8#use Test::More 'no_plan';
9use Test::NoWarnings;
10use Test::Exception;
11use Path::Class;
12use App::Sqitch;
13use App::Sqitch::Target;
14use App::Sqitch::Plan;
15use Locale::TextDomain qw(App-Sqitch);
16use Test::MockModule;
17
18$ENV{SQITCH_CONFIG}        = 'nonexistent.conf';
19$ENV{SQITCH_USER_CONFIG}   = 'nonexistent.user';
20$ENV{SQITCH_SYSTEM_CONFIG} = 'nonexistent.sys';
21
22BEGIN { require_ok 'App::Sqitch::Plan::ChangeList' or die }
23
24my $sqitch = App::Sqitch->new(options => {
25    engine => 'sqlite',
26    top_dir => dir(qw(t sql))->stringify,
27});
28my $target = App::Sqitch::Target->new(sqitch => $sqitch);
29my $plan   = App::Sqitch::Plan->new(sqitch => $sqitch, target => $target);
30
31my $foo = App::Sqitch::Plan::Change->new(plan => $plan, name => 'foo');
32my $bar = App::Sqitch::Plan::Change->new(plan => $plan, name => 'bar', parent => $foo);
33my $baz = App::Sqitch::Plan::Change->new(plan => $plan, name => 'baz', parent => $bar);
34my $yo1 = App::Sqitch::Plan::Change->new(plan => $plan, name => 'yo', parent => $baz);
35my $yo2 = App::Sqitch::Plan::Change->new(plan => $plan, name => 'yo', parent => $yo1, planner_name => 'Phil' );
36
37my $alpha = App::Sqitch::Plan::Tag->new(
38    plan   => $plan,
39    change => $yo1,
40    name   => 'alpha',
41);
42$yo1->add_tag($alpha);
43my $changes = App::Sqitch::Plan::ChangeList->new(
44    $foo,
45    $bar,
46    $yo1,
47    $baz,
48    $yo2,
49);
50
51my ($earliest_id, $latest_id);
52my $engine_mocker = Test::MockModule->new('App::Sqitch::Engine::sqlite');
53my $offset = 0;
54
55$engine_mocker->mock(earliest_change_id => sub {
56     $offset = $_[1];
57     $changes->change_at( $changes->index_of($earliest_id) + $offset )->id;
58});
59
60$engine_mocker->mock(latest_change_id => sub {
61    $offset = $_[1];
62    $changes->change_at( $changes->index_of($latest_id) - $offset )->id;
63});
64
65is $changes->count, 5, 'Count should be six';
66is_deeply [$changes->changes], [$foo, $bar, $yo1, $baz, $yo2],
67    'Changes should be in order';
68is_deeply [$changes->items], [$changes->changes],
69    'Items should be the same as changes';
70is_deeply [$changes->tags], [$alpha], 'Tags should return the one tag';
71is $changes->change_at(0), $foo, 'Should have foo at 0';
72is $changes->change_at(1), $bar, 'Should have bar at 1';
73is $changes->change_at(2), $yo1, 'Should have yo1 at 2';
74is $changes->change_at(3), $baz, 'Should have baz at 4';
75is $changes->change_at(4), $yo2, 'Should have yo2 at 5';
76
77is $changes->index_of('non'), undef, 'Should not find "non"';
78is $changes->index_of('@non'), undef, 'Should not find "@non"';
79is $changes->index_of('foo'), 0, 'Should find foo at 0';
80is $changes->index_of($foo->id), 0, 'Should find foo by ID at 0';
81is $changes->index_of($foo->old_id), 0, 'Should find foo by old ID at 0';
82is $changes->index_of('bar'), 1, 'Should find bar at 1';
83is $changes->index_of('bar^'), 0, 'Should find bar^ at 0';
84is $changes->index_of('bar~'), 2, 'Should find bar~ at 2';
85is $changes->index_of('bar~~'), 3, 'Should find bar~~ at 3';
86is $changes->index_of('bar~~~'), undef, 'Should not find bar~~~';
87is $changes->index_of('bar~2'), 3, 'Should find bar~2 at 3';
88is $changes->index_of('bar~3'), 4, 'Should find bar~3 at 4';
89is $changes->index_of($bar->id), 1, 'Should find bar by ID at 1';
90is $changes->index_of($bar->old_id), 1, 'Should find bar by old ID at 1';
91is $changes->index_of('@alpha'), 2, 'Should find @alpha at 2';
92is $changes->index_of('@alpha^'), 1, 'Should find @alpha^ at 1';
93is $changes->index_of('@alpha^^'), 0, 'Should find @alpha^^ at 1';
94is $changes->index_of('@alpha^^^'), undef, 'Should not find @alpha^^^';
95is $changes->index_of($alpha->id), 2, 'Should find @alpha by ID at 2';
96is $changes->index_of($alpha->old_id), 2, 'Should find @alpha by old ID at 2';
97is $changes->index_of('baz'), 3, 'Should find baz at 3';
98is $changes->index_of($baz->id), 3, 'Should find baz by ID at 3';
99is $changes->index_of($baz->old_id), 3, 'Should find baz by old ID at 3';
100is $changes->index_of('baz^^^'), undef, 'Should not find baz^^^';
101is $changes->index_of('baz^3'), 0, 'Should not find baz^3 at 0';
102is $changes->index_of('baz^4'), undef, 'Should not find baz^4';
103is $changes->index_of($baz->id . '^'), 2, 'Should find baz by ID^ at 2';
104is $changes->index_of($baz->old_id . '^'), 2, 'Should find baz by old ID^ at 2';
105
106throws_ok { $changes->index_of('yo') } 'App::Sqitch::X',
107    'Should get multiple indexes error looking for index of "yo"';
108is $@->ident, 'plan', 'Multiple indexes error ident should be "plan"';
109is $@->message, __x(
110    'Key {key} at multiple indexes',
111    key => 'yo',
112), 'Multiple indexes message should be correct';
113
114throws_ok { $changes->index_of('yo@howdy') } 'App::Sqitch::X',
115    'Should unknown tag error for invalid tag';
116is $@->ident, 'plan', 'Unknown tag error ident should be "plan"';
117is $@->message, __x(
118    'Unknown tag "{tag}"',
119    tag => '@howdy',
120), 'Unknown taf message should be correct';
121
122is $changes->index_of('yo@alpha'), 2, 'Should get 2 for yo@alpha';
123is $changes->index_of('yo@alpha^'), 1, 'Should get 1 for yo@alpha^';
124is $changes->index_of('yo@HEAD'), 4, 'Should get 4 for yo@HEAD';
125is $changes->index_of('yo@HEAD^'), 3, 'Should get 3 for yo@HEAD^';
126is $changes->index_of('yo@HEAD~'), undef, 'Should get undef for yo@HEAD~';
127is $changes->index_of('yo@HEAD~~'), undef, 'Should get undef for yo@HEAD~~';
128is $changes->index_of('foo@alpha'), 0, 'Should get 0 for foo@alpha';
129is $changes->index_of('foo@HEAD'), 0, 'Should get 0 for foo@HEAD';
130is $changes->index_of('foo@ROOT'), 0, 'Should get 0 for foo@ROOT';
131is $changes->index_of('baz@alpha'), undef, 'Should get undef for baz@alpha';
132is $changes->index_of('baz@HEAD'), 3, 'Should get 3 for baz@HEAD';
133is $changes->index_of('@HEAD'), 4, 'Should get 4 for @HEAD';
134is $changes->index_of('@ROOT'), 0, 'Should get 0 for @ROOT';
135is $changes->index_of('@HEAD^'), 3, 'Should get 3 for @HEAD^';
136is $changes->index_of('@HEAD~'), undef, 'Should get undef for @HEAD~';
137is $changes->index_of('@ROOT~'), 1, 'Should get 1 for @ROOT~';
138is $changes->index_of('@ROOT^'), undef, 'Should get undef for @ROOT^';
139is $changes->index_of('HEAD'), 4, 'Should get 4 for HEAD';
140is $changes->index_of('ROOT'), 0, 'Should get 0 for ROOT';
141is $changes->index_of('HEAD^'), 3, 'Should get 3 for HEAD^';
142is $changes->index_of('HEAD~'), undef, 'Should get undef for HEAD~';
143is $changes->index_of('ROOT~'), 1, 'Should get 1 for ROOT~';
144is $changes->index_of('ROOT^'), undef, 'Should get undef for ROOT^';
145
146is $changes->get('foo'), $foo, 'Should get foo for "foo"';
147is $changes->get('foo~'), $bar, 'Should get bar for "foo~"';
148is $changes->get($foo->id), $foo, 'Should get foo by ID';
149is $changes->get($foo->old_id), $foo, 'Should get foo by old ID';
150is $changes->get('bar'), $bar, 'Should get bar for "bar"';
151is $changes->get('bar^'), $foo, 'Should get foo for "bar^"';
152is $changes->get('bar~'), $yo1, 'Should get yo1 for "bar~"';
153is $changes->get('bar~~'), $baz, 'Should get baz for "bar~~"';
154is $changes->get('bar~3'), $yo2, 'Should get yo2 for "bar~3"';
155is $changes->get($bar->id), $bar, 'Should get bar by ID';
156is $changes->get($bar->old_id), $bar, 'Should get bar by old ID';
157is $changes->get($alpha->id), $yo1, 'Should get "yo" by the @alpha tag ID';
158is $changes->get($alpha->old_id), $yo1, 'Should get "yo" by the @alpha tag old ID';
159is $changes->get('baz'), $baz, 'Should get baz for "baz"';
160is $changes->get($baz->id), $baz, 'Should get baz by ID';
161is $changes->get($baz->old_id), $baz, 'Should get baz by old ID';
162is $changes->get('@HEAD^'), $baz, 'Should get baz for "@HEAD^"';
163is $changes->get('@HEAD^^'), $yo1, 'Should get yo1 for "@HEAD^^"';
164is $changes->get('@HEAD^3'), $bar, 'Should get bar for "@HEAD^3"';
165is $changes->get('@ROOT'), $foo, 'Should get foo for "@ROOT"';
166is $changes->get('HEAD^'), $baz, 'Should get baz for "HEAD^"';
167is $changes->get('HEAD^^'), $yo1, 'Should get yo1 for "HEAD^^"';
168is $changes->get('HEAD^3'), $bar, 'Should get bar for "HEAD^3"';
169is $changes->get('ROOT'), $foo, 'Should get foo for "ROOT"';
170
171is $changes->get('yo@alpha'), $yo1, 'Should get yo1 for yo@alpha';
172is $changes->get('yo@HEAD'), $yo2, 'Should get yo2 for yo@HEAD';
173is $changes->get('foo@alpha'), $foo, 'Should get foo for foo@alpha';
174is $changes->get('foo@HEAD'), $foo, 'Should get foo for foo@HEAD';
175is $changes->get('baz@alpha'), undef, 'Should get undef for baz@alpha';
176is $changes->get('baz@HEAD'), $baz, 'Should get baz for baz@HEAD';
177is $changes->get('yo@HEAD'), $yo2, 'Should get yo2 for "yo@HEAD"';
178is $changes->get('foo@ROOT'), $foo, 'Should get foo for "foo@ROOT"';
179
180is $changes->find('yo'), $yo1, 'Should find yo1 with "yo"';
181is $changes->find('yo@alpha'), $yo1, 'Should find yo1 with "yo@alpha"';
182is $changes->find('yo@HEAD'), $yo2, 'Should find yo2 with yo@HEAD';
183is $changes->find('foo'), $foo, 'Should find foo for "foo"';
184is $changes->find('foo@alpha'), $foo, 'Should find foo for "foo@alpha"';
185is $changes->find('foo@HEAD'), $foo, 'Should find foo for "foo@HEAD"';
186is $changes->find('yo^'), $bar, 'Should find bar with "yo^"';
187is $changes->find('yo^^'), $foo, 'Should find foo with "yo^^"';
188is $changes->find('yo^2'), $foo, 'Should find foo with "yo^2"';
189is $changes->find('yo~'), $baz, 'Should find baz with "yo~"';
190is $changes->find('yo~~'), $yo2, 'Should find yo2 with "yo~~"';
191is $changes->find('yo~2'), $yo2, 'Should find yo2 with "yo~2"';
192is $changes->find('yo@alpha^'), $bar, 'Should find bar with "yo@alpha^"';
193is $changes->find('yo@alpha~'), $baz, 'Should find baz with "yo@alpha^"';
194is $changes->find('yo@HEAD^'), $baz, 'Should find baz with yo@HEAD^';
195is $changes->find('@HEAD^'), $baz, 'Should find baz with @HEAD^';
196is $changes->find('@ROOT~'), $bar, 'Should find bar with @ROOT~^';
197is $changes->find('HEAD^'), $baz, 'Should find baz with HEAD^';
198is $changes->find('ROOT~'), $bar, 'Should find bar with ROOT~^';
199
200ok $changes->contains('yo'), 'Should contain yo1 with "yo"';
201ok $changes->contains('yo@alpha'), 'Should contain yo1 with "yo@alpha"';
202ok $changes->contains('yo@HEAD'), 'Should contain yo2 with yo@HEAD';
203ok $changes->contains('foo'), 'Should contain foo for "foo"';
204ok $changes->contains('foo@alpha'), 'Should contain foo for "foo@alpha"';
205ok $changes->contains('foo@HEAD'), 'Should contain foo for "foo@HEAD"';
206ok $changes->contains('yo^'), 'Should contain bar with "yo^"';
207ok $changes->contains('yo^^'), 'Should contain foo with "yo^^"';
208ok $changes->contains('yo^2'), 'Should contain foo with "yo^2"';
209ok $changes->contains('yo~'), 'Should contain baz with "yo~"';
210ok $changes->contains('yo~~'), 'Should contain yo2 with "yo~~"';
211ok $changes->contains('yo~2'), 'Should contain yo2 with "yo~2"';
212ok $changes->contains('yo@alpha^'), 'Should contain bar with "yo@alpha^"';
213ok $changes->contains('yo@alpha~'), 'Should contain baz with "yo@alpha^"';
214ok $changes->contains('yo@HEAD^'), 'Should contain baz with yo@HEAD^';
215ok $changes->contains('@HEAD^'), 'Should contain baz with @HEAD^';
216ok $changes->contains('@ROOT~'), 'Should contain bar with @ROOT~^';
217ok $changes->contains('HEAD^'), 'Should contain baz with HEAD^';
218ok $changes->contains('ROOT~'), 'Should contain bar with ROOT~^';
219
220throws_ok { $changes->get('yo') } 'App::Sqitch::X',
221    'Should get multiple indexes error looking for index of "yo"';
222is $@->ident, 'plan', 'Multiple indexes error ident should be "plan"';
223is $@->message, __x(
224    'Key {key} at multiple indexes',
225    key => 'yo',
226), 'Multiple indexes message should be correct';
227
228throws_ok { $changes->get('yo@howdy') } 'App::Sqitch::X',
229    'Should unknown tag error for invalid tag';
230is $@->ident, 'plan', 'Unknown tag error ident should be "plan"';
231is $@->message, __x(
232    'Unknown tag "{tag}"',
233    tag => '@howdy',
234), 'Unknown taf message should be correct';
235
236my $hi = App::Sqitch::Plan::Change->new(plan => $plan, name => 'hi');
237ok $changes->append($hi), 'Push hi';
238is $changes->count, 6, 'Count should now be six';
239is_deeply [$changes->changes], [$foo, $bar, $yo1, $baz, $yo2, $hi],
240    'Changes should be in order with $hi at the end';
241is $changes->index_of('hi'), 5, 'Should find "hi" at index 5';
242is $changes->index_of($hi->id), 5, 'Should find "hi" by ID at index 5';
243is $changes->index_of($hi->old_id), 5, 'Should find "hi" by old ID at index 5';
244is $changes->index_of('@ROOT'), 0, 'Index of @ROOT should still be 0';
245is $changes->index_of('@HEAD'), 5, 'Index of @HEAD should now be 5';
246is $changes->index_of('ROOT'), 0, 'Index of ROOT should still be 0';
247is $changes->index_of('HEAD'), 5, 'Index of HEAD should now be 5';
248
249# Now try first_index_of().
250is $changes->first_index_of('non'), undef, 'First index of "non" should be undef';
251is $changes->first_index_of('foo'), 0, 'First index of "foo" should be 0';
252is $changes->first_index_of('foo~'), 1, 'First index of "foo~" should be 1';
253is $changes->first_index_of('foo~~'), 2, 'First index of "foo~~" should be 2';
254is $changes->first_index_of('foo~3'), 3, 'First index of "foo~3" should be 3';
255is $changes->first_index_of('foo~~~'), undef, 'Should not find first index of "foo~~~"';
256is $changes->first_index_of('foo', '@ROOT'), undef, 'First index of "foo" since @ROOT should be undef';
257is $changes->first_index_of('bar'), 1, 'First index of "bar" should be 1';
258is $changes->first_index_of('yo'), 2, 'First index of "yo" should be 2';
259is $changes->first_index_of('yo', '@ROOT'), 2, 'First index of "yo" since @ROOT should be 2';
260is $changes->first_index_of('baz'), 3, 'First index of "baz" should be 3';
261is $changes->first_index_of('baz^'), 2, 'First index of "baz^" should be 2';
262is $changes->first_index_of('baz^^'), 1, 'First index of "baz^^" should be 1';
263is $changes->first_index_of('baz^3'), 0, 'First index of "baz^3" should be 0';
264is $changes->first_index_of('baz^^^'), undef, 'Should not find first index of "baz^^^"';
265is $changes->first_index_of('yo', '@alpha'), 4,
266    'First index of "yo" since "@alpha" should be 4';
267is $changes->first_index_of('yo', 'baz'), 4,
268    'First index of "yo" since "baz" should be 4';
269is $changes->first_index_of('yo^', 'baz'), 3,
270    'First index of "yo^" since "baz" should be 4';
271is $changes->first_index_of('yo~', 'baz'), 5,
272    'First index of "yo~" since "baz" should be 5';
273throws_ok { $changes->first_index_of('baz', 'nonexistent') } 'App::Sqitch::X',
274    'Should get an exception for an unknown change passed to first_index_of()';
275is $@->ident, 'plan', 'Unknown change error ident should be "plan"';
276is $@->message, __x(
277    'Unknown change: "{change}"',
278    change => 'nonexistent',
279), 'Unknown change message should be correct';
280
281# Try appending a couple more changes.
282my $so = App::Sqitch::Plan::Change->new(plan => $plan, name => 'so');
283my $fu = App::Sqitch::Plan::Change->new(plan => $plan, name => 'fu');
284ok $changes->append($so, $fu), 'Push so and fu';
285is $changes->count, 8, 'Count should now be eight';
286is $changes->index_of('@ROOT'), 0, 'Index of @ROOT should remain 0';
287is $changes->index_of('@HEAD'), 7, 'Index of @HEAD should now be 7';
288is $changes->index_of('ROOT'), 0, 'Index of ROOT should remain 0';
289is $changes->index_of('HEAD'), 7, 'Index of HEAD should now be 7';
290is_deeply [$changes->changes], [$foo, $bar, $yo1, $baz, $yo2, $hi, $so, $fu],
291    'Changes should be in order with $so and $fu at the end';
292
293# Try indexing a tag.
294my $beta = App::Sqitch::Plan::Tag->new(
295    plan => $plan,
296    change => $yo2,
297    name => 'beta',
298);
299$yo2->add_tag($beta);
300ok $changes->index_tag(4, $beta), 'Index beta';
301is $changes->index_of('@beta'), 4, 'Should find @beta at index 4';
302is $changes->get('@beta'), $yo2, 'Should find yo2 via @beta';
303is $changes->get($beta->id), $yo2, 'Should find yo2 via @beta ID';
304is $changes->get($beta->old_id), $yo2, 'Should find yo2 via @beta old ID';
305is_deeply [$changes->tags], [$alpha, $beta], 'Tags should return both tags';
306
307##############################################################################
308# Test last_tagged(), last_change(), index_of_last_tagged().
309is $changes->index_of_last_tagged, 2, 'Should get 2 for last tagged index';
310is $changes->last_tagged_change, $yo1, 'Should find "yo" as last tagged';
311is $changes->count, 8, 'Should get 8 for count';
312is $changes->last_change, $fu, 'Should find fu as last change';
313
314for my $changes (
315    [0, $yo1],
316    [1, $foo, $yo1],
317    [3, $foo, $bar, $baz, $yo1],
318    [4, $foo, $bar, $baz, $hi, $yo1],
319) {
320    my $index = shift @{ $changes };
321    my $n = App::Sqitch::Plan::ChangeList->new(@{ $changes });
322    is $n->index_of_last_tagged, $index, "Should find last tagged index at $index";
323    is $n->last_tagged_change, $changes->[$index], "Should find last tagged at $index";
324    is $n->count, ($index + 1), "Should get count " . ($index + 1);
325    is $n->last_change, $changes->[$index], "Should find last change at $index";
326}
327
328for my $changes (
329    [],
330    [$foo, $baz],
331    [$foo, $bar, $baz, $hi],
332) {
333    my $n = App::Sqitch::Plan::ChangeList->new(@{ $changes });
334    is $n->index_of_last_tagged, undef,
335        'Should not find tag index in ' . scalar @{$changes} . ' changes';
336    is $n->last_tagged_change, undef,
337        'Should not find tag in ' . scalar @{$changes} . ' changes';
338    if (!@{ $changes }) {
339        is $n->last_change, undef, "Should find no change in empty plan";
340    }
341}
342
343# Try an empty change list.
344isa_ok $changes = App::Sqitch::Plan::ChangeList->new,
345    'App::Sqitch::Plan::ChangeList';
346for my $ref (qw(
347    foo
348    bar
349    HEAD
350    @HEAD
351    ROOT
352    @ROOT
353    alpha
354    @alpha
355)) {
356    is $changes->index_of($ref), undef,
357        qq{Should not find index of "$ref" in empty list};
358    is $changes->first_index_of($ref), undef,
359        qq{Should not find first index of "$ref" in empty list};
360    is $changes->get($ref), undef,
361        qq{Should get undef for "$ref" in empty list};
362    ok !$changes->contains($ref),
363        qq{Should not contain "$ref" in empty list};
364    is $changes->find($ref), undef,
365        qq{Should find undef for "$ref" in empty list};
366}
367