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