1#!/usr/bin/perl -w 2 3use strict; 4use warnings; 5use 5.010; 6use utf8; 7use Test::More tests => 639; 8#use Test::More 'no_plan'; 9use App::Sqitch; 10use App::Sqitch::Plan; 11use App::Sqitch::Target; 12use Path::Class; 13use Test::Exception; 14use Test::NoWarnings; 15use Test::MockModule; 16use Locale::TextDomain qw(App-Sqitch); 17use App::Sqitch::X qw(hurl); 18use App::Sqitch::DateTime; 19use List::Util qw(max); 20use lib 't/lib'; 21use MockOutput; 22 23my $CLASS; 24 25BEGIN { 26 $CLASS = 'App::Sqitch::Engine'; 27 use_ok $CLASS or die; 28 delete $ENV{PGDATABASE}; 29 delete $ENV{PGUSER}; 30 delete $ENV{USER}; 31 $ENV{SQITCH_CONFIG} = 'nonexistent.conf'; 32} 33 34can_ok $CLASS, qw(load new name no_prompt run_deploy run_revert run_verify uri); 35 36my ($is_deployed_tag, $is_deployed_change) = (0, 0); 37my @deployed_changes; 38my @deployed_change_ids; 39my @resolved; 40my @requiring; 41my @load_changes; 42my $offset_change; 43my $die = ''; 44my $record_work = 1; 45my $updated_idx; 46my ( $earliest_change_id, $latest_change_id, $initialized ); 47my $registry_version = $CLASS->registry_release; 48my $script_hash; 49ENGINE: { 50 # Stub out an engine. 51 package App::Sqitch::Engine::whu; 52 use Moo; 53 use App::Sqitch::X qw(hurl); 54 extends 'App::Sqitch::Engine'; 55 $INC{'App/Sqitch/Engine/whu.pm'} = __FILE__; 56 57 my @SEEN; 58 for my $meth (qw( 59 run_file 60 log_deploy_change 61 log_revert_change 62 log_fail_change 63 )) { 64 no strict 'refs'; 65 *$meth = sub { 66 hurl 'AAAH!' if $die eq $meth; 67 push @SEEN => [ $meth => $_[1] ]; 68 }; 69 } 70 sub is_deployed_tag { push @SEEN => [ is_deployed_tag => $_[1] ]; $is_deployed_tag } 71 sub is_deployed_change { push @SEEN => [ is_deployed_change => $_[1] ]; $is_deployed_change } 72 sub are_deployed_changes { shift; push @SEEN => [ are_deployed_changes => [@_] ]; @deployed_change_ids } 73 sub change_id_for { shift; push @SEEN => [ change_id_for => {@_} ]; shift @resolved } 74 sub change_offset_from_id { shift; push @SEEN => [ change_offset_from_id => [@_] ]; $offset_change } 75 sub change_id_offset_from_id { shift; push @SEEN => [ change_id_offset_from_id => [@_] ]; $_[0] } 76 sub changes_requiring_change { push @SEEN => [ changes_requiring_change => $_[1] ]; @{ shift @requiring } } 77 sub earliest_change_id { push @SEEN => [ earliest_change_id => $_[1] ]; $earliest_change_id } 78 sub latest_change_id { push @SEEN => [ latest_change_id => $_[1] ]; $latest_change_id } 79 sub current_state { push @SEEN => [ current_state => $_[1] ]; $latest_change_id ? { change => 'what', change_id => $latest_change_id, script_hash => $script_hash } : undef } 80 sub initialized { push @SEEN => 'initialized'; $initialized } 81 sub initialize { push @SEEN => 'initialize' } 82 sub register_project { push @SEEN => 'register_project' } 83 sub deployed_changes { push @SEEN => [ deployed_changes => $_[1] ]; @deployed_changes } 84 sub load_change { push @SEEN => [ load_change => $_[1] ]; @load_changes } 85 sub deployed_changes_since { push @SEEN => [ deployed_changes_since => $_[1] ]; @deployed_changes } 86 sub mock_check_deploy { shift; push @SEEN => [ check_deploy_dependencies => [@_] ] } 87 sub mock_check_revert { shift; push @SEEN => [ check_revert_dependencies => [@_] ] } 88 sub begin_work { push @SEEN => ['begin_work'] if $record_work } 89 sub finish_work { push @SEEN => ['finish_work'] if $record_work } 90 sub _update_ids { push @SEEN => ['_update_ids']; $updated_idx } 91 sub log_new_tags { push @SEEN => [ log_new_tags => $_[1] ]; $_[0] } 92 sub _update_script_hashes { push @SEEN => ['_update_script_hashes']; $_[0] } 93 94 sub seen { [@SEEN] } 95 after seen => sub { @SEEN = () }; 96 97 sub name_for_change_id { return 'bugaboo' } 98 sub registry_version { $registry_version } 99} 100 101ok my $sqitch = App::Sqitch->new( 102 options => { 103 engine => 'sqlite', 104 top_dir => dir(qw(t sql))->stringify, 105 plan_file => file(qw(t plans multi.plan))->stringify, 106 } 107), 'Load a sqitch sqitch object'; 108 109my $mock_engine = Test::MockModule->new($CLASS); 110 111############################################################################## 112# Test new(). 113my $target = App::Sqitch::Target->new( sqitch => $sqitch ); 114throws_ok { $CLASS->new( sqitch => $sqitch ) } 115 qr/\QMissing required arguments: target/, 116 'Should get an exception for missing sqitch param'; 117throws_ok { $CLASS->new( target => $target ) } 118 qr/\QMissing required arguments: sqitch/, 119 'Should get an exception for missing sqitch param'; 120my $array = []; 121throws_ok { $CLASS->new({ sqitch => $array, target => $target }) } 122 qr/\QReference [] did not pass type constraint "Sqitch"/, 123 'Should get an exception for array sqitch param'; 124throws_ok { $CLASS->new({ sqitch => $sqitch, target => $array }) } 125 qr/\QReference [] did not pass type constraint "Target"/, 126 'Should get an exception for array target param'; 127throws_ok { $CLASS->new({ sqitch => 'foo', target => $target }) } 128 qr/\QValue "foo" did not pass type constraint "Sqitch"/, 129 'Should get an exception for string sqitch param'; 130throws_ok { $CLASS->new({ sqitch => $sqitch, target => 'foo' }) } 131 qr/\QValue "foo" did not pass type constraint "Target"/, 132 'Should get an exception for string target param'; 133 134isa_ok $CLASS->new({sqitch => $sqitch, target => $target}), $CLASS, 'Engine'; 135 136############################################################################## 137# Test load(). 138$sqitch->options->{engine} = 'whu'; 139$target = App::Sqitch::Target->new( sqitch => $sqitch ); 140ok my $engine = $CLASS->load({ 141 sqitch => $sqitch, 142 target => $target, 143}), 'Load an engine'; 144isa_ok $engine, 'App::Sqitch::Engine::whu'; 145is $engine->sqitch, $sqitch, 'The sqitch attribute should be set'; 146 147# Test handling of an invalid engine. 148my $unknown_target = App::Sqitch::Target->new( 149 sqitch => $sqitch, 150 uri => URI::db->new('db:nonexistent:') 151); 152throws_ok { $CLASS->load({ sqitch => $sqitch, target => $unknown_target }) } 153 'App::Sqitch::X', 'Should die on unknown target'; 154is $@->message, 'Unable to load App::Sqitch::Engine::nonexistent', 155 'Should get load error message'; 156like $@->previous_exception, qr/\QCan't locate/, 157 'Should have relevant previoius exception'; 158 159NOENGINE: { 160 # Test handling of no target. 161 throws_ok { $CLASS->load({ sqitch => $sqitch }) } 'App::Sqitch::X', 162 'No target should die'; 163 is $@->message, 'Missing "target" parameter to load()', 164 'It should be the expected message'; 165} 166 167# Test handling a bad engine implementation. 168use lib 't/lib'; 169my $bad_target = App::Sqitch::Target->new( 170 sqitch => $sqitch, 171 uri => URI::db->new('db:bad:') 172); 173throws_ok { $CLASS->load({ sqitch => $sqitch, target => $bad_target }) } 174 'App::Sqitch::X', 'Should die on bad engine module'; 175is $@->message, 'Unable to load App::Sqitch::Engine::bad', 176 'Should get another load error message'; 177like $@->previous_exception, qr/^LOL BADZ/, 178 'Should have relevant previoius exception from the bad module'; 179 180 181############################################################################## 182# Test name. 183can_ok $CLASS, 'name'; 184ok $engine = $CLASS->new({ sqitch => $sqitch, target => $target }), 185 "Create a $CLASS object"; 186throws_ok { $engine->name } 'App::Sqitch::X', 187 'Should get error from base engine name'; 188is $@->ident, 'engine', 'Name error ident should be "engine"'; 189is $@->message, __('No engine specified; use --engine or set core.engine'), 190 'Name error message should be correct'; 191 192ok $engine = App::Sqitch::Engine::whu->new({sqitch => $sqitch, target => $target}), 193 'Create a subclass name object'; 194is $engine->name, 'whu', 'Subclass oject name should be "whu"'; 195is +App::Sqitch::Engine::whu->name, 'whu', 'Subclass class name should be "whu"'; 196 197############################################################################## 198# Test config_vars. 199can_ok $CLASS, 'config_vars'; 200is_deeply [App::Sqitch::Engine->config_vars], [ 201 target => 'any', 202 registry => 'any', 203 client => 'any', 204], 'Should have database and client in engine base class'; 205 206############################################################################## 207# Test variables. 208can_ok $CLASS, qw(variables set_variables clear_variables); 209is_deeply [$engine->variables], [], 'Should have no variables'; 210ok $engine->set_variables(foo => 'bar'), 'Add a variable'; 211is_deeply [$engine->variables], [foo => 'bar'], 'Should have the variable'; 212ok $engine->set_variables(foo => 'baz', whu => 'hi', yo => 'stellar'), 213 'Set more variables'; 214is_deeply {$engine->variables}, {foo => 'baz', whu => 'hi', yo => 'stellar'}, 215 'Should have all of the variables'; 216$engine->clear_variables; 217is_deeply [$engine->variables], [], 'Should again have no variables'; 218 219############################################################################## 220# Test target. 221ok $engine = $CLASS->load({ 222 sqitch => $sqitch, 223 target => $target, 224}), 'Load engine'; 225is $engine->target, $target, 'Target should be as passed'; 226 227# Make sure password is removed from the target. 228ok $engine = $CLASS->load({ 229 sqitch => $sqitch, 230 target => $target, 231 uri => URI->new('db:whu://foo:bar@localhost/blah'), 232}), 'Load engine with URI with password'; 233isa_ok $engine->target, 'App::Sqitch::Target', 'target attribute'; 234 235############################################################################## 236# Test destination. 237ok $engine = $CLASS->load({ 238 sqitch => $sqitch, 239 target => $target, 240}), 'Load engine'; 241is $engine->destination, 'db:whu:', 'Destination should be URI string'; 242is $engine->registry_destination, $engine->destination, 243 'Rgistry destination should be the same as destination'; 244 245# Make sure password is removed from the destination. 246my $long_target = App::Sqitch::Target->new( 247 sqitch => $sqitch, 248 uri => URI->new('db:whu://foo:bar@localhost/blah'), 249); 250ok $engine = $CLASS->load({ 251 sqitch => $sqitch, 252 target => $long_target, 253}), 'Load engine with URI with password'; 254like $engine->destination, qr{^db:whu://foo:?\@localhost/blah$}, 255 'Destination should not include password'; 256is $engine->registry_destination, $engine->destination, 257 'Meta destination should again be the same as destination'; 258 259############################################################################## 260# Test _check_registry. 261can_ok $engine, '_check_registry'; 262ok $engine->_check_registry, 'Registry should be fine at current version'; 263 264# Make the registry non-existent. 265$registry_version = 0; 266$initialized = 0; 267throws_ok { $engine->_check_registry } 'App::Sqitch::X', 268 'Should get error for non-existent registry'; 269is $@->ident, 'engine', 'Non-existent registry error ident should be "engine"'; 270is $@->message, __x( 271 'No registry found in {destination}. Have you ever deployed?', 272 destination => $engine->registry_destination, 273), 'Non-existent registry error message should be correct'; 274$engine->seen; 275 276# Make the registry out-of-date. 277$registry_version = 0.1; 278throws_ok { $engine->_check_registry } 'App::Sqitch::X', 279 'Should get error for out-of-date registry'; 280is $@->ident, 'engine', 'Out-of-date registry error ident should be "engine"'; 281is $@->message, __x( 282 'Registry is at version {old} but latest is {new}. Please run the "upgrade" conmand', 283 old => 0.1, 284 new => $engine->registry_release, 285), 'Out-of-date registry error message should be correct'; 286 287# Send the registry to the future. 288$registry_version = 999.99; 289throws_ok { $engine->_check_registry } 'App::Sqitch::X', 290 'Should get error for future registry'; 291is $@->ident, 'engine', 'Future registry error ident should be "engine"'; 292is $@->message, __x( 293 'Registry version is {old} but {new} is the latest known. Please upgrade Sqitch', 294 old => 999.99, 295 new => $engine->registry_release, 296), 'Future registry error message should be correct'; 297 298 299# Restore the registry version. 300$registry_version = $CLASS->registry_release; 301 302############################################################################## 303# Test abstract methods. 304ok $engine = $CLASS->new({ 305 sqitch => $sqitch, 306 target => $target, 307}), "Create a $CLASS object again"; 308for my $abs (qw( 309 initialized 310 initialize 311 register_project 312 run_file 313 run_handle 314 log_deploy_change 315 log_fail_change 316 log_revert_change 317 log_new_tags 318 is_deployed_tag 319 is_deployed_change 320 are_deployed_changes 321 change_id_for 322 changes_requiring_change 323 earliest_change_id 324 latest_change_id 325 deployed_changes 326 deployed_changes_since 327 load_change 328 name_for_change_id 329 current_state 330 current_changes 331 current_tags 332 search_events 333 registered_projects 334 change_offset_from_id 335 change_id_offset_from_id 336)) { 337 throws_ok { $engine->$abs } qr/\Q$CLASS has not implemented $abs()/, 338 "Should get an unimplemented exception from $abs()" 339} 340 341############################################################################## 342# Test _load_changes(). 343can_ok $engine, '_load_changes'; 344my $now = App::Sqitch::DateTime->now; 345my $plan = $target->plan; 346 347# Mock App::Sqitch::DateTime so that dbchange tags all have the same 348# timestamps. 349my $mock_dt = Test::MockModule->new('App::Sqitch::DateTime'); 350$mock_dt->mock(now => $now); 351 352 353for my $spec ( 354 [ 'no change' => [] ], 355 [ 'undef' => [undef] ], 356 ['no tags' => [ 357 { 358 id => 'c8a60f1a4fdab2cf91ee7f6da08f4ac52a732b4d', 359 name => 'howdy', 360 project => 'engine', 361 note => 'For realz', 362 planner_name => 'Barack Obama', 363 planner_email => 'bo@whitehouse.gov', 364 timestamp => $now, 365 }, 366 ]], 367 ['multiple hashes with no tags' => [ 368 { 369 id => 'c8a60f1a4fdab2cf91ee7f6da08f4ac52a732b4d', 370 name => 'howdy', 371 project => 'engine', 372 note => 'For realz', 373 planner_name => 'Barack Obama', 374 planner_email => 'bo@whitehouse.gov', 375 timestamp => $now, 376 }, 377 { 378 id => 'ae5b4397f78dfc6072ccf6d505b17f9624d0e3b0', 379 name => 'booyah', 380 project => 'engine', 381 note => 'Whatever', 382 planner_name => 'Barack Obama', 383 planner_email => 'bo@whitehouse.gov', 384 timestamp => $now, 385 }, 386 ]], 387 ['tags' => [ 388 { 389 id => 'c8a60f1a4fdab2cf91ee7f6da08f4ac52a732b4d', 390 name => 'howdy', 391 project => 'engine', 392 note => 'For realz', 393 planner_name => 'Barack Obama', 394 planner_email => 'bo@whitehouse.gov', 395 timestamp => $now, 396 tags => [qw(foo bar)], 397 }, 398 ]], 399 ['tags with leading @' => [ 400 { 401 id => 'c8a60f1a4fdab2cf91ee7f6da08f4ac52a732b4d', 402 name => 'howdy', 403 project => 'engine', 404 note => 'For realz', 405 planner_name => 'Barack Obama', 406 planner_email => 'bo@whitehouse.gov', 407 timestamp => $now, 408 tags => [qw(@foo @bar)], 409 }, 410 ]], 411 ['multiple hashes with tags' => [ 412 { 413 id => 'c8a60f1a4fdab2cf91ee7f6da08f4ac52a732b4d', 414 name => 'howdy', 415 project => 'engine', 416 note => 'For realz', 417 planner_name => 'Barack Obama', 418 planner_email => 'bo@whitehouse.gov', 419 timestamp => $now, 420 tags => [qw(foo bar)], 421 }, 422 { 423 id => 'ae5b4397f78dfc6072ccf6d505b17f9624d0e3b0', 424 name => 'booyah', 425 project => 'engine', 426 note => 'Whatever', 427 planner_name => 'Barack Obama', 428 planner_email => 'bo@whitehouse.gov', 429 timestamp => $now, 430 tags => [qw(@foo @bar)], 431 }, 432 ]], 433 ['reworked change' => [ 434 { 435 id => 'c8a60f1a4fdab2cf91ee7f6da08f4ac52a732b4d', 436 name => 'howdy', 437 project => 'engine', 438 note => 'For realz', 439 planner_name => 'Barack Obama', 440 planner_email => 'bo@whitehouse.gov', 441 timestamp => $now, 442 tags => [qw(foo bar)], 443 }, 444 { 445 id => 'df18b5c9739772b210fcf2c4edae095e2f6a4163', 446 name => 'howdy', 447 project => 'engine', 448 note => 'For realz', 449 planner_name => 'Barack Obama', 450 planner_email => 'bo@whitehouse.gov', 451 timestamp => $now, 452 rtags => [qw(howdy)], 453 }, 454 ]], 455 ['reworked change & multiple tags' => [ 456 { 457 id => 'c8a60f1a4fdab2cf91ee7f6da08f4ac52a732b4d', 458 name => 'howdy', 459 project => 'engine', 460 note => 'For realz', 461 planner_name => 'Barack Obama', 462 planner_email => 'bo@whitehouse.gov', 463 timestamp => $now, 464 tags => [qw(foo bar)], 465 }, 466 { 467 id => 'ae5b4397f78dfc6072ccf6d505b17f9624d0e3b0', 468 name => 'booyah', 469 project => 'engine', 470 note => 'Whatever', 471 planner_name => 'Barack Obama', 472 planner_email => 'bo@whitehouse.gov', 473 timestamp => $now, 474 tags => [qw(@settle)], 475 }, 476 { 477 id => 'df18b5c9739772b210fcf2c4edae095e2f6a4163', 478 name => 'howdy', 479 project => 'engine', 480 note => 'For realz', 481 planner_name => 'Barack Obama', 482 planner_email => 'bo@whitehouse.gov', 483 timestamp => $now, 484 rtags => [qw(booyah howdy)], 485 }, 486 ]], 487 ['doubly reworked change' => [ 488 { 489 id => 'c8a60f1a4fdab2cf91ee7f6da08f4ac52a732b4d', 490 name => 'howdy', 491 project => 'engine', 492 note => 'For realz', 493 planner_name => 'Barack Obama', 494 planner_email => 'bo@whitehouse.gov', 495 timestamp => $now, 496 tags => [qw(foo bar)], 497 }, 498 { 499 id => 'df18b5c9739772b210fcf2c4edae095e2f6a4163', 500 name => 'howdy', 501 project => 'engine', 502 note => 'For realz', 503 planner_name => 'Barack Obama', 504 planner_email => 'bo@whitehouse.gov', 505 timestamp => $now, 506 rtags => [qw(howdy)], 507 tags => [qw(why)], 508 }, 509 { 510 id => 'f38ceb6efcf2a813104b7bb08cc90667033ddf6b', 511 name => 'howdy', 512 project => 'engine', 513 note => 'For realz', 514 planner_name => 'Barack Obama', 515 planner_email => 'bo@whitehouse.gov', 516 timestamp => $now, 517 rtags => [qw(howdy)], 518 }, 519 ]], 520) { 521 my ($desc, $args) = @{ $spec }; 522 my %seen; 523 is_deeply [ $engine->_load_changes(@{ $args }) ], [ map { 524 my $tags = $_->{tags} || []; 525 my $rtags = $_->{rtags}; 526 my $c = App::Sqitch::Plan::Change->new(%{ $_ }, plan => $plan ); 527 $c->add_tag(App::Sqitch::Plan::Tag->new( 528 name => $_, 529 plan => $plan, 530 change => $c, 531 timestamp => $now, 532 )) for map { s/^@//; $_ } @{ $tags }; 533 if (my $dupe = $seen{ $_->{name} }) { 534 $dupe->add_rework_tags( map { $seen{$_}->tags } @{ $rtags }); 535 } 536 $seen{ $_->{name} } = $c; 537 $c; 538 } grep { $_ } @{ $args }], "Should load changes with $desc"; 539} 540 541# Rework a change in the plan. 542my $you = $plan->get('you'); 543my $this_rocks = $plan->get('this/rocks'); 544my $hey_there = $plan->get('hey-there'); 545ok my $rev_change = $plan->rework( name => 'you' ), 'Rework change "you"'; 546ok $plan->tag( name => '@beta1' ), 'Tag @beta1'; 547 548# Load changes 549for my $spec ( 550 [ 'Unplanned change' => [ 551 { 552 id => 'c8a60f1a4fdab2cf91ee7f6da08f4ac52a732b4d', 553 name => 'you', 554 project => 'engine', 555 note => 'For realz', 556 planner_name => 'Barack Obama', 557 planner_email => 'bo@whitehouse.gov', 558 timestamp => $now, 559 }, 560 { 561 id => 'df18b5c9739772b210fcf2c4edae095e2f6a4163', 562 name => 'this/rocks', 563 project => 'engine', 564 note => 'For realz', 565 planner_name => 'Barack Obama', 566 planner_email => 'bo@whitehouse.gov', 567 timestamp => $now, 568 }, 569 ]], 570 [ 'reworked change without reworked version deployed' => [ 571 { 572 id => $you->id, 573 name => $you->name, 574 project => $you->project, 575 note => $you->note, 576 planner_name => $you->planner_name, 577 planner_email => $you->planner_email, 578 timestamp => $you->timestamp, 579 ptags => [ $hey_there->tags, $you->tags ], 580 }, 581 { 582 id => $this_rocks->id, 583 name => 'this/rocks', 584 project => 'engine', 585 note => 'For realz', 586 planner_name => 'Barack Obama', 587 planner_email => 'bo@whitehouse.gov', 588 timestamp => $now, 589 }, 590 ]], 591 [ 'reworked change with reworked version deployed' => [ 592 { 593 id => $you->id, 594 name => $you->name, 595 project => $you->project, 596 note => $you->note, 597 planner_name => $you->planner_name, 598 planner_email => $you->planner_email, 599 timestamp => $you->timestamp, 600 tags => [qw(@foo @bar)], 601 ptags => [ $hey_there->tags, $you->tags ], 602 }, 603 { 604 id => $rev_change->id, 605 name => $rev_change->name, 606 project => 'engine', 607 note => $rev_change->note, 608 planner_name => $rev_change->planner_name, 609 planner_email => $rev_change->planner_email, 610 timestamp => $rev_change->timestamp, 611 }, 612 ]], 613) { 614 my ($desc, $args) = @{ $spec }; 615 my %seen; 616 is_deeply [ $engine->_load_changes(@{ $args }) ], [ map { 617 my $tags = $_->{tags} || []; 618 my $rtags = $_->{rtags}; 619 my $ptags = $_->{ptags}; 620 my $c = App::Sqitch::Plan::Change->new(%{ $_ }, plan => $plan ); 621 $c->add_tag(App::Sqitch::Plan::Tag->new( 622 name => $_, 623 plan => $plan, 624 change => $c, 625 timestamp => $now, 626 )) for map { s/^@//; $_ } @{ $tags }; 627 my %seen_tags; 628 if (@{ $ptags || [] }) { 629 $c->add_rework_tags( @{ $ptags }); 630 } 631 if (my $dupe = $seen{ $_->{name} }) { 632 $dupe->add_rework_tags( map { $seen{$_}->tags } @{ $rtags }); 633 } 634 $seen{ $_->{name} } = $c; 635 $c; 636 } grep { $_ } @{ $args }], "Should load changes with $desc"; 637} 638 639############################################################################## 640# Test deploy_change and revert_change. 641ok $engine = App::Sqitch::Engine::whu->new( sqitch => $sqitch, target => $target ), 642 'Create a subclass name object again'; 643can_ok $engine, 'deploy_change', 'revert_change'; 644 645my $change = App::Sqitch::Plan::Change->new( name => 'users', plan => $target->plan ); 646$engine->max_name_length(length $change->format_name_with_tags); 647 648ok $engine->deploy_change($change), 'Deploy a change'; 649is_deeply $engine->seen, [ 650 ['begin_work'], 651 [run_file => $change->deploy_file ], 652 [log_deploy_change => $change ], 653 ['finish_work'], 654], 'deploy_change should have called the proper methods'; 655is_deeply +MockOutput->get_info_literal, [[ 656 ' + users ..', '' , ' ' 657]], 'Output should reflect the deployment'; 658is_deeply +MockOutput->get_info, [[__ 'ok' ]], 659 'Output should reflect success'; 660 661# Have it log only. 662$engine->log_only(1); 663ok $engine->deploy_change($change), 'Only log a change'; 664is_deeply $engine->seen, [ 665 ['begin_work'], 666 [log_deploy_change => $change ], 667 ['finish_work'], 668], 'log-only deploy_change should not have called run_file'; 669is_deeply +MockOutput->get_info_literal, [[ 670 ' + users ..', '' , ' ' 671]], 'Output should reflect the logging'; 672is_deeply +MockOutput->get_info, [[__ 'ok' ]], 673 'Output should reflect deploy success'; 674 675# Have it verify. 676ok $engine->with_verify(1), 'Enable verification'; 677$engine->log_only(0); 678ok $engine->deploy_change($change), 'Deploy a change to be verified'; 679is_deeply $engine->seen, [ 680 ['begin_work'], 681 [run_file => $change->deploy_file ], 682 [run_file => $change->verify_file ], 683 [log_deploy_change => $change ], 684 ['finish_work'], 685], 'deploy_change with verification should run the verify file'; 686is_deeply +MockOutput->get_info_literal, [[ 687 ' + users ..', '' , ' ' 688]], 'Output should reflect the logging'; 689is_deeply +MockOutput->get_info, [[__ 'ok' ]], 690 'Output should reflect deploy success'; 691 692# Have it verify *and* log-only. 693ok $engine->log_only(1), 'Enable log_only'; 694ok $engine->deploy_change($change), 'Verify and log a change'; 695is_deeply $engine->seen, [ 696 ['begin_work'], 697 [run_file => $change->verify_file ], 698 [log_deploy_change => $change ], 699 ['finish_work'], 700], 'deploy_change with verification and log-only should not run deploy'; 701is_deeply +MockOutput->get_info_literal, [[ 702 ' + users ..', '' , ' ' 703]], 'Output should reflect the logging'; 704is_deeply +MockOutput->get_info, [[__ 'ok' ]], 705 'Output should reflect deploy success'; 706 707# Make it fail. 708$die = 'run_file'; 709$engine->log_only(0); 710throws_ok { $engine->deploy_change($change) } 'App::Sqitch::X', 711 'Deploy change with error'; 712is $@->message, 'AAAH!', 'Error should be from run_file'; 713is_deeply $engine->seen, [ 714 ['begin_work'], 715 [log_fail_change => $change ], 716 ['finish_work'], 717], 'Should have logged change failure'; 718$die = ''; 719is_deeply +MockOutput->get_info_literal, [[ 720 ' + users ..', '' , ' ' 721]], 'Output should reflect the deployment, even with failure'; 722is_deeply +MockOutput->get_info, [[__ 'not ok' ]], 723 'Output should reflect deploy failure'; 724 725# Make the verify fail. 726$mock_engine->mock( verify_change => sub { hurl 'WTF!' }); 727throws_ok { $engine->deploy_change($change) } 'App::Sqitch::X', 728 'Deploy change with failed verification'; 729is $@->message, __ 'Deploy failed', 'Error should be from deploy_change'; 730is_deeply $engine->seen, [ 731 ['begin_work'], 732 [run_file => $change->deploy_file ], 733 ['begin_work'], 734 [run_file => $change->revert_file ], 735 [log_fail_change => $change ], 736 ['finish_work'], 737], 'Should have logged verify failure'; 738$die = ''; 739is_deeply +MockOutput->get_info_literal, [[ 740 ' + users ..', '' , ' ' 741]], 'Output should reflect the deployment, even with verify failure'; 742is_deeply +MockOutput->get_info, [[__ 'not ok' ]], 743 'Output should reflect deploy failure'; 744is_deeply +MockOutput->get_vent, [['WTF!']], 745 'Verify error should have been vented'; 746 747# Make the verify fail with log only. 748ok $engine->log_only(1), 'Enable log_only'; 749throws_ok { $engine->deploy_change($change) } 'App::Sqitch::X', 750 'Deploy change with log-only and failed verification'; 751is $@->message, __ 'Deploy failed', 'Error should be from deploy_change'; 752is_deeply $engine->seen, [ 753 ['begin_work'], 754 ['begin_work'], 755 [log_fail_change => $change ], 756 ['finish_work'], 757], 'Should have logged verify failure but not reverted'; 758$die = ''; 759is_deeply +MockOutput->get_info_literal, [[ 760 ' + users ..', '' , ' ' 761]], 'Output should reflect the deployment, even with verify failure'; 762is_deeply +MockOutput->get_info, [[__ 'not ok' ]], 763 'Output should reflect deploy failure'; 764is_deeply +MockOutput->get_vent, [['WTF!']], 765 'Verify error should have been vented'; 766 767# Try a change with no verify file. 768$engine->log_only(0); 769$mock_engine->unmock( 'verify_change' ); 770$change = App::Sqitch::Plan::Change->new( name => 'foo', plan => $target->plan ); 771ok $engine->deploy_change($change), 'Deploy a change with no verify script'; 772is_deeply $engine->seen, [ 773 ['begin_work'], 774 [run_file => $change->deploy_file ], 775 [log_deploy_change => $change ], 776 ['finish_work'], 777], 'deploy_change with no verify file should not run it'; 778is_deeply +MockOutput->get_info_literal, [[ 779 ' + foo ..', '..' , ' ' 780]], 'Output should reflect the logging'; 781is_deeply +MockOutput->get_info, [[__ 'ok' ]], 782 'Output should reflect deploy success'; 783is_deeply +MockOutput->get_vent, [ 784 [__x 'Verify script {file} does not exist', file => $change->verify_file], 785], 'A warning about no verify file should have been emitted'; 786 787# Alright, disable verify now. 788$engine->with_verify(0); 789 790ok $engine->revert_change($change), 'Revert a change'; 791is_deeply $engine->seen, [ 792 ['begin_work'], 793 [run_file => $change->revert_file ], 794 [log_revert_change => $change ], 795 ['finish_work'], 796], 'revert_change should have called the proper methods'; 797is_deeply +MockOutput->get_info_literal, [[ 798 ' - foo ..', '..', ' ' 799]], 'Output should reflect reversion'; 800is_deeply +MockOutput->get_info, [[__ 'ok']], 801 'Output should acknowldge revert success'; 802 803# Revert with log-only. 804ok $engine->log_only(1), 'Enable log_only'; 805ok $engine->revert_change($change), 'Revert a change with log-only'; 806is_deeply $engine->seen, [ 807 ['begin_work'], 808 [log_revert_change => $change ], 809 ['finish_work'], 810], 'Log-only revert_change should not have run the change script'; 811is_deeply +MockOutput->get_info_literal, [[ 812 ' - foo ..', '..', ' ' 813]], 'Output should reflect logged reversion'; 814is_deeply +MockOutput->get_info, [[__ 'ok']], 815 'Output should acknowldge revert success'; 816$record_work = 0; 817 818############################################################################## 819# Test earliest_change() and latest_change(). 820chdir 't'; 821my $plan_file = file qw(sql sqitch.plan); 822my $sqitch_old = $sqitch; # Hang on to this because $change does not retain it. 823$sqitch = App::Sqitch->new( 824 options => { 825 engine => 'sqlite', 826 plan_file => $plan_file->stringify, 827 top_dir => 'sql', 828 }, 829); 830$target = App::Sqitch::Target->new( sqitch => $sqitch ); 831$change = App::Sqitch::Plan::Change->new( name => 'foo', plan => $target->plan ); 832ok $engine = App::Sqitch::Engine::whu->new( sqitch => $sqitch, target => $target ), 833 'Engine with sqitch with plan file'; 834$plan = $target->plan; 835my @changes = $plan->changes; 836 837$latest_change_id = $changes[0]->id; 838is $engine->latest_change, $changes[0], 'Should get proper change from latest_change()'; 839is_deeply $engine->seen, [[ latest_change_id => undef ]], 840 'Latest change ID should have been called with no arg'; 841$latest_change_id = $changes[2]->id; 842is $engine->latest_change(2), $changes[2], 843 'Should again get proper change from latest_change()'; 844is_deeply $engine->seen, [[ latest_change_id => 2 ]], 845 'Latest change ID should have been called with offset arg'; 846$latest_change_id = undef; 847 848$earliest_change_id = $changes[0]->id; 849is $engine->earliest_change, $changes[0], 'Should get proper change from earliest_change()'; 850is_deeply $engine->seen, [[ earliest_change_id => undef ]], 851 'Earliest change ID should have been called with no arg'; 852$earliest_change_id = $changes[2]->id; 853is $engine->earliest_change(4), $changes[2], 854 'Should again get proper change from earliest_change()'; 855is_deeply $engine->seen, [[ earliest_change_id => 4 ]], 856 'Earliest change ID should have been called with offset arg'; 857$earliest_change_id = undef; 858 859############################################################################## 860# Test _sync_plan() 861can_ok $CLASS, '_sync_plan'; 862$engine->seen; 863 864is $plan->position, -1, 'Plan should start at position -1'; 865is $engine->start_at, undef, 'start_at should be undef'; 866 867ok $engine->_sync_plan, 'Sync the plan'; 868is $plan->position, -1, 'Plan should still be at position -1'; 869is $engine->start_at, undef, 'start_at should still be undef'; 870$plan->position(4); 871is_deeply $engine->seen, [['current_state', undef]], 872 'Should not have updated IDs or hashes'; 873 874ok $engine->_sync_plan, 'Sync the plan again'; 875is $plan->position, -1, 'Plan should again be at position -1'; 876is $engine->start_at, undef, 'start_at should again be undef'; 877is_deeply $engine->seen, [['current_state', undef]], 878 'Still should not have updated IDs or hashes'; 879 880# Have latest_item return a tag. 881$latest_change_id = $changes[1]->old_id; 882$updated_idx = 2; 883ok $engine->_sync_plan, 'Sync the plan to a tag'; 884is $plan->position, 2, 'Plan should now be at position 1'; 885is $engine->start_at, 'widgets@beta', 'start_at should now be widgets@beta'; 886is_deeply $engine->seen, [ 887 ['current_state', undef], 888 ['_update_ids'], 889 ['log_new_tags' => $plan->change_at(2)], 890], 'Should have updated IDs'; 891 892# Have current_state return a script hash. 893$script_hash = '550aeeab2ae39cba45840888b12a70820a2d6f83'; 894ok $engine->_sync_plan, 'Sync the plan with a random script hash'; 895is $plan->position, 2, 'Plan should now be at position 1'; 896is $engine->start_at, 'widgets@beta', 'start_at should now be widgets@beta'; 897is_deeply $engine->seen, [ 898 ['current_state', undef], 899 ['_update_ids'], 900 ['log_new_tags' => $plan->change_at(2)], 901], 'Should have updated IDs but not hashes'; 902 903# Have current_state return the last deployed ID as script_hash. 904$script_hash = $latest_change_id; 905ok $engine->_sync_plan, 'Sync the plan with a random script hash'; 906is $plan->position, 2, 'Plan should now be at position 1'; 907is $engine->start_at, 'widgets@beta', 'start_at should now be widgets@beta'; 908is_deeply $engine->seen, [ 909 ['current_state', undef], 910 ['_update_ids'], 911 ['_update_script_hashes'], 912 ['log_new_tags' => $plan->change_at(2)], 913], 'Should have updated IDs and hashes'; 914 915# Return no change ID, now. 916$script_hash = $latest_change_id = $changes[1]->id; 917ok $engine->_sync_plan, 'Sync the plan'; 918is $plan->position, 1, 'Plan should be at position 1'; 919is $engine->start_at, 'users@alpha', 'start_at should be users@alpha'; 920is_deeply $engine->seen, [ 921 ['current_state', undef], 922 ['_update_script_hashes'], 923 ['log_new_tags' => $plan->change_at(1)], 924], 'Should have updated hashes but not IDs'; 925 926############################################################################## 927# Test deploy. 928can_ok $CLASS, 'deploy'; 929$script_hash = undef; 930$latest_change_id = undef; 931$plan->reset; 932$engine->seen; 933@changes = $plan->changes; 934 935# Mock the deploy methods to log which were called. 936my $deploy_meth; 937for my $meth (qw(_deploy_all _deploy_by_tag _deploy_by_change)) { 938 my $orig = $CLASS->can($meth); 939 $mock_engine->mock($meth => sub { 940 $deploy_meth = $meth; 941 $orig->(@_); 942 }); 943} 944 945# Mock dependency checking to add its call to the seen stuff. 946$mock_engine->mock( check_deploy_dependencies => sub { 947 shift->mock_check_deploy(@_); 948}); 949$mock_engine->mock( check_revert_dependencies => sub { 950 shift->mock_check_revert(@_); 951}); 952 953ok $engine->deploy('@alpha'), 'Deploy to @alpha'; 954is $plan->position, 1, 'Plan should be at position 1'; 955is_deeply $engine->seen, [ 956 [current_state => undef], 957 'initialized', 958 'initialize', 959 'register_project', 960 [check_deploy_dependencies => [$plan, 1]], 961 [run_file => $changes[0]->deploy_file], 962 [log_deploy_change => $changes[0]], 963 [run_file => $changes[1]->deploy_file], 964 [log_deploy_change => $changes[1]], 965], 'Should have deployed through @alpha'; 966 967is $deploy_meth, '_deploy_all', 'Should have called _deploy_all()'; 968is_deeply +MockOutput->get_info, [ 969 [__x 'Adding registry tables to {destination}', 970 destination => $engine->registry_destination, 971 ], 972 [__x 'Deploying changes through {change} to {destination}', 973 destination => $engine->destination, 974 change => $plan->get('@alpha')->format_name_with_tags, 975 ], 976 [__ 'ok'], 977 [__ 'ok'], 978], 'Should have seen the output of the deploy to @alpha'; 979is_deeply +MockOutput->get_info_literal, [ 980 [' + roles ..', '.......', ' '], 981 [' + users @alpha ..', '', ' '], 982], 'Both change names should be output'; 983 984# Try with log-only in all modes. 985for my $mode (qw(change tag all)) { 986 ok $engine->log_only(1), 'Enable log_only'; 987 ok $engine->deploy('@alpha', $mode, 1), 'Log-only deploy in $mode mode to @alpha'; 988 is $plan->position, 1, 'Plan should be at position 1'; 989 is_deeply $engine->seen, [ 990 [current_state => undef], 991 'initialized', 992 'initialize', 993 'register_project', 994 [check_deploy_dependencies => [$plan, 1]], 995 [log_deploy_change => $changes[0]], 996 [log_deploy_change => $changes[1]], 997 ], 'Should have deployed through @alpha without running files'; 998 999 my $meth = $mode eq 'all' ? 'all' : ('by_' . $mode); 1000 is $deploy_meth, "_deploy_$meth", "Should have called _deploy_$meth()"; 1001 is_deeply +MockOutput->get_info, [ 1002 [ 1003 __x 'Adding registry tables to {destination}', 1004 destination => $engine->registry_destination, 1005 ], 1006 [ 1007 __x 'Deploying changes through {change} to {destination}', 1008 destination => $engine->destination, 1009 change => $plan->get('@alpha')->format_name_with_tags, 1010 ], 1011 [__ 'ok'], 1012 [__ 'ok'], 1013 ], 'Should have seen the output of the deploy to @alpha'; 1014 is_deeply +MockOutput->get_info_literal, [ 1015 [' + roles ..', '.......', ' '], 1016 [' + users @alpha ..', '', ' '], 1017 ], 'Both change names should be output'; 1018} 1019 1020# Try with no need to initialize. 1021$initialized = 1; 1022$plan->reset; 1023$engine->log_only(0); 1024ok $engine->deploy('@alpha', 'tag'), 'Deploy to @alpha with tag mode'; 1025is $plan->position, 1, 'Plan should again be at position 1'; 1026is_deeply $engine->seen, [ 1027 [current_state => undef], 1028 'initialized', 1029 'register_project', 1030 [check_deploy_dependencies => [$plan, 1]], 1031 [run_file => $changes[0]->deploy_file], 1032 [log_deploy_change => $changes[0]], 1033 [run_file => $changes[1]->deploy_file], 1034 [log_deploy_change => $changes[1]], 1035], 'Should have deployed through @alpha without initialization'; 1036 1037is $deploy_meth, '_deploy_by_tag', 'Should have called _deploy_by_tag()'; 1038is_deeply +MockOutput->get_info, [ 1039 [__x 'Deploying changes through {change} to {destination}', 1040 destination => $engine->registry_destination, 1041 change => $plan->get('@alpha')->format_name_with_tags, 1042 ], 1043 [__ 'ok'], 1044 [__ 'ok'], 1045], 'Should have seen the output of the deploy to @alpha'; 1046is_deeply +MockOutput->get_info_literal, [ 1047 [' + roles ..', '.......', ' '], 1048 [' + users @alpha ..', '', ' '], 1049], 'Both change names should be output'; 1050 1051# Try a bogus change. 1052throws_ok { $engine->deploy('nonexistent') } 'App::Sqitch::X', 1053 'Should get an error for an unknown change'; 1054is $@->message, __x( 1055 'Unknown change: "{change}"', 1056 change => 'nonexistent', 1057), 'The exception should report the unknown change'; 1058is_deeply $engine->seen, [ 1059 [current_state => undef], 1060], 'Only latest_item() should have been called'; 1061 1062# Start with @alpha. 1063$latest_change_id = ($changes[1]->tags)[0]->id; 1064ok $engine->deploy('@alpha'), 'Deploy to alpha thrice'; 1065is_deeply $engine->seen, [ 1066 [current_state => undef], 1067 ['log_new_tags' => $changes[1]], 1068], 'Only latest_item() should have been called'; 1069is_deeply +MockOutput->get_info, [ 1070 [__x 'Nothing to deploy (already at "{change}")', change => '@alpha'], 1071], 'Should notify user that already at @alpha'; 1072 1073# Start with widgets. 1074$latest_change_id = $changes[2]->id; 1075throws_ok { $engine->deploy('@alpha') } 'App::Sqitch::X', 1076 'Should fail changeing older change'; 1077is $@->ident, 'deploy', 'Should be a "deploy" error'; 1078is $@->message, __ 'Cannot deploy to an earlier change; use "revert" instead', 1079 'It should suggest using "revert"'; 1080is_deeply $engine->seen, [ 1081 [current_state => undef], 1082 ['log_new_tags' => $changes[2]], 1083], 'Should have called latest_item() and latest_tag()'; 1084 1085# Make sure we can deploy everything by change. 1086$latest_change_id = undef; 1087$plan->reset; 1088$plan->add( name => 'lolz', note => 'ha ha' ); 1089@changes = $plan->changes; 1090ok $engine->deploy(undef, 'change'), 'Deploy everything by change'; 1091is $plan->position, 3, 'Plan should be at position 3'; 1092is_deeply $engine->seen, [ 1093 [current_state => undef], 1094 'initialized', 1095 'register_project', 1096 [check_deploy_dependencies => [$plan, 3]], 1097 [run_file => $changes[0]->deploy_file], 1098 [log_deploy_change => $changes[0]], 1099 [run_file => $changes[1]->deploy_file], 1100 [log_deploy_change => $changes[1]], 1101 [run_file => $changes[2]->deploy_file], 1102 [log_deploy_change => $changes[2]], 1103 [run_file => $changes[3]->deploy_file], 1104 [log_deploy_change => $changes[3]], 1105], 'Should have deployed everything'; 1106 1107is $deploy_meth, '_deploy_by_change', 'Should have called _deploy_by_change()'; 1108is_deeply +MockOutput->get_info, [ 1109 [__x 'Deploying changes to {destination}', destination => $engine->destination ], 1110 [__ 'ok'], 1111 [__ 'ok'], 1112 [__ 'ok'], 1113 [__ 'ok'], 1114], 'Should have emitted deploy announcement and successes'; 1115 1116is_deeply +MockOutput->get_info_literal, [ 1117 [' + roles ..', '........', ' '], 1118 [' + users @alpha ..', '.', ' '], 1119 [' + widgets @beta ..', '', ' '], 1120 [' + lolz ..', '.........', ' '], 1121], 'Should have seen the output of the deploy to the end'; 1122 1123# If we deploy again, it should be up-to-date. 1124$latest_change_id = $changes[-1]->id; 1125ok $engine->deploy, 'Should return success for deploy to up-to-date DB'; 1126is_deeply +MockOutput->get_info, [ 1127 [__ 'Nothing to deploy (up-to-date)' ], 1128], 'Should have emitted deploy announcement and successes'; 1129is_deeply $engine->seen, [ 1130 [current_state => undef], 1131], 'It should have just fetched the latest change ID'; 1132 1133$latest_change_id = undef; 1134 1135# Try invalid mode. 1136throws_ok { $engine->deploy(undef, 'evil_mode') } 'App::Sqitch::X', 1137 'Should fail on invalid mode'; 1138is $@->ident, 'deploy', 'Should be a "deploy" error'; 1139is $@->message, __x('Unknown deployment mode: "{mode}"', mode => 'evil_mode'), 1140 'And the message should reflect the unknown mode'; 1141is_deeply $engine->seen, [ 1142 [current_state => undef], 1143 'initialized', 1144 'register_project', 1145 [check_deploy_dependencies => [$plan, 3]], 1146], 'It should have check for initialization'; 1147is_deeply +MockOutput->get_info, [ 1148 [__x 'Deploying changes to {destination}', destination => $engine->destination ], 1149], 'Should have announced destination'; 1150 1151# Try a plan with no changes. 1152NOSTEPS: { 1153 my $plan_file = file qw(empty.plan); 1154 my $fh = $plan_file->open('>') or die "Cannot open $plan_file: $!"; 1155 say $fh '%project=empty'; 1156 $fh->close or die "Error closing $plan_file: $!"; 1157 END { $plan_file->remove } 1158 my $sqitch = App::Sqitch->new( 1159 _engine => 'sqlite', 1160 plan_file => $plan_file, 1161 options => { 1162 engine => 'sqlite', 1163 plan_file => $plan_file->stringify, 1164 } 1165 ); 1166 my $target = App::Sqitch::Target->new(sqitch => $sqitch ); 1167 ok my $engine = App::Sqitch::Engine::whu->new( 1168 sqitch => $sqitch, 1169 target => $target, 1170 ), 'Engine with sqitch with no file'; 1171 $engine->max_name_length(10); 1172 throws_ok { $engine->deploy } 'App::Sqitch::X', 'Should die with no changes'; 1173 is $@->message, __"Nothing to deploy (empty plan)", 1174 'Should have the localized message'; 1175 is_deeply $engine->seen, [ 1176 [current_state => undef], 1177 ], 'It should have checked for the latest item'; 1178} 1179 1180############################################################################## 1181# Test _deploy_by_change() 1182$engine = App::Sqitch::Engine::whu->new(sqitch => $sqitch, target => $target); 1183$plan->reset; 1184$mock_engine->unmock('_deploy_by_change'); 1185$engine->max_name_length( 1186 max map { 1187 length $_->format_name_with_tags 1188 } $plan->changes 1189); 1190ok $engine->_deploy_by_change($plan, 1), 'Deploy changewise to index 1'; 1191is_deeply $engine->seen, [ 1192 [run_file => $changes[0]->deploy_file], 1193 [log_deploy_change => $changes[0]], 1194 [run_file => $changes[1]->deploy_file], 1195 [log_deploy_change => $changes[1]], 1196], 'Should changewise deploy to index 2'; 1197is_deeply +MockOutput->get_info_literal, [ 1198 [' + roles ..', '........', ' '], 1199 [' + users @alpha ..', '.', ' '], 1200], 'Should have seen output of each change'; 1201is_deeply +MockOutput->get_info, [[__ 'ok' ], [__ 'ok']], 1202 'Output should reflect deploy successes'; 1203 1204ok $engine->_deploy_by_change($plan, 3), 'Deploy changewise to index 2'; 1205is_deeply $engine->seen, [ 1206 [run_file => $changes[2]->deploy_file], 1207 [log_deploy_change => $changes[2]], 1208 [run_file => $changes[3]->deploy_file], 1209 [log_deploy_change => $changes[3]], 1210], 'Should changewise deploy to from index 2 to index 3'; 1211is_deeply +MockOutput->get_info_literal, [ 1212 [' + widgets @beta ..', '', ' '], 1213 [' + lolz ..', '.........', ' '], 1214], 'Should have seen output of changes 2-3'; 1215is_deeply +MockOutput->get_info, [[__ 'ok' ], [__ 'ok']], 1216 'Output should reflect deploy successes'; 1217 1218# Make it die. 1219$plan->reset; 1220$die = 'run_file'; 1221throws_ok { $engine->_deploy_by_change($plan, 2) } 'App::Sqitch::X', 1222 'Die in _deploy_by_change'; 1223is $@->message, 'AAAH!', 'It should have died in run_file'; 1224is_deeply $engine->seen, [ 1225 [log_fail_change => $changes[0] ], 1226], 'It should have logged the failure'; 1227is_deeply +MockOutput->get_info_literal, [ 1228 [' + roles ..', '........', ' '], 1229], 'Should have seen output for first change'; 1230is_deeply +MockOutput->get_info, [[__ 'not ok']], 1231 'Output should reflect deploy failure'; 1232$die = ''; 1233 1234############################################################################## 1235# Test _deploy_by_tag(). 1236$plan->reset; 1237$mock_engine->unmock('_deploy_by_tag'); 1238ok $engine->_deploy_by_tag($plan, 1), 'Deploy tagwise to index 1'; 1239 1240is_deeply $engine->seen, [ 1241 [run_file => $changes[0]->deploy_file], 1242 [log_deploy_change => $changes[0]], 1243 [run_file => $changes[1]->deploy_file], 1244 [log_deploy_change => $changes[1]], 1245], 'Should tagwise deploy to index 1'; 1246is_deeply +MockOutput->get_info_literal, [ 1247 [' + roles ..', '........', ' '], 1248 [' + users @alpha ..', '.', ' '], 1249], 'Should have seen output of each change'; 1250is_deeply +MockOutput->get_info, [[__ 'ok' ], [__ 'ok']], 1251 'Output should reflect deploy successes'; 1252 1253ok $engine->_deploy_by_tag($plan, 3), 'Deploy tagwise to index 3'; 1254is_deeply $engine->seen, [ 1255 [run_file => $changes[2]->deploy_file], 1256 [log_deploy_change => $changes[2]], 1257 [run_file => $changes[3]->deploy_file], 1258 [log_deploy_change => $changes[3]], 1259], 'Should tagwise deploy from index 2 to index 3'; 1260is_deeply +MockOutput->get_info_literal, [ 1261 [' + widgets @beta ..', '', ' '], 1262 [' + lolz ..', '.........', ' '], 1263], 'Should have seen output of changes 3-3'; 1264is_deeply +MockOutput->get_info, [[__ 'ok' ], [__ 'ok']], 1265 'Output should reflect deploy successes'; 1266 1267# Add another couple of changes. 1268$plan->add(name => 'tacos' ); 1269$plan->add(name => 'curry' ); 1270@changes = $plan->changes; 1271 1272# Make it die. 1273$plan->position(1); 1274my $mock_whu = Test::MockModule->new('App::Sqitch::Engine::whu'); 1275$mock_whu->mock(log_deploy_change => sub { hurl 'ROFL' if $_[1] eq $changes[-1] }); 1276throws_ok { $engine->_deploy_by_tag($plan, $#changes) } 'App::Sqitch::X', 1277 'Die in log_deploy_change'; 1278is $@->message, __('Deploy failed'), 'Should get final deploy failure message'; 1279is_deeply $engine->seen, [ 1280 [run_file => $changes[2]->deploy_file], 1281 [run_file => $changes[3]->deploy_file], 1282 [run_file => $changes[4]->deploy_file], 1283 [run_file => $changes[5]->deploy_file], 1284 [run_file => $changes[5]->revert_file], 1285 [log_fail_change => $changes[5] ], 1286 [run_file => $changes[4]->revert_file], 1287 [log_revert_change => $changes[4]], 1288 [run_file => $changes[3]->revert_file], 1289 [log_revert_change => $changes[3]], 1290], 'It should have reverted back to the last deployed tag'; 1291 1292is_deeply +MockOutput->get_info_literal, [ 1293 [' + widgets @beta ..', '', ' '], 1294 [' + lolz ..', '.........', ' '], 1295 [' + tacos ..', '........', ' '], 1296 [' + curry ..', '........', ' '], 1297 [' - tacos ..', '........', ' '], 1298 [' - lolz ..', '.........', ' '], 1299], 'Should have seen deploy and revert messages (excluding curry revert)'; 1300is_deeply +MockOutput->get_info, [ 1301 [__ 'ok' ], 1302 [__ 'ok' ], 1303 [__ 'ok' ], 1304 [__ 'not ok' ], 1305 [__ 'ok' ], 1306 [__ 'ok' ], 1307], 'Output should reflect deploy successes and failure'; 1308is_deeply +MockOutput->get_vent, [ 1309 ['ROFL'], 1310 [__x 'Reverting to {change}', change => 'widgets @beta'] 1311], 'The original error should have been vented'; 1312$mock_whu->unmock('log_deploy_change'); 1313 1314# Make it die with log-only. 1315$plan->position(1); 1316ok $engine->log_only(1), 'Enable log_only'; 1317$mock_whu->mock(log_deploy_change => sub { hurl 'ROFL' if $_[1] eq $changes[-1] }); 1318throws_ok { $engine->_deploy_by_tag($plan, $#changes, 1) } 'App::Sqitch::X', 1319 'Die in log_deploy_change log-only'; 1320is $@->message, __('Deploy failed'), 'Should get final deploy failure message'; 1321is_deeply $engine->seen, [ 1322 [log_fail_change => $changes[5] ], 1323 [log_revert_change => $changes[4]], 1324 [log_revert_change => $changes[3]], 1325], 'It should have run no deploy or revert scripts'; 1326 1327is_deeply +MockOutput->get_info_literal, [ 1328 [' + widgets @beta ..', '', ' '], 1329 [' + lolz ..', '.........', ' '], 1330 [' + tacos ..', '........', ' '], 1331 [' + curry ..', '........', ' '], 1332 [' - tacos ..', '........', ' '], 1333 [' - lolz ..', '.........', ' '], 1334], 'Should have seen deploy and revert messages (excluding curry revert)'; 1335is_deeply +MockOutput->get_info, [ 1336 [__ 'ok' ], 1337 [__ 'ok' ], 1338 [__ 'ok' ], 1339 [__ 'not ok' ], 1340 [__ 'ok' ], 1341 [__ 'ok' ], 1342], 'Output should reflect deploy successes and failure'; 1343is_deeply +MockOutput->get_vent, [ 1344 ['ROFL'], 1345 [__x 'Reverting to {change}', change => 'widgets @beta'] 1346], 'The original error should have been vented'; 1347$mock_whu->unmock('log_deploy_change'); 1348 1349# Now have it fail back to the beginning. 1350$plan->reset; 1351$engine->log_only(0); 1352$mock_whu->mock(run_file => sub { die 'ROFL' if $_[1]->basename eq 'users.sql' }); 1353throws_ok { $engine->_deploy_by_tag($plan, $plan->count -1 ) } 'App::Sqitch::X', 1354 'Die in _deploy_by_tag again'; 1355is $@->message, __('Deploy failed'), 'Should again get final deploy failure message'; 1356is_deeply $engine->seen, [ 1357 [log_deploy_change => $changes[0]], 1358 [log_fail_change => $changes[1]], 1359 [log_revert_change => $changes[0]], 1360], 'Should have logged back to the beginning'; 1361is_deeply +MockOutput->get_info_literal, [ 1362 [' + roles ..', '........', ' '], 1363 [' + users @alpha ..', '.', ' '], 1364 [' - roles ..', '........', ' '], 1365], 'Should have seen deploy and revert messages'; 1366is_deeply +MockOutput->get_info, [ 1367 [__ 'ok' ], 1368 [__ 'not ok' ], 1369 [__ 'ok' ], 1370], 'Output should reflect deploy successes and failure'; 1371my $vented = MockOutput->get_vent; 1372is @{ $vented }, 2, 'Should have one vented message'; 1373my $errmsg = shift @{ $vented->[0] }; 1374like $errmsg, qr/^ROFL\b/, 'And it should be the underlying error'; 1375is_deeply $vented, [ 1376 [], 1377 [__ 'Reverting all changes'], 1378], 'And it should had notified that all changes were reverted'; 1379 1380# Add a change and deploy to that, to make sure it rolls back any changes since 1381# last tag. 1382$plan->add(name => 'dr_evil' ); 1383@changes = $plan->changes; 1384$plan->reset; 1385$mock_whu->mock(run_file => sub { hurl 'ROFL' if $_[1]->basename eq 'dr_evil.sql' }); 1386throws_ok { $engine->_deploy_by_tag($plan, $plan->count -1 ) } 'App::Sqitch::X', 1387 'Die in _deploy_by_tag yet again'; 1388is $@->message, __('Deploy failed'), 'Should die "Deploy failed" again'; 1389is_deeply $engine->seen, [ 1390 [log_deploy_change => $changes[0]], 1391 [log_deploy_change => $changes[1]], 1392 [log_deploy_change => $changes[2]], 1393 [log_deploy_change => $changes[3]], 1394 [log_deploy_change => $changes[4]], 1395 [log_deploy_change => $changes[5]], 1396 [log_fail_change => $changes[6]], 1397 [log_revert_change => $changes[5] ], 1398 [log_revert_change => $changes[4] ], 1399 [log_revert_change => $changes[3] ], 1400], 'Should have reverted back to last tag'; 1401 1402is_deeply +MockOutput->get_info_literal, [ 1403 [' + roles ..', '........', ' '], 1404 [' + users @alpha ..', '.', ' '], 1405 [' + widgets @beta ..', '', ' '], 1406 [' + lolz ..', '.........', ' '], 1407 [' + tacos ..', '........', ' '], 1408 [' + curry ..', '........', ' '], 1409 [' + dr_evil ..', '......', ' '], 1410 [' - curry ..', '........', ' '], 1411 [' - tacos ..', '........', ' '], 1412 [' - lolz ..', '.........', ' '], 1413], 'Should have user change reversion messages'; 1414is_deeply +MockOutput->get_info, [ 1415 [__ 'ok' ], 1416 [__ 'ok' ], 1417 [__ 'ok' ], 1418 [__ 'ok' ], 1419 [__ 'ok' ], 1420 [__ 'ok' ], 1421 [__ 'not ok' ], 1422 [__ 'ok' ], 1423 [__ 'ok' ], 1424 [__ 'ok' ], 1425], 'Output should reflect deploy successes and failure'; 1426is_deeply +MockOutput->get_vent, [ 1427 ['ROFL'], 1428 [__x 'Reverting to {change}', change => 'widgets @beta'] 1429], 'Should see underlying error and reversion message'; 1430 1431# Make it choke on change reversion. 1432$mock_whu->unmock_all; 1433$die = ''; 1434$plan->reset; 1435$mock_whu->mock(run_file => sub { 1436 hurl 'ROFL' if $_[1] eq $changes[1]->deploy_file; 1437 hurl 'BARF' if $_[1] eq $changes[0]->revert_file; 1438}); 1439$mock_whu->mock(start_at => 'whatever'); 1440throws_ok { $engine->_deploy_by_tag($plan, $plan->count -1 ) } 'App::Sqitch::X', 1441 'Die in _deploy_by_tag again'; 1442is $@->message, __('Deploy failed'), 'Should once again get final deploy failure message'; 1443is_deeply $engine->seen, [ 1444 [log_deploy_change => $changes[0] ], 1445 [log_fail_change => $changes[1] ], 1446], 'Should have tried to revert one change'; 1447is_deeply +MockOutput->get_info_literal, [ 1448 [' + roles ..', '........', ' '], 1449 [' + users @alpha ..', '.', ' '], 1450 [' - roles ..', '........', ' '], 1451], 'Should have seen revert message'; 1452is_deeply +MockOutput->get_info, [ 1453 [__ 'ok' ], 1454 [__ 'not ok' ], 1455 [__ 'not ok' ], 1456], 'Output should reflect deploy successes and failure'; 1457is_deeply +MockOutput->get_vent, [ 1458 ['ROFL'], 1459 [__x 'Reverting to {change}', change => 'whatever'], 1460 ['BARF'], 1461 [__ 'The schema will need to be manually repaired'] 1462], 'Should get reversion failure message'; 1463$mock_whu->unmock_all; 1464 1465############################################################################## 1466# Test _deploy_all(). 1467$plan->reset; 1468$mock_engine->unmock('_deploy_all'); 1469ok $engine->_deploy_all($plan, 1), 'Deploy all to index 1'; 1470 1471is_deeply $engine->seen, [ 1472 [run_file => $changes[0]->deploy_file], 1473 [log_deploy_change => $changes[0]], 1474 [run_file => $changes[1]->deploy_file], 1475 [log_deploy_change => $changes[1]], 1476], 'Should tagwise deploy to index 1'; 1477is_deeply +MockOutput->get_info_literal, [ 1478 [' + roles ..', '........', ' '], 1479 [' + users @alpha ..', '.', ' '], 1480], 'Should have seen output of each change'; 1481is_deeply +MockOutput->get_info, [ 1482 [__ 'ok' ], 1483 [__ 'ok' ], 1484], 'Output should reflect deploy successes'; 1485 1486ok $engine->_deploy_all($plan, 2), 'Deploy tagwise to index 2'; 1487is_deeply $engine->seen, [ 1488 [run_file => $changes[2]->deploy_file], 1489 [log_deploy_change => $changes[2]], 1490], 'Should tagwise deploy to from index 1 to index 2'; 1491is_deeply +MockOutput->get_info_literal, [ 1492 [' + widgets @beta ..', '', ' '], 1493], 'Should have seen output of changes 3-4'; 1494is_deeply +MockOutput->get_info, [ 1495 [__ 'ok' ], 1496], 'Output should reflect deploy successe'; 1497 1498# Make it die. 1499$plan->reset; 1500$mock_whu->mock(log_deploy_change => sub { hurl 'ROFL' if $_[1] eq $changes[2] }); 1501throws_ok { $engine->_deploy_all($plan, 3) } 'App::Sqitch::X', 1502 'Die in _deploy_all'; 1503is $@->message, __('Deploy failed'), 'Should get final deploy failure message'; 1504$mock_whu->unmock('log_deploy_change'); 1505is_deeply $engine->seen, [ 1506 [run_file => $changes[0]->deploy_file], 1507 [run_file => $changes[1]->deploy_file], 1508 [run_file => $changes[2]->deploy_file], 1509 [run_file => $changes[2]->revert_file], 1510 [log_fail_change => $changes[2]], 1511 [run_file => $changes[1]->revert_file], 1512 [log_revert_change => $changes[1]], 1513 [run_file => $changes[0]->revert_file], 1514 [log_revert_change => $changes[0]], 1515], 'It should have logged up to the failure'; 1516 1517is_deeply +MockOutput->get_info_literal, [ 1518 [' + roles ..', '........', ' '], 1519 [' + users @alpha ..', '.', ' '], 1520 [' + widgets @beta ..', '', ' '], 1521 [' - users @alpha ..', '.', ' '], 1522 [' - roles ..', '........', ' '], 1523], 'Should have seen deploy and revert messages excluding revert for failed logging'; 1524is_deeply +MockOutput->get_info, [ 1525 [__ 'ok' ], 1526 [__ 'ok' ], 1527 [__ 'not ok' ], 1528 [__ 'ok' ], 1529 [__ 'ok' ], 1530], 'Output should reflect deploy successes and failures'; 1531is_deeply +MockOutput->get_vent, [ 1532 ['ROFL'], 1533 [__ 'Reverting all changes'], 1534], 'The original error should have been vented'; 1535$die = ''; 1536 1537# Make it die with log-only. 1538$plan->reset; 1539ok $engine->log_only(1), 'Enable log_only'; 1540$mock_whu->mock(log_deploy_change => sub { hurl 'ROFL' if $_[1] eq $changes[2] }); 1541throws_ok { $engine->_deploy_all($plan, 3, 1) } 'App::Sqitch::X', 1542 'Die in log-only _deploy_all'; 1543is $@->message, __('Deploy failed'), 'Should get final deploy failure message'; 1544$mock_whu->unmock('log_deploy_change'); 1545is_deeply $engine->seen, [ 1546 [log_fail_change => $changes[2]], 1547 [log_revert_change => $changes[1]], 1548 [log_revert_change => $changes[0]], 1549], 'It should have run no deploys or reverts'; 1550 1551is_deeply +MockOutput->get_info_literal, [ 1552 [' + roles ..', '........', ' '], 1553 [' + users @alpha ..', '.', ' '], 1554 [' + widgets @beta ..', '', ' '], 1555 [' - users @alpha ..', '.', ' '], 1556 [' - roles ..', '........', ' '], 1557], 'Should have seen deploy and revert messages excluding revert for failed logging'; 1558is_deeply +MockOutput->get_info, [ 1559 [__ 'ok' ], 1560 [__ 'ok' ], 1561 [__ 'not ok' ], 1562 [__ 'ok' ], 1563 [__ 'ok' ], 1564], 'Output should reflect deploy successes and failures'; 1565is_deeply +MockOutput->get_vent, [ 1566 ['ROFL'], 1567 [__ 'Reverting all changes'], 1568], 'The original error should have been vented'; 1569$die = ''; 1570 1571# Now have it fail on a later change, should still go all the way back. 1572$plan->reset; 1573$engine->log_only(0); 1574$mock_whu->mock(run_file => sub { hurl 'ROFL' if $_[1]->basename eq 'widgets.sql' }); 1575throws_ok { $engine->_deploy_all($plan, $plan->count -1 ) } 'App::Sqitch::X', 1576 'Die in _deploy_all again'; 1577is $@->message, __('Deploy failed'), 'Should again get final deploy failure message'; 1578is_deeply $engine->seen, [ 1579 [log_deploy_change => $changes[0]], 1580 [log_deploy_change => $changes[1]], 1581 [log_fail_change => $changes[2]], 1582 [log_revert_change => $changes[1]], 1583 [log_revert_change => $changes[0]], 1584], 'Should have reveted all changes and tags'; 1585is_deeply +MockOutput->get_info_literal, [ 1586 [' + roles ..', '........', ' '], 1587 [' + users @alpha ..', '.', ' '], 1588 [' + widgets @beta ..', '', ' '], 1589 [' - users @alpha ..', '.', ' '], 1590 [' - roles ..', '........', ' '], 1591], 'Should see all changes revert'; 1592is_deeply +MockOutput->get_info, [ 1593 [__ 'ok' ], 1594 [__ 'ok' ], 1595 [__ 'not ok' ], 1596 [__ 'ok' ], 1597 [__ 'ok' ], 1598], 'Output should reflect deploy successes and failures'; 1599is_deeply +MockOutput->get_vent, [ 1600 ['ROFL'], 1601 [__ 'Reverting all changes'], 1602], 'Should notifiy user of error and rollback'; 1603 1604# Die when starting from a later point. 1605$plan->position(2); 1606$engine->start_at('@alpha'); 1607$mock_whu->mock(run_file => sub { hurl 'ROFL' if $_[1]->basename eq 'dr_evil.sql' }); 1608throws_ok { $engine->_deploy_all($plan, $plan->count -1 ) } 'App::Sqitch::X', 1609 'Die in _deploy_all on the last change'; 1610is $@->message, __('Deploy failed'), 'Should once again get final deploy failure message'; 1611is_deeply $engine->seen, [ 1612 [log_deploy_change => $changes[3]], 1613 [log_deploy_change => $changes[4]], 1614 [log_deploy_change => $changes[5]], 1615 [log_fail_change => $changes[6]], 1616 [log_revert_change => $changes[5]], 1617 [log_revert_change => $changes[4]], 1618 [log_revert_change => $changes[3]], 1619], 'Should have deployed to dr_evil and revered down to @alpha'; 1620 1621is_deeply +MockOutput->get_info_literal, [ 1622 [' + lolz ..', '.........', ' '], 1623 [' + tacos ..', '........', ' '], 1624 [' + curry ..', '........', ' '], 1625 [' + dr_evil ..', '......', ' '], 1626 [' - curry ..', '........', ' '], 1627 [' - tacos ..', '........', ' '], 1628 [' - lolz ..', '.........', ' '], 1629], 'Should see changes revert back to @alpha'; 1630is_deeply +MockOutput->get_info, [ 1631 [__ 'ok' ], 1632 [__ 'ok' ], 1633 [__ 'ok' ], 1634 [__ 'not ok' ], 1635 [__ 'ok' ], 1636 [__ 'ok' ], 1637 [__ 'ok' ], 1638], 'Output should reflect deploy successes and failures'; 1639is_deeply +MockOutput->get_vent, [ 1640 ['ROFL'], 1641 [__x 'Reverting to {change}', change => '@alpha'], 1642], 'Should notifiy user of error and rollback to @alpha'; 1643$mock_whu->unmock_all; 1644 1645############################################################################## 1646# Test is_deployed(). 1647my $tag = App::Sqitch::Plan::Tag->new( 1648 name => 'foo', 1649 change => $change, 1650 plan => $target->plan, 1651); 1652$is_deployed_tag = $is_deployed_change = 1; 1653ok $engine->is_deployed($tag), 'Test is_deployed(tag)'; 1654is_deeply $engine->seen, [ 1655 [is_deployed_tag => $tag], 1656], 'It should have called is_deployed_tag()'; 1657 1658ok $engine->is_deployed($change), 'Test is_deployed(change)'; 1659is_deeply $engine->seen, [ 1660 [is_deployed_change => $change], 1661], 'It should have called is_deployed_change()'; 1662 1663############################################################################## 1664# Test deploy_change. 1665can_ok $engine, 'deploy_change'; 1666ok $engine->deploy_change($change), 'Deploy a change'; 1667is_deeply $engine->seen, [ 1668 [run_file => $change->deploy_file], 1669 [log_deploy_change => $change], 1670], 'It should have been deployed'; 1671is_deeply +MockOutput->get_info_literal, [ 1672 [' + foo ..', '..........', ' '] 1673], 'Should have shown change name'; 1674is_deeply +MockOutput->get_info, [ 1675 [__ 'ok' ], 1676], 'Output should reflect deploy success'; 1677 1678my $make_deps = sub { 1679 my $conflicts = shift; 1680 return map { 1681 my $dep = App::Sqitch::Plan::Depend->new( 1682 change => $_, 1683 plan => $plan, 1684 project => $plan->project, 1685 conflicts => $conflicts, 1686 ); 1687 $dep; 1688 } @_; 1689}; 1690 1691DEPLOYDIE: { 1692 my $mock_depend = Test::MockModule->new('App::Sqitch::Plan::Depend'); 1693 $mock_depend->mock(id => sub { undef }); 1694 1695 # Now make it die on the actual deploy. 1696 $die = 'log_deploy_change'; 1697 my @requires = $make_deps->( 0, qw(foo bar) ); 1698 my @conflicts = $make_deps->( 1, qw(dr_evil) ); 1699 my $change = App::Sqitch::Plan::Change->new( 1700 name => 'foo', 1701 plan => $target->plan, 1702 requires => \@requires, 1703 conflicts => \@conflicts, 1704 ); 1705 throws_ok { $engine->deploy_change($change) } 'App::Sqitch::X', 1706 'Shuld die on deploy failure'; 1707 is $@->message, __ 'Deploy failed', 'Should be told the deploy failed'; 1708 is_deeply $engine->seen, [ 1709 [run_file => $change->deploy_file], 1710 [run_file => $change->revert_file], 1711 [log_fail_change => $change], 1712 ], 'It should failed to have been deployed'; 1713 is_deeply +MockOutput->get_vent, [ 1714 ['AAAH!'], 1715 ], 'Should have vented the original error'; 1716 is_deeply +MockOutput->get_info_literal, [ 1717 [' + foo ..', '..........', ' '], 1718 ], 'Should have shown change name'; 1719 is_deeply +MockOutput->get_info, [ 1720 [__ 'not ok' ], 1721 ], 'Output should reflect deploy failure'; 1722 $die = ''; 1723} 1724 1725############################################################################## 1726# Test revert_change(). 1727can_ok $engine, 'revert_change'; 1728ok $engine->revert_change($change), 'Revert the change'; 1729is_deeply $engine->seen, [ 1730 [run_file => $change->revert_file], 1731 [log_revert_change => $change], 1732], 'It should have been reverted'; 1733is_deeply +MockOutput->get_info_literal, [ 1734 [' - foo ..', '..........', ' '] 1735], 'Should have shown reverted change name'; 1736is_deeply +MockOutput->get_info, [ 1737 [__ 'ok'], 1738], 'And the revert failure should be "ok"'; 1739 1740############################################################################## 1741# Test revert(). 1742can_ok $engine, 'revert'; 1743$engine->plan($plan); 1744 1745# Start with no deployed IDs. 1746@deployed_changes = (); 1747throws_ok { $engine->revert } 'App::Sqitch::X', 1748 'Should get exception for no changes to revert'; 1749is $@->ident, 'revert', 'Should be a revert exception'; 1750is $@->message, __ 'Nothing to revert (nothing deployed)', 1751 'Should have notified that there is nothing to revert'; 1752is $@->exitval, 1, 'Exit val should be 1'; 1753is_deeply $engine->seen, [ 1754 [deployed_changes => undef], 1755], 'It should only have called deployed_changes()'; 1756is_deeply +MockOutput->get_info, [], 'Nothing should have been output'; 1757 1758# Try reverting to an unknown change. 1759throws_ok { $engine->revert('nonexistent') } 'App::Sqitch::X', 1760 'Revert should die on unknown change'; 1761is $@->ident, 'revert', 'Should be another "revert" error'; 1762is $@->message, __x( 1763 'Unknown change: "{change}"', 1764 change => 'nonexistent', 1765), 'The message should mention it is an unknown change'; 1766is_deeply $engine->seen, [['change_id_for', { 1767 change_id => undef, 1768 change => 'nonexistent', 1769 tag => undef, 1770 project => 'sql', 1771}]], 'Should have called change_id_for() with change name'; 1772is_deeply +MockOutput->get_info, [], 'Nothing should have been output'; 1773 1774# Try reverting to an unknown change ID. 1775throws_ok { $engine->revert('8d77c5f588b60bc0f2efcda6369df5cb0177521d') } 'App::Sqitch::X', 1776 'Revert should die on unknown change ID'; 1777is $@->ident, 'revert', 'Should be another "revert" error'; 1778is $@->message, __x( 1779 'Unknown change: "{change}"', 1780 change => '8d77c5f588b60bc0f2efcda6369df5cb0177521d', 1781), 'The message should mention it is an unknown change'; 1782is_deeply $engine->seen, [['change_id_for', { 1783 change_id => '8d77c5f588b60bc0f2efcda6369df5cb0177521d', 1784 change => undef, 1785 tag => undef, 1786 project => 'sql', 1787}]], 'Shoudl have called change_id_for() with change ID'; 1788is_deeply +MockOutput->get_info, [], 'Nothing should have been output'; 1789 1790# Revert an undeployed change. 1791throws_ok { $engine->revert('@alpha') } 'App::Sqitch::X', 1792 'Revert should die on undeployed change'; 1793is $@->ident, 'revert', 'Should be another "revert" error'; 1794is $@->message, __x( 1795 'Change not deployed: "{change}"', 1796 change => '@alpha', 1797), 'The message should mention that the change is not deployed'; 1798is_deeply $engine->seen, [['change_id_for', { 1799 change => '', 1800 change_id => undef, 1801 tag => 'alpha', 1802 project => 'sql', 1803}]], 'change_id_for'; 1804is_deeply +MockOutput->get_info, [], 'Nothing should have been output'; 1805 1806# Revert to a point with no following changes. 1807$offset_change = $changes[0]; 1808push @resolved => $offset_change->id; 1809throws_ok { $engine->revert($changes[0]->id) } 'App::Sqitch::X', 1810 'Should get error reverting when no subsequent changes'; 1811is $@->ident, 'revert', 'No subsequent change error ident should be "revert"'; 1812is $@->exitval, 1, 'No subsequent change error exitval should be 1'; 1813is $@->message, __x( 1814 'No changes deployed since: "{change}"', 1815 change => $changes[0]->id, 1816), 'No subsequent change error message should be correct'; 1817 1818delete $changes[0]->{_rework_tags}; # For deep comparison. 1819is_deeply $engine->seen, [ 1820 [change_id_for => { 1821 change_id => $changes[0]->id, 1822 change => undef, 1823 tag => undef, 1824 project => 'sql', 1825 }], 1826 [ change_offset_from_id => [$changes[0]->id, 0] ], 1827 [deployed_changes_since => $changes[0]], 1828], 'Should have called change_id_for and deployed_changes_since'; 1829 1830# Revert with nothing deployed. 1831throws_ok { $engine->revert } 'App::Sqitch::X', 1832 'Should get error for known but undeployed change'; 1833is $@->ident, 'revert', 'No changes error should be "revert"'; 1834is $@->exitval, 1, 'No changes exitval should be 1'; 1835is $@->message, __ 'Nothing to revert (nothing deployed)', 1836 'No changes message should be correct'; 1837 1838is_deeply $engine->seen, [ 1839 [deployed_changes => undef], 1840], 'Should have called deployed_changes'; 1841 1842# Now revert from a deployed change. 1843my @dbchanges; 1844@deployed_changes = map { 1845 my $plan_change = $_; 1846 my $params = { 1847 id => $plan_change->id, 1848 name => $plan_change->name, 1849 project => $plan_change->project, 1850 note => $plan_change->note, 1851 planner_name => $plan_change->planner_name, 1852 planner_email => $plan_change->planner_email, 1853 timestamp => $plan_change->timestamp, 1854 tags => [ map { $_->name } $plan_change->tags ], 1855 }; 1856 push @dbchanges => my $db_change = App::Sqitch::Plan::Change->new( 1857 plan => $plan, 1858 %{ $params }, 1859 ); 1860 $db_change->add_tag( App::Sqitch::Plan::Tag->new( 1861 name => $_->name, plan => $plan, change => $db_change 1862 ) ) for $plan_change->tags; 1863 $db_change->tags; # Autovivify _tags For changes with no tags. 1864 $params; 1865} @changes[0..3]; 1866 1867MockOutput->ask_y_n_returns(1); 1868ok $engine->revert, 'Revert all changes'; 1869is_deeply $engine->seen, [ 1870 [deployed_changes => undef], 1871 [check_revert_dependencies => [reverse @dbchanges[0..3]] ], 1872 [run_file => $dbchanges[3]->revert_file ], 1873 [log_revert_change => $dbchanges[3] ], 1874 [run_file => $dbchanges[2]->revert_file ], 1875 [log_revert_change => $dbchanges[2] ], 1876 [run_file => $dbchanges[1]->revert_file ], 1877 [log_revert_change => $dbchanges[1] ], 1878 [run_file => $dbchanges[0]->revert_file ], 1879 [log_revert_change => $dbchanges[0] ], 1880], 'Should have reverted the changes in reverse order'; 1881is_deeply +MockOutput->get_ask_y_n, [ 1882 [__x( 1883 'Revert all changes from {destination}?', 1884 destination => $engine->destination, 1885 ), 'Yes'], 1886], 'Should have prompted to revert all changes'; 1887is_deeply +MockOutput->get_info_literal, [ 1888 [' - lolz ..', '.........', ' '], 1889 [' - widgets @beta ..', '', ' '], 1890 [' - users @alpha ..', '.', ' '], 1891 [' - roles ..', '........', ' '], 1892], 'It should have said it was reverting all changes and listed them'; 1893is_deeply +MockOutput->get_info, [ 1894 [__ 'ok'], 1895 [__ 'ok'], 1896 [__ 'ok'], 1897 [__ 'ok'], 1898], 'And the revert successes should be emitted'; 1899 1900# Try with log-only. 1901ok $engine->log_only(1), 'Enable log_only'; 1902ok $engine->revert(undef, 1), 'Revert all changes log-only'; 1903delete @{ $_ }{qw(_path_segments _rework_tags)} for @dbchanges; # These need to be invisible. 1904is_deeply $engine->seen, [ 1905 [deployed_changes => undef], 1906 [check_revert_dependencies => [reverse @dbchanges[0..3]] ], 1907 [log_revert_change => $dbchanges[3] ], 1908 [log_revert_change => $dbchanges[2] ], 1909 [log_revert_change => $dbchanges[1] ], 1910 [log_revert_change => $dbchanges[0] ], 1911], 'Log-only Should have reverted the changes in reverse order'; 1912is_deeply +MockOutput->get_ask_y_n, [ 1913 [__x( 1914 'Revert all changes from {destination}?', 1915 destination => $engine->destination, 1916 ), 'Yes'], 1917], 'Log-only should have prompted to revert all changes'; 1918is_deeply +MockOutput->get_info_literal, [ 1919 [' - lolz ..', '.........', ' '], 1920 [' - widgets @beta ..', '', ' '], 1921 [' - users @alpha ..', '.', ' '], 1922 [' - roles ..', '........', ' '], 1923], 'It should have said it was reverting all changes and listed them'; 1924is_deeply +MockOutput->get_info, [ 1925 [__ 'ok'], 1926 [__ 'ok'], 1927 [__ 'ok'], 1928 [__ 'ok'], 1929], 'And the revert successes should be emitted'; 1930 1931# Should exit if the revert is declined. 1932MockOutput->ask_y_n_returns(0); 1933throws_ok { $engine->revert } 'App::Sqitch::X', 'Should abort declined revert'; 1934is $@->ident, 'revert', 'Declined revert ident should be "revert"'; 1935is $@->exitval, 1, 'Should have exited with value 1'; 1936is $@->message, __ 'Nothing reverted', 'Should have exited with proper message'; 1937is_deeply $engine->seen, [ 1938 [deployed_changes => undef], 1939], 'Should have called deployed_changes only'; 1940is_deeply +MockOutput->get_ask_y_n, [ 1941 [__x( 1942 'Revert all changes from {destination}?', 1943 destination => $engine->destination, 1944 ), 'Yes'], 1945], 'Should have prompt to revert all changes'; 1946is_deeply +MockOutput->get_info, [ 1947], 'It should have emitted nothing else'; 1948 1949# Revert all changes with no prompt. 1950MockOutput->ask_y_n_returns(1); 1951$engine->log_only(0); 1952$engine->no_prompt(1); 1953ok $engine->revert, 'Revert all changes with no prompt'; 1954is_deeply $engine->seen, [ 1955 [deployed_changes => undef], 1956 [check_revert_dependencies => [reverse @dbchanges[0..3]] ], 1957 [run_file => $dbchanges[3]->revert_file ], 1958 [log_revert_change => $dbchanges[3] ], 1959 [run_file => $dbchanges[2]->revert_file ], 1960 [log_revert_change => $dbchanges[2] ], 1961 [run_file => $dbchanges[1]->revert_file ], 1962 [log_revert_change => $dbchanges[1] ], 1963 [run_file => $dbchanges[0]->revert_file ], 1964 [log_revert_change => $dbchanges[0] ], 1965], 'Should have reverted the changes in reverse order'; 1966is_deeply +MockOutput->get_ask_y_n, [], 'Should have no prompt'; 1967 1968is_deeply +MockOutput->get_info_literal, [ 1969 [' - lolz ..', '.........', ' '], 1970 [' - widgets @beta ..', '', ' '], 1971 [' - users @alpha ..', '.', ' '], 1972 [' - roles ..', '........', ' '], 1973], 'It should have said it was reverting all changes and listed them'; 1974is_deeply +MockOutput->get_info, [ 1975 [__x( 1976 'Reverting all changes from {destination}', 1977 destination => $engine->destination, 1978 )], 1979 [__ 'ok'], 1980 [__ 'ok'], 1981 [__ 'ok'], 1982 [__ 'ok'], 1983], 'And the revert successes should be emitted'; 1984 1985# Now just revert to an earlier change. 1986$engine->no_prompt(0); 1987$offset_change = $dbchanges[1]; 1988push @resolved => $offset_change->id; 1989@deployed_changes = @deployed_changes[2..3]; 1990ok $engine->revert('@alpha'), 'Revert to @alpha'; 1991 1992delete $dbchanges[1]->{_rework_tags}; # These need to be invisible. 1993is_deeply $engine->seen, [ 1994 [change_id_for => { change_id => undef, change => '', tag => 'alpha', project => 'sql' }], 1995 [ change_offset_from_id => [$dbchanges[1]->id, 0] ], 1996 [deployed_changes_since => $dbchanges[1]], 1997 [check_revert_dependencies => [reverse @dbchanges[2..3]] ], 1998 [run_file => $dbchanges[3]->revert_file ], 1999 [log_revert_change => $dbchanges[3] ], 2000 [run_file => $dbchanges[2]->revert_file ], 2001 [log_revert_change => $dbchanges[2] ], 2002], 'Should have reverted only changes after @alpha'; 2003is_deeply +MockOutput->get_ask_y_n, [ 2004 [__x( 2005 'Revert changes to {change} from {destination}?', 2006 destination => $engine->destination, 2007 change => $dbchanges[1]->format_name_with_tags, 2008 ), 'Yes'], 2009], 'Should have prompt to revert to change'; 2010is_deeply +MockOutput->get_info_literal, [ 2011 [' - lolz ..', '.........', ' '], 2012 [' - widgets @beta ..', '', ' '], 2013], 'Output should show what it reverts to'; 2014is_deeply +MockOutput->get_info, [ 2015 [__ 'ok'], 2016 [__ 'ok'], 2017], 'And the revert successes should be emitted'; 2018 2019MockOutput->ask_y_n_returns(0); 2020$offset_change = $dbchanges[1]; 2021push @resolved => $offset_change->id; 2022throws_ok { $engine->revert('@alpha') } 'App::Sqitch::X', 2023 'Should abort declined revert to @alpha'; 2024is $@->ident, 'revert:confirm', 'Declined revert ident should be "revert:confirm"'; 2025is $@->exitval, 1, 'Should have exited with value 1'; 2026is $@->message, __ 'Nothing reverted', 'Should have exited with proper message'; 2027is_deeply $engine->seen, [ 2028 [change_id_for => { change_id => undef, change => '', tag => 'alpha', project => 'sql' }], 2029 [change_offset_from_id => [$dbchanges[1]->id, 0] ], 2030 [deployed_changes_since => $dbchanges[1]], 2031], 'Should have called revert methods'; 2032is_deeply +MockOutput->get_ask_y_n, [ 2033 [__x( 2034 'Revert changes to {change} from {destination}?', 2035 change => $dbchanges[1]->format_name_with_tags, 2036 destination => $engine->destination, 2037 ), 'Yes'], 2038], 'Should have prompt to revert to @alpha'; 2039is_deeply +MockOutput->get_info, [ 2040], 'It should have emitted nothing else'; 2041 2042# Try to revert just the last change with no prompt 2043MockOutput->ask_y_n_returns(1); 2044$engine->no_prompt(1); 2045my $rev_file = $dbchanges[-1]->revert_file; # Grab before deleting _rework_tags. 2046my $rtags = delete $dbchanges[-1]->{_rework_tags}; # These need to be invisible. 2047$offset_change = $dbchanges[-1]; 2048push @resolved => $offset_change->id; 2049@deployed_changes = $deployed_changes[-1]; 2050ok $engine->revert('@HEAD^'), 'Revert to @HEAD^'; 2051is_deeply $engine->seen, [ 2052 [change_id_for => { change_id => undef, change => '', tag => 'HEAD', project => 'sql' }], 2053 [change_offset_from_id => [$dbchanges[-1]->id, -1] ], 2054 [deployed_changes_since => $dbchanges[-1]], 2055 [check_revert_dependencies => [{ %{ $dbchanges[-1] }, _rework_tags => $rtags }] ], 2056 [run_file => $rev_file ], 2057 [log_revert_change => { %{ $dbchanges[-1] }, _rework_tags => $rtags } ], 2058], 'Should have reverted one changes for @HEAD^'; 2059is_deeply +MockOutput->get_ask_y_n, [], 'Should have no prompt'; 2060is_deeply +MockOutput->get_info_literal, [ 2061 [' - lolz ..', '', ' '], 2062], 'Output should show what it reverts to'; 2063is_deeply +MockOutput->get_info, [ 2064 [__x( 2065 'Reverting changes to {change} from {destination}', 2066 destination => $engine->destination, 2067 change => $dbchanges[-1]->format_name_with_tags, 2068 )], 2069 [__ 'ok'], 2070], 'And the header and "ok" should be emitted'; 2071 2072############################################################################## 2073# Test change_id_for_depend(). 2074can_ok $CLASS, 'change_id_for_depend'; 2075 2076$offset_change = $dbchanges[1]; 2077my ($dep) = $make_deps->( 1, 'foo' ); 2078throws_ok { $engine->change_id_for_depend( $dep ) } 'App::Sqitch::X', 2079 'Should get error from change_id_for_depend when change not in plan'; 2080is $@->ident, 'plan', 'Should get ident "plan" from change_id_for_depend'; 2081is $@->message, __x( 2082 'Unable to find change "{change}" in plan {file}', 2083 change => $dep->key_name, 2084 file => $target->plan_file, 2085), 'Should have proper message from change_id_for_depend error'; 2086 2087PLANOK: { 2088 my $mock_depend = Test::MockModule->new('App::Sqitch::Plan::Depend'); 2089 $mock_depend->mock(id => sub { undef }); 2090 $mock_depend->mock(change => sub { undef }); 2091 throws_ok { $engine->change_id_for_depend( $dep ) } 'App::Sqitch::X', 2092 'Should get error from change_id_for_depend when no ID'; 2093 is $@->ident, 'engine', 'Should get ident "engine" when no ID'; 2094 is $@->message, __x( 2095 'Invalid dependency: {dependency}', 2096 dependency => $dep->as_string, 2097 ), 'Should have proper messag from change_id_for_depend error'; 2098 2099 # Let it have the change. 2100 $mock_depend->unmock('change'); 2101 2102 push @resolved => $changes[1]->id; 2103 is $engine->change_id_for_depend( $dep ), $changes[1]->id, 2104 'Get a change id'; 2105 is_deeply $engine->seen, [ 2106 [change_id_for => { 2107 change_id => $dep->id, 2108 change => $dep->change, 2109 tag => $dep->tag, 2110 project => $dep->project, 2111 }], 2112 ], 'Should have passed dependency params to change_id_for()'; 2113} 2114 2115############################################################################## 2116# Test find_change(). 2117can_ok $CLASS, 'find_change'; 2118push @resolved => $dbchanges[1]->id; 2119is $engine->find_change( 2120 change_id => $resolved[0], 2121 change => 'hi', 2122 tag => 'yo', 2123), $dbchanges[1], 'find_change() should work'; 2124is_deeply $engine->seen, [ 2125 [change_id_for => { 2126 change_id => $dbchanges[1]->id, 2127 change => 'hi', 2128 tag => 'yo', 2129 project => 'sql', 2130 }], 2131 [change_offset_from_id => [ $dbchanges[1]->id, undef ]], 2132], 'Its parameters should have been passed to change_id_for and change_offset_from_id'; 2133 2134# Pass a project and an ofset. 2135push @resolved => $dbchanges[1]->id; 2136is $engine->find_change( 2137 change => 'hi', 2138 offset => 1, 2139 project => 'fred', 2140), $dbchanges[1], 'find_change() should work'; 2141is_deeply $engine->seen, [ 2142 [change_id_for => { 2143 change_id => undef, 2144 change => 'hi', 2145 tag => undef, 2146 project => 'fred', 2147 }], 2148 [change_offset_from_id => [ $dbchanges[1]->id, 1 ]], 2149], 'Project and offset should have been passed off'; 2150 2151############################################################################## 2152# Test find_change_id(). 2153can_ok $CLASS, 'find_change_id'; 2154push @resolved => $dbchanges[1]->id; 2155is $engine->find_change_id( 2156 change_id => $resolved[0], 2157 change => 'hi', 2158 tag => 'yo', 2159), $dbchanges[1]->id, 'find_change_id() should work'; 2160is_deeply $engine->seen, [ 2161 [change_id_for => { 2162 change_id => $dbchanges[1]->id, 2163 change => 'hi', 2164 tag => 'yo', 2165 project => 'sql', 2166 }], 2167 [change_id_offset_from_id => [ $dbchanges[1]->id, undef ]], 2168], 'Its parameters should have been passed to change_id_for and change_offset_from_id'; 2169 2170# Pass a project and an ofset. 2171push @resolved => $dbchanges[1]->id; 2172is $engine->find_change_id( 2173 change => 'hi', 2174 offset => 1, 2175 project => 'fred', 2176), $dbchanges[1]->id, 'find_change_id() should work'; 2177is_deeply $engine->seen, [ 2178 [change_id_for => { 2179 change_id => undef, 2180 change => 'hi', 2181 tag => undef, 2182 project => 'fred', 2183 }], 2184 [change_id_offset_from_id => [ $dbchanges[1]->id, 1 ]], 2185], 'Project and offset should have been passed off'; 2186 2187############################################################################## 2188# Test verify_change(). 2189can_ok $CLASS, 'verify_change'; 2190$change = App::Sqitch::Plan::Change->new( name => 'users', plan => $target->plan ); 2191ok $engine->verify_change($change), 'Verify a change'; 2192is_deeply $engine->seen, [ 2193 [run_file => $change->verify_file ], 2194], 'The change file should have been run'; 2195is_deeply +MockOutput->get_info, [], 'Should have no info output'; 2196 2197# Try a change with no verify script. 2198$change = App::Sqitch::Plan::Change->new( name => 'roles', plan => $target->plan ); 2199ok $engine->verify_change($change), 'Verify a change with no verify script.'; 2200is_deeply $engine->seen, [], 'No abstract methods should be called'; 2201is_deeply +MockOutput->get_info, [], 'Should have no info output'; 2202is_deeply +MockOutput->get_vent, [ 2203 [__x 'Verify script {file} does not exist', file => $change->verify_file], 2204], 'A warning about no verify file should have been emitted'; 2205 2206############################################################################## 2207# Test check_deploy_dependenices(). 2208$mock_engine->unmock('check_deploy_dependencies'); 2209can_ok $engine, 'check_deploy_dependencies'; 2210 2211CHECK_DEPLOY_DEPEND: { 2212 # Make sure dependencies check out for all the existing changes. 2213 $plan->reset; 2214 ok $engine->check_deploy_dependencies($plan), 2215 'All planned changes should be okay'; 2216 is_deeply $engine->seen, [ 2217 [ are_deployed_changes => [map { $plan->change_at($_) } 0..$plan->count - 1] ], 2218 ], 'Should have called are_deployed_changes'; 2219 2220 # Make sure it works when depending on a previous change. 2221 my $change = $plan->change_at(3); 2222 push @{ $change->_requires } => $make_deps->( 0, 'users' ); 2223 ok $engine->check_deploy_dependencies($plan), 2224 'Dependencies should check out even when within those to be deployed'; 2225 is_deeply [ map { $_->resolved_id } map { $_->requires } $plan->changes ], 2226 [ $plan->change_at(1)->id ], 2227 'Resolved ID should be populated'; 2228 2229 # Make sure it fails if there is a conflict within those to be deployed. 2230 push @{ $change->_conflicts } => $make_deps->( 1, 'widgets' ); 2231 throws_ok { $engine->check_deploy_dependencies($plan) } 'App::Sqitch::X', 2232 'Conflict should throw exception'; 2233 is $@->ident, 'deploy', 'Should be a "deploy" error'; 2234 is $@->message, __nx( 2235 'Conflicts with previously deployed change: {changes}', 2236 'Conflicts with previously deployed changes: {changes}', 2237 scalar 1, 2238 changes => 'widgets', 2239 ), 'Should have localized message about the local conflict'; 2240 shift @{ $change->_conflicts }; 2241 2242 # Now test looking stuff up in the database. 2243 my $mock_depend = Test::MockModule->new('App::Sqitch::Plan::Depend'); 2244 my @depend_ids; 2245 $mock_depend->mock(id => sub { shift @depend_ids }); 2246 2247 my @conflicts = $make_deps->( 1, qw(foo bar) ); 2248 $change = App::Sqitch::Plan::Change->new( 2249 name => 'foo', 2250 plan => $target->plan, 2251 conflicts => \@conflicts, 2252 ); 2253 $plan->_changes->append($change); 2254 2255 my $start_from = $plan->count - 1; 2256 $plan->position( $start_from - 1); 2257 push @resolved, '2342', '253245'; 2258 throws_ok { $engine->check_deploy_dependencies($plan, $start_from) } 'App::Sqitch::X', 2259 'Conflict should throw exception'; 2260 is $@->ident, 'deploy', 'Should be a "deploy" error'; 2261 is $@->message, __nx( 2262 'Conflicts with previously deployed change: {changes}', 2263 'Conflicts with previously deployed changes: {changes}', 2264 scalar 2, 2265 changes => 'foo bar', 2266 ), 'Should have localized message about conflicts'; 2267 2268 is_deeply $engine->seen, [ 2269 [ are_deployed_changes => [map { $plan->change_at($_) } 0..$start_from-1] ], 2270 [ change_id_for => { 2271 change_id => undef, 2272 change => 'foo', 2273 tag => undef, 2274 project => 'sql', 2275 } ], 2276 [ change_id_for => { 2277 change_id => undef, 2278 change => 'bar', 2279 tag => undef, 2280 project => 'sql', 2281 } ], 2282 ], 'Should have called change_id_for() twice'; 2283 is_deeply [ map { $_->resolved_id } @conflicts ], [undef, undef], 2284 'Conflicting dependencies should have no resolved IDs'; 2285 2286 # Fail with multiple conflicts. 2287 push @{ $plan->change_at(3)->_conflicts } => $make_deps->( 1, 'widgets' ); 2288 $plan->reset; 2289 push @depend_ids => $plan->change_at(2)->id; 2290 push @resolved, '2342', '253245', '2323434'; 2291 throws_ok { $engine->check_deploy_dependencies($plan) } 'App::Sqitch::X', 2292 'Conflict should throw another exception'; 2293 is $@->ident, 'deploy', 'Should be a "deploy" error'; 2294 is $@->message, __nx( 2295 'Conflicts with previously deployed change: {changes}', 2296 'Conflicts with previously deployed changes: {changes}', 2297 scalar 3, 2298 changes => 'widgets foo bar', 2299 ), 'Should have localized message about all three conflicts'; 2300 2301 is_deeply $engine->seen, [ 2302 [ change_id_for => { 2303 change_id => undef, 2304 change => 'users', 2305 tag => undef, 2306 project => 'sql', 2307 } ], 2308 [ change_id_for => { 2309 change_id => undef, 2310 change => 'foo', 2311 tag => undef, 2312 project => 'sql', 2313 } ], 2314 [ change_id_for => { 2315 change_id => undef, 2316 change => 'bar', 2317 tag => undef, 2318 project => 'sql', 2319 } ], 2320 ], 'Should have called change_id_for() twice'; 2321 is_deeply [ map { $_->resolved_id } @conflicts ], [undef, undef], 2322 'Conflicting dependencies should have no resolved IDs'; 2323 2324 ########################################################################## 2325 # Die on missing dependencies. 2326 my @requires = $make_deps->( 0, qw(foo bar) ); 2327 $change = App::Sqitch::Plan::Change->new( 2328 name => 'blah', 2329 plan => $target->plan, 2330 requires => \@requires, 2331 ); 2332 $plan->_changes->append($change); 2333 $start_from = $plan->count - 1; 2334 $plan->position( $start_from - 1); 2335 2336 push @resolved, undef, undef; 2337 throws_ok { $engine->check_deploy_dependencies($plan, $start_from) } 'App::Sqitch::X', 2338 'Missing dependencies should throw exception'; 2339 is $@->ident, 'deploy', 'Should be another "deploy" error'; 2340 is $@->message, __nx( 2341 'Missing required change: {changes}', 2342 'Missing required changes: {changes}', 2343 scalar 2, 2344 changes => 'foo bar', 2345 ), 'Should have localized message missing dependencies'; 2346 2347 is_deeply $engine->seen, [ 2348 [ change_id_for => { 2349 change_id => undef, 2350 change => 'foo', 2351 tag => undef, 2352 project => 'sql', 2353 } ], 2354 [ change_id_for => { 2355 change_id => undef, 2356 change => 'bar', 2357 tag => undef, 2358 project => 'sql', 2359 } ], 2360 ], 'Should have called check_requires'; 2361 is_deeply [ map { $_->resolved_id } @requires ], [undef, undef], 2362 'Missing requirements should not have resolved'; 2363 2364 # Make sure we see both conflict and prereq failures. 2365 push @resolved, '2342', '253245', '2323434', undef, undef; 2366 $plan->reset; 2367 2368 throws_ok { $engine->check_deploy_dependencies($plan, $start_from) } 'App::Sqitch::X', 2369 'Missing dependencies should throw exception'; 2370 is $@->ident, 'deploy', 'Should be another "deploy" error'; 2371 is $@->message, join( 2372 "\n", 2373 __nx( 2374 'Conflicts with previously deployed change: {changes}', 2375 'Conflicts with previously deployed changes: {changes}', 2376 scalar 3, 2377 changes => 'widgets foo', 2378 ), 2379 __nx( 2380 'Missing required change: {changes}', 2381 'Missing required changes: {changes}', 2382 scalar 2, 2383 changes => 'foo bar', 2384 ), 2385 ), 'Should have localized conflicts and required error messages'; 2386 2387 is_deeply $engine->seen, [ 2388 [ change_id_for => { 2389 change_id => undef, 2390 change => 'widgets', 2391 tag => undef, 2392 project => 'sql', 2393 } ], 2394 [ change_id_for => { 2395 change_id => undef, 2396 change => 'users', 2397 tag => undef, 2398 project => 'sql', 2399 } ], 2400 [ change_id_for => { 2401 change_id => undef, 2402 change => 'foo', 2403 tag => undef, 2404 project => 'sql', 2405 } ], 2406 [ change_id_for => { 2407 change_id => undef, 2408 change => 'bar', 2409 tag => undef, 2410 project => 'sql', 2411 } ], 2412 [ change_id_for => { 2413 change_id => undef, 2414 change => 'foo', 2415 tag => undef, 2416 project => 'sql', 2417 } ], 2418 [ change_id_for => { 2419 change_id => undef, 2420 change => 'bar', 2421 tag => undef, 2422 project => 'sql', 2423 } ], 2424 ], 'Should have called check_requires'; 2425 is_deeply [ map { $_->resolved_id } @requires ], [undef, undef], 2426 'Missing requirements should not have resolved'; 2427} 2428 2429# Test revert dependency-checking. 2430$mock_engine->unmock('check_revert_dependencies'); 2431can_ok $engine, 'check_revert_dependencies'; 2432 2433CHECK_REVERT_DEPEND: { 2434 my $change = App::Sqitch::Plan::Change->new( 2435 name => 'urfa', 2436 id => '24234234234e', 2437 plan => $plan, 2438 ); 2439 2440 # Have revert change fail with requiring changes. 2441 my $req = { 2442 change_id => '23234234', 2443 change => 'blah', 2444 asof_tag => undef, 2445 project => $plan->project, 2446 }; 2447 @requiring = [$req]; 2448 2449 throws_ok { $engine->check_revert_dependencies($change) } 'App::Sqitch::X', 2450 'Should get error reverting change another depend on'; 2451 is $@->ident, 'revert', 'Dependent error ident should be "revert"'; 2452 is $@->message, __nx( 2453 'Change "{change}" required by currently deployed change: {changes}', 2454 'Change "{change}" required by currently deployed changes: {changes}', 2455 1, 2456 change => 'urfa', 2457 changes => 'blah' 2458 ), 'Dependent error message should be correct'; 2459 is_deeply $engine->seen, [ 2460 [changes_requiring_change => $change ], 2461 ], 'It should have check for requiring changes'; 2462 2463 # Add a second requiring change. 2464 my $req2 = { 2465 change_id => '99999', 2466 change => 'harhar', 2467 asof_tag => '@foo', 2468 project => 'elsewhere', 2469 }; 2470 @requiring = [$req, $req2]; 2471 2472 throws_ok { $engine->check_revert_dependencies($change) } 'App::Sqitch::X', 2473 'Should get error reverting change others depend on'; 2474 is $@->ident, 'revert', 'Dependent error ident should be "revert"'; 2475 is $@->message, __nx( 2476 'Change "{change}" required by currently deployed change: {changes}', 2477 'Change "{change}" required by currently deployed changes: {changes}', 2478 2 , 2479 change => 'urfa', 2480 changes => 'blah elsewhere:harhar@foo' 2481 ), 'Dependent error message should be correct'; 2482 is_deeply $engine->seen, [ 2483 [changes_requiring_change => $change ], 2484 ], 'It should have check for requiring changes'; 2485 2486 # Try it with two changes. 2487 my $req3 = { 2488 change_id => '94949494', 2489 change => 'frobisher', 2490 project => 'whu', 2491 }; 2492 @requiring = ([$req, $req2], [$req3]); 2493 2494 my $change2 = App::Sqitch::Plan::Change->new( 2495 name => 'kazane', 2496 id => '8686868686', 2497 plan => $plan, 2498 ); 2499 2500 throws_ok { $engine->check_revert_dependencies($change, $change2) } 'App::Sqitch::X', 2501 'Should get error reverting change others depend on'; 2502 is $@->ident, 'revert', 'Dependent error ident should be "revert"'; 2503 is $@->message, join( 2504 "\n", 2505 __nx( 2506 'Change "{change}" required by currently deployed change: {changes}', 2507 'Change "{change}" required by currently deployed changes: {changes}', 2508 2 , 2509 change => 'urfa', 2510 changes => 'blah elsewhere:harhar@foo' 2511 ), 2512 __nx( 2513 'Change "{change}" required by currently deployed change: {changes}', 2514 'Change "{change}" required by currently deployed changes: {changes}', 2515 1, 2516 change => 'kazane', 2517 changes => 'whu:frobisher' 2518 ), 2519 ), 'Dependent error message should be correct'; 2520 is_deeply $engine->seen, [ 2521 [changes_requiring_change => $change ], 2522 [changes_requiring_change => $change2 ], 2523 ], 'It should have checked twice for requiring changes'; 2524} 2525 2526############################################################################## 2527# Test _trim_to(). 2528can_ok $engine, '_trim_to'; 2529 2530# Should get an error when a change is not in the plan. 2531throws_ok { $engine->_trim_to( 'foo', 'nonexistent', [] ) } 'App::Sqitch::X', 2532 '_trim_to should complain about a nonexistent change key'; 2533is $@->ident, 'foo', '_trim_to nonexistent key error ident should be "foo"'; 2534is $@->message, __x( 2535 'Cannot find "{change}" in the database or the plan', 2536 change => 'nonexistent', 2537), '_trim_to nonexistent key error message should be correct'; 2538is_deeply $engine->seen, [ 2539 [ change_id_for => { 2540 change => 'nonexistent', 2541 change_id => undef, 2542 project => 'sql', 2543 tag => undef, 2544 } ] 2545], 'It should have passed the change name to change_id_for'; 2546 2547# Should get an error when it's in the plan but not the database. 2548throws_ok { $engine->_trim_to( 'yep', 'blah', [] ) } 'App::Sqitch::X', 2549 '_trim_to should complain about an undeployed change key'; 2550is $@->ident, 'yep', '_trim_to undeployed change error ident should be "yep"'; 2551is $@->message, __x( 2552 'Change "{change}" has not been deployed', 2553 change => 'blah', 2554), '_trim_to undeployed change error message should be correct'; 2555is_deeply $engine->seen, [ 2556 [ change_id_for => { 2557 change => 'blah', 2558 change_id => undef, 2559 project => 'sql', 2560 tag => undef, 2561 } ] 2562], 'It should have passed change "blah" change_id_for'; 2563 2564# Should get an error when it's deployed but not in the plan. 2565@resolved = ('whatever'); 2566throws_ok { $engine->_trim_to( 'oop', 'whatever', [] ) } 'App::Sqitch::X', 2567 '_trim_to should complain about an unplanned change key'; 2568is $@->ident, 'oop', '_trim_to unplanned change error ident should be "oop"'; 2569is $@->message, __x( 2570 'Change "{change}" is deployed, but not planned', 2571 change => 'whatever', 2572), '_trim_to unplanned change error message should be correct'; 2573is_deeply $engine->seen, [ 2574 [ change_id_for => { 2575 change => 'whatever', 2576 change_id => undef, 2577 project => 'sql', 2578 tag => undef, 2579 } ], 2580 [ change_id_offset_from_id => ['whatever', 0]], 2581], 'It should have passed "whatever" to change_id_offset_from_id'; 2582 2583# Let's mess with changes. Start by shifting nothing. 2584my $to_trim = [@changes]; 2585@resolved = ($changes[0]->id); 2586my $key = $changes[0]->name; 2587is $engine->_trim_to('foo', $key, $to_trim), 0, 2588 qq{_trim_to should find "$key" at index 0}; 2589is_deeply [ map { $_->id } @{ $to_trim } ], [ map { $_->id } @changes ], 2590 'Changes should be untrimmed'; 2591is_deeply $engine->seen, [ 2592 [ change_id_for => { 2593 change => $key, 2594 change_id => undef, 2595 project => 'sql', 2596 tag => undef, 2597 } ], 2598 [ change_id_offset_from_id => [$changes[0]->id, 0]], 2599], 'It should have passed change 0 ID to change_id_offset_from_id'; 2600 2601# Try shifting to the third change. 2602$to_trim = [@changes]; 2603@resolved = ($changes[2]->id); 2604$key = $changes[2]->name; 2605is $engine->_trim_to('foo', $key, $to_trim), 2, 2606 qq{_trim_to should find "$key" at index 2}; 2607is_deeply [ map { $_->id } @{ $to_trim } ], [ map { $_->id } @changes[2..$#changes] ], 2608 'First two changes should be shifted off'; 2609is_deeply $engine->seen, [ 2610 [ change_id_for => { 2611 change => $key, 2612 change_id => undef, 2613 project => 'sql', 2614 tag => undef, 2615 } ], 2616 [ change_id_offset_from_id => [$changes[2]->id, 0]], 2617], 'It should have passed change 2 ID to change_id_offset_from_id'; 2618 2619# Try popping nothing. 2620$to_trim = [@changes]; 2621@resolved = ($changes[-1]->id); 2622$key = $changes[-1]->name; 2623is $engine->_trim_to('foo', $key, $to_trim, 1), $#changes, 2624 qq{_trim_to should find "$key" at last index}; 2625is_deeply [ map { $_->id } @{ $to_trim } ], [ map { $_->id } @changes ], 2626 'Changes should be untrimmed'; 2627is_deeply $engine->seen, [ 2628 [ change_id_for => { 2629 change => $key, 2630 change_id => undef, 2631 project => 'sql', 2632 tag => undef, 2633 } ], 2634 [ change_id_offset_from_id => [$changes[-1]->id, 0]], 2635], 'It should have passed change -1 ID to change_id_offset_from_id'; 2636 2637# Try shifting to the third-to-last change. 2638$to_trim = [@changes]; 2639@resolved = ($changes[-3]->id); 2640$key = $changes[-3]->name; 2641is $engine->_trim_to('foo', $key, $to_trim, 1), 4, 2642 qq{_trim_to should find "$key" at index 4}; 2643is_deeply [ map { $_->id } @{ $to_trim } ], [ map { $_->id } @changes[0..$#changes-2] ], 2644 'Last two changes should be popped off'; 2645is_deeply $engine->seen, [ 2646 [ change_id_for => { 2647 change => $key, 2648 change_id => undef, 2649 project => 'sql', 2650 tag => undef, 2651 } ], 2652 [ change_id_offset_from_id => [$changes[-3]->id, 0]], 2653], 'It should have passed change -3 ID to change_id_offset_from_id'; 2654 2655# ^ should be handled relative to deployed changes. 2656$to_trim = [@changes]; 2657@resolved = ($changes[-3]->id); 2658$key = $changes[-4]->name; 2659is $engine->_trim_to('foo', "$key^", $to_trim, 1), 4, 2660 qq{_trim_to should find "$key^" at index 4}; 2661is_deeply $engine->seen, [ 2662 [ change_id_for => { 2663 change => $key, 2664 change_id => undef, 2665 project => 'sql', 2666 tag => undef, 2667 } ], 2668 [ change_id_offset_from_id => [$changes[-3]->id, -1]], 2669], 'Should pass change -3 ID and offset -1 to change_id_offset_from_id'; 2670 2671# ~ should be handled relative to deployed changes. 2672$to_trim = [@changes]; 2673@resolved = ($changes[-3]->id); 2674$key = $changes[-2]->name; 2675is $engine->_trim_to('foo', "$key~", $to_trim, 1), 4, 2676 qq{_trim_to should find "$key~" at index 4}; 2677is_deeply $engine->seen, [ 2678 [ change_id_for => { 2679 change => $key, 2680 change_id => undef, 2681 project => 'sql', 2682 tag => undef, 2683 } ], 2684 [ change_id_offset_from_id => [$changes[-3]->id, 1]], 2685], 'Should pass change -3 ID and offset 1 to change_id_offset_from_id'; 2686 2687# @HEAD and HEAD should be handled relative to deployed changes, not the plan. 2688$to_trim = [@changes]; 2689@resolved = ($changes[2]->id); 2690$key = '@HEAD'; 2691is $engine->_trim_to('foo', $key, $to_trim), 2, 2692 qq{_trim_to should find "$key" at index 2}; 2693is_deeply [ map { $_->id } @{ $to_trim } ], [ map { $_->id } @changes[2..$#changes] ], 2694 'First two changes should be shifted off'; 2695is_deeply $engine->seen, [ 2696 [ change_id_for => { 2697 change => '', 2698 change_id => undef, 2699 project => 'sql', 2700 tag => 'HEAD', 2701 } ], 2702 [ change_id_offset_from_id => [$changes[2]->id, 0]], 2703], 'Should pass tag HEAD to change_id_for'; 2704 2705$to_trim = [@changes]; 2706@resolved = ($changes[2]->id); 2707$key = 'HEAD'; 2708is $engine->_trim_to('foo', $key, $to_trim), 2, 2709 qq{_trim_to should find "$key" at index 2}; 2710is_deeply [ map { $_->id } @{ $to_trim } ], [ map { $_->id } @changes[2..$#changes] ], 2711 'First two changes should be shifted off'; 2712is_deeply $engine->seen, [ 2713 [ change_id_for => { 2714 change => undef, 2715 change_id => undef, 2716 project => 'sql', 2717 tag => '@HEAD', 2718 } ], 2719 [ change_id_offset_from_id => [$changes[2]->id, 0]], 2720], 'Should pass tag @HEAD to change_id_for'; 2721 2722# @ROOT and ROOT should be handled relative to deployed changes, not the plan. 2723$to_trim = [@changes]; 2724@resolved = ($changes[2]->id); 2725$key = '@ROOT'; 2726is $engine->_trim_to('foo', $key, $to_trim, 1), 2, 2727 qq{_trim_to should find "$key" at index 2}; 2728is_deeply [ map { $_->id } @{ $to_trim } ], [ map { $_->id } @changes[0,1,2] ], 2729 'All but First three changes should be popped off'; 2730is_deeply $engine->seen, [ 2731 [ change_id_for => { 2732 change => '', 2733 change_id => undef, 2734 project => 'sql', 2735 tag => 'ROOT', 2736 } ], 2737 [ change_id_offset_from_id => [$changes[2]->id, 0]], 2738], 'Should pass tag ROOT to change_id_for'; 2739 2740$to_trim = [@changes]; 2741@resolved = ($changes[2]->id); 2742$key = 'ROOT'; 2743is $engine->_trim_to('foo', $key, $to_trim, 1), 2, 2744 qq{_trim_to should find "$key" at index 2}; 2745is_deeply [ map { $_->id } @{ $to_trim } ], [ map { $_->id } @changes[0,1,2] ], 2746 'All but First three changes should be popped off'; 2747is_deeply $engine->seen, [ 2748 [ change_id_for => { 2749 change => undef, 2750 change_id => undef, 2751 project => 'sql', 2752 tag => '@ROOT', 2753 } ], 2754 [ change_id_offset_from_id => [$changes[2]->id, 0]], 2755], 'Should pass tag @ROOT to change_id_for'; 2756 2757############################################################################## 2758# Test _verify_changes(). 2759can_ok $engine, '_verify_changes'; 2760$engine->seen; 2761 2762# Start with a single change with a valid verify script. 2763is $engine->_verify_changes(1, 1, 0, $changes[1]), 0, 2764 'Verify of a single change should return errcount 0'; 2765is_deeply +MockOutput->get_emit_literal, [[ 2766 ' * users @alpha ..', '', ' ', 2767]], 'Declared output should list the change'; 2768is_deeply +MockOutput->get_emit, [['ok']], 2769 'Emitted Output should reflect the verification of the change'; 2770is_deeply +MockOutput->get_comment, [], 'Should have no comments'; 2771is_deeply $engine->seen, [ 2772 [run_file => $changes[1]->verify_file ], 2773], 'The verify script should have been run'; 2774 2775# Try a single change with no verify script. 2776is $engine->_verify_changes(0, 0, 0, $changes[0]), 0, 2777 'Verify of another single change should return errcount 0'; 2778is_deeply +MockOutput->get_emit_literal, [[ 2779 ' * roles ..', '', ' ', 2780]], 'Declared output should list the change'; 2781is_deeply +MockOutput->get_emit, [['ok']], 2782 'Emitted Output should reflect the verification of the change'; 2783is_deeply +MockOutput->get_comment, [], 'Should have no comments'; 2784is_deeply +MockOutput->get_vent, [ 2785 [__x 'Verify script {file} does not exist', file => $changes[0]->verify_file], 2786], 'A warning about no verify file should have been emitted'; 2787is_deeply $engine->seen, [ 2788], 'The verify script should not have been run'; 2789 2790# Try multiple changes. 2791is $engine->_verify_changes(0, 1, 0, @changes[0,1]), 0, 2792 'Verify of two changes should return errcount 0'; 2793is_deeply +MockOutput->get_emit_literal, [ 2794 [' * roles ..', '.......', ' '], 2795 [' * users @alpha ..', '', ' '], 2796], 'Declared output should list both changes'; 2797is_deeply +MockOutput->get_emit, [['ok'], ['ok']], 2798 'Emitted Output should reflect the verification of the changes'; 2799 2800is_deeply +MockOutput->get_comment, [], 'Should have no comments'; 2801is_deeply +MockOutput->get_vent, [ 2802 [__x 'Verify script {file} does not exist', file => $changes[0]->verify_file], 2803], 'A warning about no verify file should have been emitted'; 2804is_deeply $engine->seen, [ 2805 [run_file => $changes[1]->verify_file ], 2806], 'Only one verify script should have been run'; 2807 2808# Try multiple changes and show undeployed changes. 2809my @plan_changes = $plan->changes; 2810is $engine->_verify_changes(0, 1, 1, @changes[0,1]), 0, 2811 'Verify of two changes and show pending'; 2812is_deeply +MockOutput->get_emit_literal, [ 2813 [' * roles ..', '.......', ' '], 2814 [' * users @alpha ..', '', ' '], 2815], 'Delcared output should list deployed changes'; 2816is_deeply +MockOutput->get_emit, [ 2817 ['ok'], ['ok'], 2818 [__n 'Undeployed change:', 'Undeployed changes:', 2], 2819 map { [ ' * ', $_->format_name_with_tags] } @plan_changes[2..$#plan_changes] 2820], 'Emitted output should include list of pending changes'; 2821is_deeply +MockOutput->get_comment, [], 'Should have no comments'; 2822is_deeply +MockOutput->get_vent, [ 2823 [__x 'Verify script {file} does not exist', file => $changes[0]->verify_file], 2824], 'A warning about no verify file should have been emitted'; 2825is_deeply $engine->seen, [ 2826 [run_file => $changes[1]->verify_file ], 2827], 'Only one verify script should have been run'; 2828 2829# Try a change that is not in the plan. 2830$change = App::Sqitch::Plan::Change->new( name => 'nonexistent', plan => $plan ); 2831is $engine->_verify_changes(1, 0, 0, $change), 1, 2832 'Verify of a change not in the plan should return errcount 1'; 2833is_deeply +MockOutput->get_emit_literal, [[ 2834 ' * nonexistent ..', '', ' ' 2835]], 'Declared Output should reflect the verification of the change'; 2836is_deeply +MockOutput->get_emit, [['not ok']], 2837 'Emitted Output should reflect the failure of the verify'; 2838is_deeply +MockOutput->get_comment, [[__ 'Not present in the plan' ]], 2839 'Should have a comment about the change missing from the plan'; 2840is_deeply $engine->seen, [], 'No verify script should have been run'; 2841 2842# Try a change in the wrong place in the plan. 2843my $mock_plan = Test::MockModule->new(ref $plan); 2844$mock_plan->mock(index_of => 5); 2845is $engine->_verify_changes(1, 0, 0, $changes[1]), 1, 2846 'Verify of an out-of-order change should return errcount 1'; 2847is_deeply +MockOutput->get_emit_literal, [ 2848 [' * users @alpha ..', '', ' '], 2849], 'Declared output should reflect the verification of the change'; 2850is_deeply +MockOutput->get_emit, [['not ok']], 2851 'Emitted Output should reflect the failure of the verify'; 2852is_deeply +MockOutput->get_comment, [[__ 'Out of order' ]], 2853 'Should have a comment about the out-of-order change'; 2854is_deeply $engine->seen, [ 2855 [run_file => $changes[1]->verify_file ], 2856], 'The verify script should have been run'; 2857 2858# Make sure that multiple issues add up. 2859$mock_engine->mock( verify_change => sub { hurl 'WTF!' }); 2860is $engine->_verify_changes(1, 0, 0, $changes[1]), 2, 2861 'Verify of a change with 2 issues should return 2'; 2862is_deeply +MockOutput->get_emit_literal, [ 2863 [' * users @alpha ..', '', ' '], 2864], 'Declared output should reflect the verification of the change'; 2865is_deeply +MockOutput->get_emit, [['not ok']], 2866 'Emitted Output should reflect the failure of the verify'; 2867is_deeply +MockOutput->get_comment, [ 2868 [__ 'Out of order' ], 2869 ['WTF!'], 2870], 'Should have comment about the out-of-order change and script failure'; 2871is_deeply $engine->seen, [], 'No abstract methods should have been called'; 2872 2873# Make sure that multiple changes with multiple issues add up. 2874$mock_engine->mock( verify_change => sub { hurl 'WTF!' }); 2875is $engine->_verify_changes(0, -1, 0, @changes[0,1]), 4, 2876 'Verify of 2 changes with 2 issues each should return 4'; 2877is_deeply +MockOutput->get_emit_literal, [ 2878 [' * roles ..', '.......', ' '], 2879 [' * users @alpha ..', '', ' '], 2880], 'Declraed output should reflect the verification of both changes'; 2881is_deeply +MockOutput->get_emit, [['not ok'], ['not ok']], 2882 'Emitted Output should reflect the failure of both verifies'; 2883is_deeply +MockOutput->get_comment, [ 2884 [__ 'Out of order' ], 2885 ['WTF!'], 2886 [__ 'Out of order' ], 2887 ['WTF!'], 2888], 'Should have comment about the out-of-order changes and script failures'; 2889is_deeply $engine->seen, [], 'No abstract methods should have been called'; 2890 2891# Unmock before moving on. 2892$mock_plan->unmock('index_of'); 2893$mock_engine->unmock('verify_change'); 2894 2895# Now deal with changes in the plan but not in the list. 2896is $engine->_verify_changes($#changes, $plan->count - 1, 0, $changes[-1]), 2, 2897 '_verify_changes with two undeployed changes should returne 2'; 2898is_deeply +MockOutput->get_emit_literal, [ 2899 [' * dr_evil ..', '', ' '], 2900 [' * foo ..', '....', ' ' , 'not ok', ' '], 2901 [' * blah ..', '...', ' ' , 'not ok', ' '], 2902], 'Listed changes should be both deployed and undeployed'; 2903is_deeply +MockOutput->get_emit, [['ok']], 2904 'Emitted Output should reflect 1 pass'; 2905is_deeply +MockOutput->get_comment, [ 2906 [__ 'Not deployed' ], 2907 [__ 'Not deployed' ], 2908], 'Should have comments for undeployed changes'; 2909is_deeply $engine->seen, [], 'No abstract methods should have been called'; 2910 2911############################################################################## 2912# Test verify(). 2913can_ok $engine, 'verify'; 2914my @verify_changes; 2915$mock_engine->mock( _load_changes => sub { @verify_changes }); 2916 2917# First, test with no changes. 2918throws_ok { $engine->verify } 'App::Sqitch::X', 2919 'Should get error for no deployed changes'; 2920is $@->ident, 'verify', 'No deployed changes ident should be "verify"'; 2921is $@->exitval, 1, 'No deployed changes exitval should be 1'; 2922is $@->message, __ 'No changes deployed', 2923 'No deployed changes message should be correct'; 2924is_deeply +MockOutput->get_info, [ 2925 [__x 'Verifying {destination}', destination => $engine->destination], 2926], 'Notification of the verify should be emitted'; 2927 2928# Try no changes *and* nothing in the plan. 2929my $count = 0; 2930$mock_plan->mock(count => sub { $count }); 2931throws_ok { $engine->verify } 'App::Sqitch::X', 2932 'Should get error for no changes'; 2933is $@->ident, 'verify', 'No changes ident should be "verify"'; 2934is $@->exitval, 1, 'No changes exitval should be 1'; 2935is $@->message, __ 'Nothing to verify (no planned or deployed changes)', 2936 'No changes message should be correct'; 2937is_deeply +MockOutput->get_info, [ 2938 [__x 'Verifying {destination}', destination => $engine->destination], 2939], 'Notification of the verify should be emitted'; 2940 2941# Now return some changes but have nothing in the plan. 2942@verify_changes = @changes; 2943throws_ok { $engine->verify } 'App::Sqitch::X', 2944 'Should get error for no planned changes'; 2945is $@->ident, 'verify', 'No planned changes ident should be "verify"'; 2946is $@->exitval, 2, 'No planned changes exitval should be 2'; 2947is $@->message, __ 'There are deployed changes, but none planned!', 2948 'No planned changes message should be correct'; 2949is_deeply +MockOutput->get_info, [ 2950 [__x 'Verifying {destination}', destination => $engine->destination], 2951], 'Notification of the verify should be emitted'; 2952 2953# Let's do one change and have it pass. 2954$mock_plan->mock(index_of => 0); 2955$count = 1; 2956@verify_changes = ($changes[1]); 2957undef $@; 2958ok $engine->verify, 'Verify one change'; 2959is_deeply +MockOutput->get_info, [ 2960 [__x 'Verifying {destination}', destination => $engine->destination], 2961], 'Notification of the verify should be emitted'; 2962is_deeply +MockOutput->get_emit_literal, [ 2963 [' * ' . $changes[1]->format_name_with_tags . ' ..', '', ' ' ], 2964], 'The one change name should be declared'; 2965is_deeply +MockOutput->get_emit, [ 2966 ['ok'], 2967 [__ 'Verify successful'], 2968], 'Success should be emitted'; 2969is_deeply +MockOutput->get_comment, [], 'Should have no comments'; 2970 2971# Verify two changes. 2972MockOutput->get_vent; 2973$mock_plan->unmock('index_of'); 2974@verify_changes = @changes[0,1]; 2975ok $engine->verify, 'Verify two changes'; 2976is_deeply +MockOutput->get_info, [ 2977 [__x 'Verifying {destination}', destination => $engine->destination], 2978], 'Notification of the verify should be emitted'; 2979is_deeply +MockOutput->get_emit_literal, [ 2980 [' * roles ..', '.......', ' ' ], 2981 [' * users @alpha ..', '', ' ' ], 2982], 'The two change names should be declared'; 2983is_deeply +MockOutput->get_emit, [ 2984 ['ok'], ['ok'], 2985 [__ 'Verify successful'], 2986], 'Both successes should be emitted'; 2987is_deeply +MockOutput->get_comment, [], 'Should have no comments'; 2988is_deeply +MockOutput->get_vent, [ 2989 [__x( 2990 'Verify script {file} does not exist', 2991 file => $changes[0]->verify_file, 2992 )] 2993], 'Should have warning about missing verify script'; 2994 2995# Make sure a reworked change (that is, one with a suffix) is ignored. 2996my $mock_change = Test::MockModule->new(ref $change); 2997$mock_change->mock(is_reworked => 1); 2998@verify_changes = @changes[0,1]; 2999ok $engine->verify, 'Verify with a reworked change changes'; 3000is_deeply +MockOutput->get_info, [ 3001 [__x 'Verifying {destination}', destination => $engine->destination], 3002], 'Notification of the verify should be emitted'; 3003is_deeply +MockOutput->get_emit_literal, [ 3004 [' * roles ..', '.......', ' ' ], 3005 [' * users @alpha ..', '', ' ' ], 3006], 'The two change names should be emitted'; 3007is_deeply +MockOutput->get_emit, [ 3008 ['ok'], ['ok'], 3009 [__ 'Verify successful'], 3010], 'Both successes should be emitted'; 3011is_deeply +MockOutput->get_comment, [], 'Should have no comments'; 3012is_deeply +MockOutput->get_vent, [], 'Should have no warnings'; 3013 3014$mock_change->unmock('is_reworked'); 3015 3016# Make sure we can trim. 3017@verify_changes = @changes; 3018@resolved = map { $_->id } @changes[1,2]; 3019ok $engine->verify('users', 'widgets'), 'Verify two specific changes'; 3020is_deeply +MockOutput->get_info, [ 3021 [__x 'Verifying {destination}', destination => $engine->destination], 3022], 'Notification of the verify should be emitted'; 3023is_deeply +MockOutput->get_emit_literal, [ 3024 [' * users @alpha ..', '.', ' ' ], 3025 [' * widgets @beta ..', '', ' ' ], 3026], 'The two change names should be emitted'; 3027is_deeply +MockOutput->get_emit, [ 3028 ['ok'], ['ok'], 3029 [__ 'Verify successful'], 3030], 'Both successes should be emitted'; 3031is_deeply +MockOutput->get_comment, [], 'Should have no comments'; 3032is_deeply +MockOutput->get_vent, [ 3033 [__x( 3034 'Verify script {file} does not exist', 3035 file => $changes[2]->verify_file, 3036 )] 3037], 'Should have warning about missing verify script'; 3038 3039# Now fail! 3040$mock_engine->mock( verify_change => sub { hurl 'WTF!' }); 3041@verify_changes = @changes; 3042@resolved = map { $_->id } @changes[1,2]; 3043throws_ok { $engine->verify('users', 'widgets') } 'App::Sqitch::X', 3044 'Should get failure for failing verify scripts'; 3045is $@->ident, 'verify', 'Failed verify ident should be "verify"'; 3046is $@->exitval, 2, 'Failed verify exitval should be 2'; 3047is $@->message, __ 'Verify failed', 'Faield verify message should be correct'; 3048is_deeply +MockOutput->get_info, [ 3049 [__x 'Verifying {destination}', destination => $engine->destination], 3050], 'Notification of the verify should be emitted'; 3051my $msg = __ 'Verify Summary Report'; 3052is_deeply +MockOutput->get_emit_literal, [ 3053 [' * users @alpha ..', '.', ' ' ], 3054 [' * widgets @beta ..', '', ' ' ], 3055], 'Both change names should be declared'; 3056is_deeply +MockOutput->get_emit, [ 3057 ['not ok'], ['not ok'], 3058 [ "\n", $msg ], 3059 [ '-' x length $msg ], 3060 [__x 'Changes: {number}', number => 2 ], 3061 [__x 'Errors: {number}', number => 2 ], 3062], 'Output should include the failure report'; 3063is_deeply +MockOutput->get_comment, [ 3064 ['WTF!'], 3065 ['WTF!'], 3066], 'Should have the errors in comments'; 3067is_deeply +MockOutput->get_vent, [], 'Nothing should have been vented'; 3068 3069__END__ 3070diag $_->format_name_with_tags for @changes; 3071diag '======'; 3072diag $_->format_name_with_tags for $plan->changes; 3073