tests/git-update-dirs.t

   1 #!/usr/bin/env perl
   2
   3 #=======================================================================
   4 # git-update-dirs.t
   5 # File ID: 9072b5a4-f909-11e4-b80e-000df06acc56
   6 #
   7 # Test suite for git-update-dirs(1).
   8 #
   9 # Character set: UTF-8
  10 # ©opyleft 2015– Øyvind A. Holm <sunny@sunbase.org>
  11 # License: GNU General Public License version 2 or later, see end of
  12 # file for legal stuff.
  13 #=======================================================================
  14
  15 use strict;
  16 use warnings;
  17
  18 BEGIN {
  19     use Test::More qw{no_plan};
  20     # use_ok() goes here
  21 }
  22
  23 use Getopt::Long;
  24
  25 local $| = 1;
  26
  27 our $CMDB = "git-update-dirs";
  28 our $CMD = "../$CMDB";
  29
  30 our %Opt = (
  31
  32     'all' => 0,
  33     'help' => 0,
  34     'quiet' => 0,
  35     'todo' => 0,
  36     'verbose' => 0,
  37     'version' => 0,
  38
  39 );
  40
  41 our $progname = $0;
  42 $progname =~ s/^.*\/(.*?)$/$1/;
  43 our $VERSION = '0.0.0';
  44
  45 my $current_repo;
  46 my %descriptions = ();
  47 my %disable_already_tested = ();
  48
  49 Getopt::Long::Configure('bundling');
  50 GetOptions(
  51
  52     'all|a' => \$Opt{'all'},
  53     'help|h' => \$Opt{'help'},
  54     'quiet|q+' => \$Opt{'quiet'},
  55     'todo|t' => \$Opt{'todo'},
  56     'verbose|v+' => \$Opt{'verbose'},
  57     'version' => \$Opt{'version'},
  58
  59 ) || die("$progname: Option error. Use -h for help.\n");
  60
  61 $Opt{'verbose'} -= $Opt{'quiet'};
  62 $Opt{'help'} && usage(0);
  63 if ($Opt{'version'}) {
  64     print_version();
  65     exit(0);
  66 }
  67
  68 exit(main());
  69
  70 sub main {
  71     # {{{
  72     my $Retval = 0;
  73
  74     diag(sprintf('========== Executing %s v%s ==========',
  75                  $progname, $VERSION));
  76
  77     if ($Opt{'todo'} && !$Opt{'all'}) {
  78         goto todo_section;
  79     }
  80
  81 =pod
  82
  83     testcmd("$CMD command", # {{{
  84         <<'END',
  85 [expected stdout]
  86 END
  87         '',
  88         0,
  89         'description',
  90     );
  91
  92     # }}}
  93
  94 =cut
  95
  96     my $Tmptop = "tmp-git-update-dirs-t-$$-" . substr(rand, 2, 8);
  97     ok(mkdir($Tmptop), "mkdir [Tmptop]") ||
  98         BAIL_OUT("$Tmptop: mkdir error, can't continue\n");
  99     ok(chdir($Tmptop), "chdir [Tmptop]") ||
 100         BAIL_OUT("$progname: $Tmptop: chdir error, can't continue\n");
 101     chomp($ENV{'HOME'} = `pwd`);
 102     testcmd('git config --global user.name "Suttleif Fisen"', '', '', 0,
 103             'git config --global user.name "Suttleif Fisen"');
 104     testcmd('git config --global user.email suttleif@example.com', '', '', 0,
 105             'git config --global user.email suttleif@example.com');
 106     testcmd('git config --global init.defaultbranch master', '', '', 0,
 107             'git config --global init.defaultbranch master');
 108     $CMD = "../$CMD";
 109
 110     diag('Testing -h (--help) option...');
 111     likecmd("$CMD -h", # {{{
 112         '/  Show this help/i',
 113         '/^$/',
 114         0,
 115         'Option -h prints help screen',
 116     );
 117
 118     # }}}
 119     diag('Testing -v (--verbose) option...');
 120     likecmd("$CMD -hv", # {{{
 121         '/^\n\S+ \d+\.\d+\.\d+/s',
 122         '/^$/',
 123         0,
 124         'Option -v with -h returns version number and help screen',
 125     );
 126
 127     # }}}
 128     diag('Testing --version option...');
 129     likecmd("$CMD --version", # {{{
 130         '/^\S+ \d+\.\d+\.\d+/',
 131         '/^$/',
 132         0,
 133         'Option --version returns version number',
 134     );
 135
 136     # }}}
 137     likecmd("git --version", # {{{
 138         '/^git version /',
 139         '/^$/',
 140         0,
 141         'git is installed',
 142     ) || BAIL_OUT("git is not installed, cannot continue");
 143
 144     # }}}
 145     if (`git-annex version 2>/dev/null` !~ /^git-annex version/) {
 146         # FIXME: Use with existing annex tests instead
 147         diag("git-annex is not installed here, skipping tests");
 148         return 0;
 149     }
 150     likecmd("git annex version", # {{{
 151         '/^git-annex version:/',
 152         '/^$/',
 153         0,
 154         'git-annex is installed',
 155     ) || BAIL_OUT("git-annex is not installed, cannot continue");
 156
 157     # }}}
 158     diag('Initialise repositories');
 159     likecmd("git init --bare bare.git", # {{{
 160         '/.*/',
 161         '/^$/',
 162         0,
 163         'Create bare Git repository',
 164     );
 165
 166     # }}}
 167     likecmd("git clone bare.git repo", # {{{
 168         '/.*/',
 169         '/.*/',
 170         0,
 171         'Clone bare.git to \'repo\'',
 172     );
 173
 174     # }}}
 175
 176     test_repo('repo', 0);
 177     test_repo('bare.git', 1);
 178
 179     my @dir_list = qw {
 180         repo/sub2
 181         repo/sub1
 182         repo/sub1/subrepo1
 183         repo/bare1.git
 184         repo/sub1/subrepo1/subsubrepo1.git
 185     };
 186
 187     for my $dir (@dir_list) {
 188         my $bare_str = ($dir =~ /\.git$/ ? ' --bare' : '');
 189         likecmd("git$bare_str init $dir",
 190             '/.*/',
 191             '/^$/',
 192             0,
 193             "Create repo '$dir'",
 194         );
 195     }
 196
 197     testcmd("$CMD --recursive -nf", # {{{
 198         <<END,
 199 ================ ./repo ================
 200
 201 ================ ./repo/sub1 ================
 202
 203 ================ ./repo/sub1/subrepo1 ================
 204
 205 ================ ./repo/sub2 ================
 206
 207 END
 208         "git-update-dirs: Simulating 'git fetch --all'...\n" x 4,
 209         0,
 210         "--recursive option",
 211     );
 212
 213     # }}}
 214     testcmd("$CMD -rfn", # {{{
 215         <<END,
 216 ================ ./repo ================
 217
 218 ================ ./repo/sub1 ================
 219
 220 ================ ./repo/sub1/subrepo1 ================
 221
 222 ================ ./repo/sub2 ================
 223
 224 END
 225         "git-update-dirs: Simulating 'git fetch --all'...\n" x 4,
 226         0,
 227         "-r (recursive) option",
 228     );
 229
 230     # }}}
 231     create_file("filelist.txt", join("\n", @dir_list));
 232     testcmd("$CMD --dirs-from filelist.txt -nf", # {{{
 233         <<END,
 234 ================ repo/sub2 ================
 235
 236 ================ repo/sub1 ================
 237
 238 ================ repo/sub1/subrepo1 ================
 239
 240 ================ repo/bare1.git ================
 241
 242 ================ repo/sub1/subrepo1/subsubrepo1.git ================
 243
 244 END
 245         "git-update-dirs: Simulating 'git fetch --all'...\n" x 5,
 246         0,
 247         "--dirs-from option",
 248     );
 249
 250     # }}}
 251     testcmd("$CMD --fetch -n --dirs-from - <filelist.txt", # {{{
 252         <<END,
 253 ================ repo/sub2 ================
 254
 255 ================ repo/sub1 ================
 256
 257 ================ repo/sub1/subrepo1 ================
 258
 259 ================ repo/bare1.git ================
 260
 261 ================ repo/sub1/subrepo1/subsubrepo1.git ================
 262
 263 END
 264         "git-update-dirs: Simulating 'git fetch --all'...\n" x 5,
 265         0,
 266         "Read file list from stdin with '--dirs-from -'",
 267     );
 268
 269     # }}}
 270     create_file("filelist2.txt", <<END);
 271 repo/sub2
 272 repo/bare1.git
 273 repo/sub1
 274 END
 275     testcmd("$CMD --fetch -n --dirs-from filelist.txt " .
 276         "--dirs-from filelist2.txt", # {{{
 277         <<END,
 278 ================ repo/sub2 ================
 279
 280 ================ repo/sub1 ================
 281
 282 ================ repo/sub1/subrepo1 ================
 283
 284 ================ repo/bare1.git ================
 285
 286 ================ repo/sub1/subrepo1/subsubrepo1.git ================
 287
 288 ================ repo/sub2 ================
 289
 290 ================ repo/bare1.git ================
 291
 292 ================ repo/sub1 ================
 293
 294 END
 295         "git-update-dirs: Simulating 'git fetch --all'...\n" x 8,
 296         0,
 297         "--dirs-from is specified twice, read from two files",
 298     );
 299
 300     # }}}
 301     ok(unlink("filelist.txt"), "Delete filelist.txt");
 302     ok(unlink("filelist2.txt"), "Delete filelist2.txt");
 303
 304     diag('Clean up');
 305     testcmd("rm -rf bare.git", # {{{
 306         '',
 307         '',
 308         0,
 309         'Remove bare test repository',
 310     );
 311
 312     # }}}
 313     testcmd("rm -rf repo", # {{{
 314         '',
 315         '',
 316         0,
 317         'Remove non-bare test repository',
 318     );
 319
 320     # }}}
 321     ok(unlink(".gitconfig"), "Delete .gitconfig");
 322     testcmd("rm -rf .cache", "", "", 0, "Delete .cache/, created by git-annex");
 323     testcmd("rm -rf .ssh", "", "", 0, "Delete .ssh/, created by git-annex");
 324     ok(chdir(".."), "chdir ..");
 325     ok(-d $Tmptop, "[Tmptop] exists");
 326     ok(rmdir($Tmptop), "rmdir [Tmptop]");
 327     ok(!-d $Tmptop, "[Tmptop] is gone");
 328
 329     todo_section:
 330     ;
 331
 332     if ($Opt{'all'} || $Opt{'todo'}) {
 333         diag('Running TODO tests...'); # {{{
 334
 335         TODO: {
 336
 337             local $TODO = '';
 338             # Insert TODO tests here.
 339
 340         }
 341         # TODO tests }}}
 342     }
 343
 344     diag('Testing finished.');
 345     return $Retval;
 346     # }}}
 347 } # main()
 348
 349 sub test_repo {
 350     # {{{
 351     my ($repo, $is_bare) = @_;
 352
 353     diag("Run tests in $repo");
 354     $current_repo = $repo;
 355     ok(chdir($repo), "chdir $repo") || BAIL_OUT('chdir error');
 356     $CMD = "../../../$CMDB";
 357     if (!-e $CMD) {
 358         BAIL_OUT("test_repo(): \$CMD is '$CMD', that's wrong");
 359     }
 360     if (!$is_bare) {
 361         likecmd("git remote add bare ../bare.git", # {{{
 362             '/^$/',
 363             '/^$/',
 364             0,
 365             'Create bare remote',
 366         );
 367
 368         # }}}
 369         likecmd("git commit --allow-empty -m 'Empty start commit'", # {{{
 370             '/.*/',
 371             '/^$/',
 372             0,
 373             'Create empty start commit',
 374         );
 375
 376         # }}}
 377         likecmd("git push bare master", # {{{
 378             '/.*/',
 379             '/.*/',
 380             0,
 381             'Push master to the bare repo',
 382         );
 383
 384         # }}}
 385     }
 386     likecmd("git annex init " . ($is_bare ? "bare" : "repo"), # {{{
 387         '/.*/',
 388         '/^$/',
 389         0,
 390         "Make $repo an annex",
 391     );
 392
 393     # }}}
 394     my $sep = "================ . ================\n";
 395
 396     diag('--exec-before');
 397     testcmd("$CMD -E 'echo This is nice' .", # {{{
 398         "${sep}This is nice\n\n",
 399         "git-update-dirs: Executing 'echo This is nice'...\n",
 400         0,
 401         "$repo: Test -E option",
 402     );
 403
 404     # }}}
 405     testcmd("$CMD --exec-before 'echo This is nice' .", # {{{
 406         "${sep}This is nice\n\n",
 407         "git-update-dirs: Executing 'echo This is nice'...\n",
 408         0,
 409         "$repo: Test --exec-before option",
 410     );
 411
 412     # }}}
 413     test_disabled("exec-before", "$CMD --exec-before echo .");
 414     diag('--lpar');
 415     testcmd("$CMD -n -l .", # {{{
 416         "$sep\n",
 417         "git-update-dirs: Simulating 'lpar'...\n" .
 418             "git-update-dirs: Simulating 'lpar'...\n",
 419         0,
 420         "$repo: Test -l option",
 421     );
 422
 423     # }}}
 424     testcmd("$CMD -n --lpar .", # {{{
 425         "$sep\n",
 426         "git-update-dirs: Simulating 'lpar'...\n" .
 427             "git-update-dirs: Simulating 'lpar'...\n",
 428         0,
 429         "$repo: Test --lpar option",
 430     );
 431
 432     # }}}
 433     test_disabled("lpar");
 434     diag('--test');
 435     test_option('-t', 'git fsck');
 436     test_option('--test', 'git fsck');
 437     diag('--fetch-prune');
 438     test_option('-F', 'git fetch --all --prune');
 439     test_option('--fetch-prune', 'git fetch --all --prune');
 440     diag('--fetch');
 441     test_option('-f', 'git fetch --all');
 442     test_option('--fetch', 'git fetch --all');
 443     diag('--pull');
 444     if ($is_bare) {
 445         testcmd("$CMD -n -p", '', '', 0, "$repo: Test -p");
 446         testcmd("$CMD -n --pull", '', '', 0, "$repo: Test --pull");
 447     } else {
 448         test_option('-p', 'git pull --ff-only');
 449         test_option('--pull', 'git pull --ff-only');
 450     }
 451     diag('--ga-sync');
 452     test_option('-g', 'ga sync');
 453     test_option('--ga-sync', 'ga sync');
 454     diag('--ga-dropget');
 455     test_option('-G', nolf(<<END)); # {{{
 456 ga sync'...
 457 git-update-dirs: Simulating 'ga drop --auto'...
 458 git-update-dirs: Simulating 'ga sync'...
 459 git-update-dirs: Simulating 'ga get --auto'...
 460 git-update-dirs: Simulating 'ga sync
 461 END
 462
 463     # }}}
 464     test_option('--ga-dropget', nolf(<<END)); # {{{
 465 ga sync'...
 466 git-update-dirs: Simulating 'ga drop --auto'...
 467 git-update-dirs: Simulating 'ga sync'...
 468 git-update-dirs: Simulating 'ga get --auto'...
 469 git-update-dirs: Simulating 'ga sync
 470 END
 471
 472     # }}}
 473     diag('--ga-dropunused');
 474     test_option('-u', nolf(<<END)); # {{{
 475 ga sync'...
 476 git-update-dirs: Simulating 'ga unused'...
 477 git-update-dirs: Simulating 'ga dropunused all'...
 478 git-update-dirs: Simulating 'ga sync
 479 END
 480
 481     # }}}
 482     test_option('--ga-dropunused', nolf(<<END)); # {{{
 483 ga sync'...
 484 git-update-dirs: Simulating 'ga unused'...
 485 git-update-dirs: Simulating 'ga dropunused all'...
 486 git-update-dirs: Simulating 'ga sync
 487 END
 488
 489     # }}}
 490     diag('--ga-moveunused');
 491     test_option('-U', nolf(<<END)); # {{{
 492 ga sync
 493 END
 494
 495     # }}}
 496     testcmd('git remote add seagate-3tb yep', # {{{
 497         '',
 498         '',
 499         0,
 500         "$repo: Add fake seagate-3tb remote",
 501     );
 502
 503     # }}}
 504     test_option('--ga-moveunused', nolf(<<END)); # {{{
 505 ga sync'...
 506 git-update-dirs: Simulating 'ga unused'...
 507 git-update-dirs: Simulating 'ga move --unused --to seagate-3tb'...
 508 git-update-dirs: Simulating 'ga sync
 509 END
 510
 511     # }}}
 512     diag('--ga-getnew');
 513     test_option('-N', 'ga-getnew');
 514     test_option('--ga-getnew', 'ga-getnew');
 515     diag('--ga-update-desc');
 516     test_option('-S', 'ga update-desc');
 517     test_option('--ga-update-desc', 'ga update-desc');
 518     diag('--dangling');
 519     test_option('-d', 'git dangling');
 520     test_option('--dangling', 'git dangling');
 521     diag('--allbr');
 522     if ($is_bare) {
 523         test_option('-a', nolf(<<END)); # {{{
 524 git nobr'...
 525 git-update-dirs: Simulating 'git allbr -a'...
 526 git-update-dirs: Simulating 'git checkout -
 527 END
 528
 529         # }}}
 530         test_option('--allbr', nolf(<<END)); # {{{
 531 git nobr'...
 532 git-update-dirs: Simulating 'git allbr -a'...
 533 git-update-dirs: Simulating 'git checkout -
 534 END
 535
 536         # }}}
 537     } else {
 538         testcmd("$CMD . -n --allbr", # {{{
 539             "$sep\n",
 540             '',
 541             0,
 542             'Ignore --allbr if it\'s only specified once in a non-bare repo',
 543         );
 544
 545         # }}}
 546         testcmd("$CMD . -n -a", # {{{
 547             "$sep\n",
 548             '',
 549             0,
 550             'Ignore -a if it\'s only specified once in a non-bare repo',
 551         );
 552
 553         # }}}
 554     }
 555     testcmd("$CMD -aan .", # {{{
 556         "$sep\n",
 557         <<END,
 558 git-update-dirs: Simulating 'git nobr'...
 559 git-update-dirs: Simulating 'git allbr -a'...
 560 git-update-dirs: Simulating 'git checkout -'...
 561 END
 562         0,
 563         "$repo: -aa works in non-bare repos, though",
 564     );
 565
 566     # }}}
 567     diag('--push');
 568     test_option('-P', 'git pa');
 569     test_option('--push', 'git pa');
 570     diag('--submodule');
 571     testcmd("$CMD --dry-run -s .", # {{{
 572         "================ . ================\n\n",
 573         '',
 574         0,
 575         "$repo: Test -s option, .gitmodules is missing",
 576     );
 577
 578     # }}}
 579     testcmd("touch .gitmodules", '', '', 0, "$repo: Create empty .gitmodules");
 580     test_option('--submodule', nolf(<<END)); # {{{
 581 git submodule init'...
 582 git-update-dirs: Simulating 'git submodule update
 583 END
 584
 585     # }}}
 586     diag('--compress');
 587     my $objects = $is_bare ? 'objects' : '.git\/objects';
 588     my $compress_output = # {{{
 589         '/^' .
 590         '================ \. ================\n' .
 591         '\n' .
 592         'Before: \d+\n' .
 593         'After : \d+\n' .
 594         'Saved : \d+ \(\d+.\d+%\)\n' .
 595         'Number of files in ' .
 596         $objects .
 597         ': before: \d+, after: \d+, saved: \d+\n' .
 598         '\n' .
 599         'Before: \d+\n' .
 600         'After : \d+\n' .
 601         'Total : \d+ \(\d+.\d+%\)\n' .
 602         'Number of object files: before: \d+, after: \d+, saved: \d+\n' .
 603         '/';
 604
 605     # }}}
 606     likecmd("$CMD -n -c .", # {{{
 607         $compress_output,
 608         '/^' .
 609             'git-update-dirs: Simulating \'git count-objects -vH\'\.\.\.\n' .
 610             'git-update-dirs: Simulating \'git gc\'\.\.\.\n' .
 611             '$/',
 612         0,
 613         "$repo: Test -c option",
 614     );
 615
 616     # }}}
 617     likecmd("$CMD -n --compress .", # {{{
 618         $compress_output,
 619         '/^' .
 620             'git-update-dirs: Simulating \'git count-objects -vH\'\.\.\.\n' .
 621             'git-update-dirs: Simulating \'git gc\'\.\.\.\n' .
 622             '$/',
 623         0,
 624         "$repo: Test --compress option",
 625     );
 626
 627     # }}}
 628     system("git config git-update-dirs.no-compress true");
 629     likecmd("$CMD -n -c .", # {{{
 630         '/^================ \. ================\n\n' .
 631         'Before: \d+\n' .
 632         'After : \d+\n' .
 633         'Number of object files: before: \d+, after: \d+, saved: \d+\n/',
 634         '/^$/',
 635         0,
 636         "$repo: Test disabling of -c",
 637     );
 638
 639     # }}}
 640     system("git config --unset git-update-dirs.no-compress");
 641     diag('--aggressive-compress');
 642     likecmd("$CMD -n -C .", # {{{
 643         $compress_output,
 644         '/^' .
 645             'git-update-dirs: Simulating \'git count-objects -vH\'\.\.\.\n' .
 646             'git-update-dirs: Simulating \'git gc --aggressive\'\.\.\.\n' .
 647             '$/',
 648         0,
 649         "$repo: Test -C option",
 650     );
 651
 652     # }}}
 653     likecmd("$CMD --dry-run --aggressive-compress .", # {{{
 654         $compress_output,
 655         '/^' .
 656             'git-update-dirs: Simulating \'git count-objects -vH\'\.\.\.\n' .
 657             'git-update-dirs: Simulating \'git gc --aggressive\'\.\.\.\n' .
 658             '$/',
 659         0,
 660         "$repo: Test --aggressive-compress option",
 661     );
 662
 663     # }}}
 664     system("git config git-update-dirs.no-aggressive-compress true");
 665     likecmd("$CMD -n -C .", # {{{
 666         '/^================ \. ================\n\n' .
 667         'Before: \d+\n' .
 668         'After : \d+\n' .
 669         'Number of object files: before: \d+, after: \d+, saved: \d+\n/',
 670         '/^$/',
 671         0,
 672         "$repo: Test disabling of -C",
 673     );
 674
 675     # }}}
 676     system("git config --unset git-update-dirs.no-aggressive-compress");
 677     diag('--delete-dangling');
 678     if ($is_bare) {
 679         # FIXME: This behaviour is up for debate. Should -D be ignored
 680         # in bare repositories by default?
 681         testcmd("$CMD -n -D .", # {{{
 682             "$sep\n",
 683             '',
 684             0,
 685             "$repo: Test -D",
 686         );
 687
 688         # }}}
 689         testcmd("$CMD -n --delete-dangling .", # {{{
 690             "$sep\n",
 691             '',
 692             0,
 693             "$repo: Test --delete-dangling",
 694         );
 695
 696         # }}}
 697     } else {
 698         test_option('-D', 'git dangling -D');
 699         test_option('--delete-dangling', 'git dangling -D');
 700     }
 701     diag('--exec-after');
 702     testcmd("$CMD -e 'echo This is nice' .", # {{{
 703         "${sep}This is nice\n\n",
 704         "git-update-dirs: Executing 'echo This is nice'...\n",
 705         0,
 706         "$repo: Test -e option",
 707     );
 708
 709     # }}}
 710     testcmd("$CMD --exec-after 'echo This is nice' .", # {{{
 711         "${sep}This is nice\n\n",
 712         "git-update-dirs: Executing 'echo This is nice'...\n",
 713         0,
 714         "$repo: Test --exec-after option",
 715     );
 716
 717     # }}}
 718     test_disabled("exec-after", "$CMD --exec-after echo .");
 719     diag('--all-options');
 720     my ($allbr_str, $pull_str);
 721     if ($is_bare) {
 722         $allbr_str = <<END;
 723 git-update-dirs: Simulating 'git nobr'...
 724 git-update-dirs: Simulating 'git allbr -a'...
 725 git-update-dirs: Simulating 'git checkout -'...
 726 END
 727         $pull_str = "";
 728     } else {
 729         $allbr_str = "";
 730         $pull_str = "git-update-dirs: Simulating 'git pull --ff-only'...\n";
 731     }
 732     testcmd("$CMD --all-options -n .", # {{{
 733         "$sep\n",
 734         <<END,
 735 git-update-dirs: Simulating 'lpar'...
 736 git-update-dirs: Simulating 'git fetch --all --prune'...
 737 ${pull_str}git-update-dirs: Simulating 'ga sync'...
 738 git-update-dirs: Simulating 'ga update-desc'...
 739 git-update-dirs: Simulating 'git dangling'...
 740 ${allbr_str}git-update-dirs: Simulating 'git pa'...
 741 git-update-dirs: Simulating 'git submodule init'...
 742 git-update-dirs: Simulating 'git submodule update'...
 743 git-update-dirs: Simulating 'lpar'...
 744 END
 745         0,
 746         "$repo: Test --all-options, allbr is ignored",
 747     );
 748
 749     # }}}
 750     testcmd("$CMD -Ana .", # {{{
 751         "$sep\n",
 752         <<END,
 753 git-update-dirs: Simulating 'lpar'...
 754 git-update-dirs: Simulating 'git fetch --all --prune'...
 755 ${pull_str}git-update-dirs: Simulating 'ga sync'...
 756 git-update-dirs: Simulating 'ga update-desc'...
 757 git-update-dirs: Simulating 'git dangling'...
 758 git-update-dirs: Simulating 'git nobr'...
 759 git-update-dirs: Simulating 'git allbr -a'...
 760 git-update-dirs: Simulating 'git checkout -'...
 761 git-update-dirs: Simulating 'git pa'...
 762 git-update-dirs: Simulating 'git submodule init'...
 763 git-update-dirs: Simulating 'git submodule update'...
 764 git-update-dirs: Simulating 'lpar'...
 765 END
 766         0,
 767         "$repo: Test the -A option with an extra -a to get some allbr action",
 768     );
 769
 770     # }}}
 771     ok(chdir('..'), "$repo: chdir ..");
 772     $CMD = "../../$CMDB";
 773     return;
 774     # }}}
 775 } # test_repo()
 776
 777 sub nolf {
 778     # Strip \n from string, replacement for chomp() {{{
 779     my $str = shift;
 780     $str =~ s/\n$//s;
 781     return($str);
 782     # }}}
 783 } # nolf()
 784
 785 sub test_option {
 786     # {{{
 787     my ($option, $cmd) = @_;
 788
 789     if (!-e $CMD) {
 790         BAIL_OUT("\$CMD is '$CMD', that's wrong");
 791     }
 792     testcmd("$CMD -n $option .",
 793         "================ . ================\n\n",
 794         "git-update-dirs: Simulating '$cmd'...\n",
 795         0,
 796         "$current_repo: Test $option option",
 797     );
 798     if ($option =~ /^--(.+)$/ && !defined($disable_already_tested{$1})) {
 799         test_disabled($1);
 800     }
 801     return;
 802     # }}}
 803 } # test_option()
 804
 805 sub test_disabled {
 806     # Test disabling of commands {{{
 807     my ($longopt, $command) = @_;
 808     system("git config git-update-dirs.no-$longopt true");
 809     # Some commands calls "ga sync", so also disable "ga sync" to
 810     # avoid that single line appear in the output.
 811     if ($longopt =~ /^(ga-dropget|ga-dropunused|ga-moveunused)$/) {
 812         system("git config git-update-dirs.no-ga-sync true");
 813     }
 814     defined($command) || ($command = "../../../$CMDB -n --$longopt .");
 815     testcmd($command,
 816         "================ . ================\n\n",
 817         '',
 818         0,
 819         "$current_repo: --$longopt is disabled",
 820     );
 821     system("git config --unset git-update-dirs.no-$longopt");
 822     if ($longopt =~ /^(ga-dropget|ga-dropunused|ga-moveunused)$/) {
 823         system("git config --unset git-update-dirs.no-ga-sync");
 824     }
 825     $disable_already_tested{$longopt} = 1;
 826     return;
 827     # }}}
 828 } # test_disabled()
 829
 830 sub testcmd {
 831     # {{{
 832     my ($Cmd, $Exp_stdout, $Exp_stderr, $Exp_retval, $Desc) = @_;
 833     defined($descriptions{$Desc}) &&
 834         BAIL_OUT("testcmd(): '$Desc' description is used twice");
 835     $descriptions{$Desc} = 1;
 836     my $stderr_cmd = '';
 837     my $cmd_outp_str = $Opt{'verbose'} >= 1 ? "\"$Cmd\" - " : '';
 838     my $Txt = join('', $cmd_outp_str, defined($Desc) ? $Desc : '');
 839     my $TMP_STDERR = "$CMDB-stderr.tmp";
 840     my $retval = 1;
 841
 842     if (defined($Exp_stderr)) {
 843         $stderr_cmd = " 2>$TMP_STDERR";
 844     }
 845     $retval &= is(`$Cmd$stderr_cmd`, $Exp_stdout, "$Txt (stdout)");
 846     my $ret_val = $?;
 847     if (defined($Exp_stderr)) {
 848         $retval &= is(file_data($TMP_STDERR), $Exp_stderr, "$Txt (stderr)");
 849         unlink($TMP_STDERR);
 850     } else {
 851         diag("Warning: stderr not defined for '$Txt'");
 852     }
 853     $retval &= is($ret_val >> 8, $Exp_retval, "$Txt (retval)");
 854
 855     return $retval;
 856     # }}}
 857 } # testcmd()
 858
 859 sub likecmd {
 860     # {{{
 861     my ($Cmd, $Exp_stdout, $Exp_stderr, $Exp_retval, $Desc) = @_;
 862     defined($descriptions{$Desc}) &&
 863         BAIL_OUT("likecmd(): '$Desc' description is used twice");
 864     $descriptions{$Desc} = 1;
 865     my $stderr_cmd = '';
 866     my $cmd_outp_str = $Opt{'verbose'} >= 1 ? "\"$Cmd\" - " : '';
 867     my $Txt = join('', $cmd_outp_str, defined($Desc) ? $Desc : '');
 868     my $TMP_STDERR = "$CMDB-stderr.tmp";
 869     my $retval = 1;
 870
 871     if (defined($Exp_stderr)) {
 872         $stderr_cmd = " 2>$TMP_STDERR";
 873     }
 874     $retval &= like(`$Cmd$stderr_cmd`, $Exp_stdout, "$Txt (stdout)");
 875     my $ret_val = $?;
 876     if (defined($Exp_stderr)) {
 877         $retval &= like(file_data($TMP_STDERR), $Exp_stderr, "$Txt (stderr)");
 878         unlink($TMP_STDERR);
 879     } else {
 880         diag("Warning: stderr not defined for '$Txt'");
 881     }
 882     $retval &= is($ret_val >> 8, $Exp_retval, "$Txt (retval)");
 883
 884     return $retval;
 885     # }}}
 886 } # likecmd()
 887
 888 sub file_data {
 889     # Return file content as a string {{{
 890     my $File = shift;
 891     my $Txt;
 892
 893     open(my $fp, '<', $File) or return undef;
 894     local $/ = undef;
 895     $Txt = <$fp>;
 896     close($fp);
 897     return $Txt;
 898     # }}}
 899 } # file_data()
 900
 901 sub create_file {
 902     # Create new file and fill it with data {{{
 903     my ($file, $text) = @_;
 904     my $retval = 0;
 905     if (open(my $fp, ">$file")) {
 906         print($fp $text);
 907         close($fp);
 908         $retval = is(
 909             file_data($file),
 910             $text,
 911             "$file was successfully created",
 912         );
 913     }
 914     return($retval); # 0 if error, 1 if ok
 915     # }}}
 916 } # create_file()
 917
 918 sub print_version {
 919     # Print program version {{{
 920     print("$progname $VERSION\n");
 921     return;
 922     # }}}
 923 } # print_version()
 924
 925 sub usage {
 926     # Send the help message to stdout {{{
 927     my $Retval = shift;
 928
 929     if ($Opt{'verbose'}) {
 930         print("\n");
 931         print_version();
 932     }
 933     print(<<"END");
 934
 935 Usage: $progname [options]
 936
 937 Contains tests for the $CMDB(1) program.
 938
 939 Options:
 940
 941   -a, --all
 942     Run all tests, also TODOs.
 943   -h, --help
 944     Show this help.
 945   -q, --quiet
 946     Be more quiet. Can be repeated to increase silence.
 947   -t, --todo
 948     Run only the TODO tests.
 949   -v, --verbose
 950     Increase level of verbosity. Can be repeated.
 951   --version
 952     Print version information.
 953
 954 END
 955     exit($Retval);
 956     # }}}
 957 } # usage()
 958
 959 sub msg {
 960     # Print a status message to stderr based on verbosity level {{{
 961     my ($verbose_level, $Txt) = @_;
 962
 963     $verbose_level > $Opt{'verbose'} && return;
 964     print(STDERR "$progname: $Txt\n");
 965     return;
 966     # }}}
 967 } # msg()
 968
 969 __END__
 970
 971 # This program is free software; you can redistribute it and/or modify
 972 # it under the terms of the GNU General Public License as published by
 973 # the Free Software Foundation; either version 2 of the License, or (at
 974 # your option) any later version.
 975 #
 976 # This program is distributed in the hope that it will be useful, but
 977 # WITHOUT ANY WARRANTY; without even the implied warranty of
 978 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 979 # See the GNU General Public License for more details.
 980 #
 981 # You should have received a copy of the GNU General Public License
 982 # along with this program.
 983 # If not, see L<http://www.gnu.org/licenses/>.
 984
 985 # vim: set fenc=UTF-8 ft=perl fdm=marker ts=4 sw=4 sts=4 et fo+=w :