perlmodules.t: Remove Module::Starter and Module::Starter::Plugin::CGIApp
[sunny256-utils.git] / tests / git-update-dirs.t
blobbe3c71c9ed392f349df2889e9656aa1d0d1fafef
1 #!/usr/bin/env perl
3 #=======================================================================
4 # git-update-dirs.t
5 # File ID: 9072b5a4-f909-11e4-b80e-000df06acc56
7 # Test suite for git-update-dirs(1).
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 #=======================================================================
15 use strict;
16 use warnings;
18 BEGIN {
19 use Test::More qw{no_plan};
20 # use_ok() goes here
23 use Cwd qw{ abs_path getcwd };
24 use Getopt::Long;
26 local $| = 1;
28 our $CMDB = "git-update-dirs";
29 our $CMD = "../$CMDB";
31 our %Opt = (
33 'all' => 0,
34 'help' => 0,
35 'quiet' => 0,
36 'todo' => 0,
37 'verbose' => 0,
38 'version' => 0,
42 our $progname = $0;
43 $progname =~ s/^.*\/(.*?)$/$1/;
44 our $VERSION = '0.0.0';
46 my $current_repo;
47 my %descriptions = ();
48 my %disable_already_tested = ();
49 my $abspwd = abs_path(getcwd());
51 Getopt::Long::Configure('bundling');
52 GetOptions(
54 'all|a' => \$Opt{'all'},
55 'help|h' => \$Opt{'help'},
56 'quiet|q+' => \$Opt{'quiet'},
57 'todo|t' => \$Opt{'todo'},
58 'verbose|v+' => \$Opt{'verbose'},
59 'version' => \$Opt{'version'},
61 ) || die("$progname: Option error. Use -h for help.\n");
63 $Opt{'verbose'} -= $Opt{'quiet'};
64 $Opt{'help'} && usage(0);
65 if ($Opt{'version'}) {
66 print_version();
67 exit(0);
70 exit(main());
72 sub main {
73 # {{{
74 my $Retval = 0;
76 diag(sprintf('========== Executing %s v%s ==========',
77 $progname, $VERSION));
79 if ($Opt{'todo'} && !$Opt{'all'}) {
80 goto todo_section;
83 =pod
85 testcmd("$CMD command", # {{{
86 <<'END',
87 [expected stdout]
88 END
89 '',
91 'description',
94 # }}}
96 =cut
98 my $Tmptop = "tmp-git-update-dirs-t-$$-" . substr(rand, 2, 8);
99 my $abstop = "$abspwd/$Tmptop";
100 ok(mkdir($Tmptop), "mkdir [Tmptop]") ||
101 BAIL_OUT("$Tmptop: mkdir error, can't continue\n");
102 ok(chdir($Tmptop), "chdir [Tmptop]") ||
103 BAIL_OUT("$progname: $Tmptop: chdir error, can't continue\n");
104 chomp($ENV{'HOME'} = `pwd`);
105 testcmd('git config --global user.name "Suttleif Fisen"', '', '', 0,
106 'git config --global user.name "Suttleif Fisen"');
107 testcmd('git config --global user.email suttleif@example.com', '', '', 0,
108 'git config --global user.email suttleif@example.com');
109 testcmd('git config --global init.defaultbranch master', '', '', 0,
110 'git config --global init.defaultbranch master');
111 $CMD = "../$CMD";
113 diag('Testing -h (--help) option...');
114 likecmd("$CMD -h", # {{{
115 '/ Show this help/i',
116 '/^$/',
118 'Option -h prints help screen',
121 # }}}
122 diag('Testing -v (--verbose) option...');
123 likecmd("$CMD -hv", # {{{
124 '/^\n\S+ \d+\.\d+\.\d+/s',
125 '/^$/',
127 'Option -v with -h returns version number and help screen',
130 # }}}
131 diag('Testing --version option...');
132 likecmd("$CMD --version", # {{{
133 '/^\S+ \d+\.\d+\.\d+/',
134 '/^$/',
136 'Option --version returns version number',
139 # }}}
140 likecmd("git --version", # {{{
141 '/^git version /',
142 '/^$/',
144 'git is installed',
145 ) || BAIL_OUT("git is not installed, cannot continue");
147 # }}}
148 if (`git-annex version 2>/dev/null` !~ /^git-annex version/) {
149 # FIXME: Use with existing annex tests instead
150 diag("git-annex is not installed here, skipping tests");
151 return 0;
153 likecmd("git annex version", # {{{
154 '/^git-annex version:/',
155 '/^$/',
157 'git-annex is installed',
158 ) || BAIL_OUT("git-annex is not installed, cannot continue");
160 # }}}
161 diag('Initialise repositories');
162 likecmd("git init --bare bare.git", # {{{
163 '/.*/',
164 '/^$/',
166 'Create bare Git repository',
169 # }}}
170 likecmd("git clone bare.git repo", # {{{
171 '/.*/',
172 '/.*/',
174 'Clone bare.git to \'repo\'',
177 # }}}
179 test_repo('repo', 0, $abspwd, $Tmptop);
180 test_repo('bare.git', 1, $abspwd, $Tmptop);
182 my @dir_list = qw {
183 repo/sub2
184 repo/sub1
185 repo/sub1/subrepo1
186 repo/bare1.git
187 repo/sub1/subrepo1/subsubrepo1.git
190 for my $dir (@dir_list) {
191 my $bare_str = ($dir =~ /\.git$/ ? ' --bare' : '');
192 likecmd("git$bare_str init $dir",
193 '/.*/',
194 '/^$/',
196 "Create repo '$dir'",
200 testcmd("$CMD --recursive -nf", # {{{
201 <<END,
202 ================ $abstop/repo ================
204 ================ $abstop/repo/sub1 ================
206 ================ $abstop/repo/sub1/subrepo1 ================
208 ================ $abstop/repo/sub2 ================
211 "git-update-dirs: Simulating 'git fetch --all'...\n" x 4,
213 "--recursive option",
216 # }}}
217 testcmd("$CMD -rfn", # {{{
218 <<END,
219 ================ $abstop/repo ================
221 ================ $abstop/repo/sub1 ================
223 ================ $abstop/repo/sub1/subrepo1 ================
225 ================ $abstop/repo/sub2 ================
228 "git-update-dirs: Simulating 'git fetch --all'...\n" x 4,
230 "-r (recursive) option",
233 # }}}
234 create_file("filelist.txt", join("\n", @dir_list));
235 testcmd("$CMD --dirs-from filelist.txt -nf", # {{{
236 <<END,
237 ================ $abstop/repo/sub2 ================
239 ================ $abstop/repo/sub1 ================
241 ================ $abstop/repo/sub1/subrepo1 ================
243 ================ $abstop/repo/bare1.git ================
245 ================ $abstop/repo/sub1/subrepo1/subsubrepo1.git ================
248 "git-update-dirs: Simulating 'git fetch --all'...\n" x 5,
250 "--dirs-from option",
253 # }}}
254 testcmd("$CMD --fetch -n --dirs-from - <filelist.txt", # {{{
255 <<END,
256 ================ $abstop/repo/sub2 ================
258 ================ $abstop/repo/sub1 ================
260 ================ $abstop/repo/sub1/subrepo1 ================
262 ================ $abstop/repo/bare1.git ================
264 ================ $abstop/repo/sub1/subrepo1/subsubrepo1.git ================
267 "git-update-dirs: Simulating 'git fetch --all'...\n" x 5,
269 "Read file list from stdin with '--dirs-from -'",
272 # }}}
273 create_file("filelist2.txt", <<END);
274 repo/sub2
275 repo/bare1.git
276 repo/sub1
278 testcmd("$CMD --fetch -n --dirs-from filelist.txt " .
279 "--dirs-from filelist2.txt", # {{{
280 <<END,
281 ================ $abstop/repo/sub2 ================
283 ================ $abstop/repo/sub1 ================
285 ================ $abstop/repo/sub1/subrepo1 ================
287 ================ $abstop/repo/bare1.git ================
289 ================ $abstop/repo/sub1/subrepo1/subsubrepo1.git ================
291 ================ $abstop/repo/sub2 ================
293 ================ $abstop/repo/bare1.git ================
295 ================ $abstop/repo/sub1 ================
298 "git-update-dirs: Simulating 'git fetch --all'...\n" x 8,
300 "--dirs-from is specified twice, read from two files",
303 # }}}
304 ok(unlink("filelist.txt"), "Delete filelist.txt");
305 ok(unlink("filelist2.txt"), "Delete filelist2.txt");
307 diag('Clean up');
308 testcmd("rm -rf bare.git", # {{{
312 'Remove bare test repository',
315 # }}}
316 testcmd("rm -rf repo", # {{{
320 'Remove non-bare test repository',
323 # }}}
324 ok(unlink(".gitconfig"), "Delete .gitconfig");
325 testcmd("rm -rf .cache", "", "", 0, "Delete .cache/, created by git-annex");
326 testcmd("rm -rf .ssh", "", "", 0, "Delete .ssh/, created by git-annex");
327 ok(chdir(".."), "chdir ..");
328 ok(-d $Tmptop, "[Tmptop] exists");
329 ok(rmdir($Tmptop), "rmdir [Tmptop]");
330 ok(!-d $Tmptop, "[Tmptop] is gone");
332 todo_section:
335 if ($Opt{'all'} || $Opt{'todo'}) {
336 diag('Running TODO tests...'); # {{{
338 TODO: {
340 local $TODO = '';
341 # Insert TODO tests here.
344 # TODO tests }}}
347 diag('Testing finished.');
348 return $Retval;
349 # }}}
350 } # main()
352 sub test_repo {
353 # {{{
354 my ($repo, $is_bare, $abspwd, $Tmptop) = @_;
355 my $absrepo = "$abspwd/$Tmptop/$repo";
357 diag("Run tests in $repo");
358 $current_repo = $repo;
359 ok(chdir($repo), "chdir $repo") || BAIL_OUT('chdir error');
360 $CMD = "../../../$CMDB";
361 if (!-e $CMD) {
362 BAIL_OUT("test_repo(): \$CMD is '$CMD', that's wrong");
364 if (!$is_bare) {
365 likecmd("git remote add bare ../bare.git", # {{{
366 '/^$/',
367 '/^$/',
369 'Create bare remote',
372 # }}}
373 likecmd("git commit --allow-empty -m 'Empty start commit'", # {{{
374 '/.*/',
375 '/^$/',
377 'Create empty start commit',
380 # }}}
381 likecmd("git push bare master", # {{{
382 '/.*/',
383 '/.*/',
385 'Push master to the bare repo',
388 # }}}
390 likecmd("git annex init " . ($is_bare ? "bare" : "repo"), # {{{
391 '/.*/',
392 '/^$/',
394 "Make $repo an annex",
397 # }}}
398 my $sep = "================ $absrepo ================\n";
400 diag('--exec-before');
401 testcmd("$CMD -E 'echo This is nice' .", # {{{
402 "${sep}This is nice\n\n",
403 "git-update-dirs: Executing 'echo This is nice'...\n",
405 "$repo: Test -E option",
408 # }}}
409 testcmd("$CMD --exec-before 'echo This is nice' .", # {{{
410 "${sep}This is nice\n\n",
411 "git-update-dirs: Executing 'echo This is nice'...\n",
413 "$repo: Test --exec-before option",
416 # }}}
417 test_disabled("exec-before", "$CMD --exec-before echo .", $absrepo);
418 diag('--lpar');
419 testcmd("$CMD -n -l .", # {{{
420 "$sep\n",
421 "git-update-dirs: Simulating 'lpar'...\n" .
422 "git-update-dirs: Simulating 'lpar'...\n",
424 "$repo: Test -l option",
427 # }}}
428 testcmd("$CMD -n --lpar .", # {{{
429 "$sep\n",
430 "git-update-dirs: Simulating 'lpar'...\n" .
431 "git-update-dirs: Simulating 'lpar'...\n",
433 "$repo: Test --lpar option",
436 # }}}
437 test_disabled("lpar", undef, $absrepo);
438 diag('--test');
439 test_option('-t', 'git fsck', $absrepo);
440 test_option('--test', 'git fsck', $absrepo);
441 diag('--fetch-prune');
442 test_option('-F', 'git fetch --all --prune', $absrepo);
443 test_option('--fetch-prune', 'git fetch --all --prune', $absrepo);
444 diag('--fetch');
445 test_option('-f', 'git fetch --all', $absrepo);
446 test_option('--fetch', 'git fetch --all', $absrepo);
447 diag('--pull');
448 if ($is_bare) {
449 testcmd("$CMD -n -p", '', '', 0, "$repo: Test -p");
450 testcmd("$CMD -n --pull", '', '', 0, "$repo: Test --pull");
451 } else {
452 test_option('-p', 'git pull --ff-only', $absrepo);
453 test_option('--pull', 'git pull --ff-only', $absrepo);
455 diag('--ga-sync');
456 test_option('-g', 'ga sync', $absrepo);
457 test_option('--ga-sync', 'ga sync', $absrepo);
458 diag('--ga-dropget');
459 test_option('-G', nolf(<<END), $absrepo); # {{{
460 ga sync'...
461 git-update-dirs: Simulating 'ga drop --auto'...
462 git-update-dirs: Simulating 'ga sync'...
463 git-update-dirs: Simulating 'ga get --auto'...
464 git-update-dirs: Simulating 'ga sync
467 # }}}
468 test_option('--ga-dropget', nolf(<<END), $absrepo); # {{{
469 ga sync'...
470 git-update-dirs: Simulating 'ga drop --auto'...
471 git-update-dirs: Simulating 'ga sync'...
472 git-update-dirs: Simulating 'ga get --auto'...
473 git-update-dirs: Simulating 'ga sync
476 # }}}
477 diag('--ga-dropunused');
478 test_option('-u', nolf(<<END), $absrepo); # {{{
479 ga sync'...
480 git-update-dirs: Simulating 'ga unused'...
481 git-update-dirs: Simulating 'ga dropunused all'...
482 git-update-dirs: Simulating 'ga sync
485 # }}}
486 test_option('--ga-dropunused', nolf(<<END), $absrepo); # {{{
487 ga sync'...
488 git-update-dirs: Simulating 'ga unused'...
489 git-update-dirs: Simulating 'ga dropunused all'...
490 git-update-dirs: Simulating 'ga sync
493 # }}}
494 diag('--ga-moveunused');
495 test_option('-U', nolf(<<END), $absrepo); # {{{
496 ga sync
499 # }}}
500 testcmd('git remote add seagate-3tb yep', # {{{
504 "$repo: Add fake seagate-3tb remote",
507 # }}}
508 test_option('--ga-moveunused', nolf(<<END), $absrepo); # {{{
509 ga sync'...
510 git-update-dirs: Simulating 'ga unused'...
511 git-update-dirs: Simulating 'ga move --unused --to seagate-3tb'...
512 git-update-dirs: Simulating 'ga sync
515 # }}}
516 diag('--ga-getnew');
517 test_option('-N', 'ga-getnew', $absrepo);
518 test_option('--ga-getnew', 'ga-getnew', $absrepo);
519 diag('--ga-update-desc');
520 test_option('-S', 'ga update-desc', $absrepo);
521 test_option('--ga-update-desc', 'ga update-desc', $absrepo);
522 diag('--dangling');
523 test_option('-d', 'git dangling', $absrepo);
524 test_option('--dangling', 'git dangling', $absrepo);
525 diag('--allbr');
526 if ($is_bare) {
527 test_option('-a', nolf(<<END), $absrepo); # {{{
528 git nobr'...
529 git-update-dirs: Simulating 'git allbr -a'...
530 git-update-dirs: Simulating 'git checkout -
533 # }}}
534 test_option('--allbr', nolf(<<END), $absrepo); # {{{
535 git nobr'...
536 git-update-dirs: Simulating 'git allbr -a'...
537 git-update-dirs: Simulating 'git checkout -
540 # }}}
541 } else {
542 testcmd("$CMD . -n --allbr", # {{{
543 "$sep\n",
546 'Ignore --allbr if it\'s only specified once in a non-bare repo',
549 # }}}
550 testcmd("$CMD . -n -a", # {{{
551 "$sep\n",
554 'Ignore -a if it\'s only specified once in a non-bare repo',
557 # }}}
559 testcmd("$CMD -aan .", # {{{
560 "$sep\n",
561 <<END,
562 git-update-dirs: Simulating 'git nobr'...
563 git-update-dirs: Simulating 'git allbr -a'...
564 git-update-dirs: Simulating 'git checkout -'...
567 "$repo: -aa works in non-bare repos, though",
570 # }}}
571 diag('--push');
572 test_option('-P', 'git pa', $absrepo);
573 test_option('--push', 'git pa', $absrepo);
574 diag('--submodule');
575 testcmd("$CMD --dry-run -s .", # {{{
576 "================ $absrepo ================\n\n",
579 "$repo: Test -s option, .gitmodules is missing",
582 # }}}
583 testcmd("touch .gitmodules", '', '', 0, "$repo: Create empty .gitmodules");
584 test_option('--submodule', nolf(<<END), $absrepo); # {{{
585 git submodule init'...
586 git-update-dirs: Simulating 'git submodule update
589 # }}}
590 diag('--compress');
591 my $objects = $is_bare ? 'objects' : '.git\/objects';
592 my $absrepo_r = $absrepo;
593 $absrepo_r =~ s,/,\\/,g;
594 my $compress_output = # {{{
595 '/^' .
596 "================ $absrepo_r ================\\n" .
597 '\n' .
598 'Before: \d+\n' .
599 'After : \d+\n' .
600 'Saved : \d+ \(\d+.\d+%\)\n' .
601 'Number of files in ' .
602 $objects .
603 ': before: \d+, after: \d+, saved: \d+\n' .
604 '\n' .
605 'Before: \d+\n' .
606 'After : \d+\n' .
607 'Total : \d+ \(\d+.\d+%\)\n' .
608 'Number of object files: before: \d+, after: \d+, saved: \d+\n' .
609 '/';
611 # }}}
612 likecmd("$CMD -n -c .", # {{{
613 $compress_output,
614 '/^' .
615 'git-update-dirs: Simulating \'git count-objects -vH\'\.\.\.\n' .
616 'git-update-dirs: Simulating \'git gc\'\.\.\.\n' .
617 '$/',
619 "$repo: Test -c option",
622 # }}}
623 likecmd("$CMD -n --compress .", # {{{
624 $compress_output,
625 '/^' .
626 'git-update-dirs: Simulating \'git count-objects -vH\'\.\.\.\n' .
627 'git-update-dirs: Simulating \'git gc\'\.\.\.\n' .
628 '$/',
630 "$repo: Test --compress option",
633 # }}}
634 system("git config git-update-dirs.no-compress true");
635 likecmd("$CMD -n -c .", # {{{
636 "/^================ $absrepo_r ================\\n\\n" .
637 'Before: \d+\n' .
638 'After : \d+\n' .
639 'Number of object files: before: \d+, after: \d+, saved: \d+\n/',
640 '/^$/',
642 "$repo: Test disabling of -c",
645 # }}}
646 system("git config --unset git-update-dirs.no-compress");
647 diag('--aggressive-compress');
648 likecmd("$CMD -n -C .", # {{{
649 $compress_output,
650 '/^' .
651 'git-update-dirs: Simulating \'git count-objects -vH\'\.\.\.\n' .
652 'git-update-dirs: Simulating \'git gc --aggressive\'\.\.\.\n' .
653 '$/',
655 "$repo: Test -C option",
658 # }}}
659 likecmd("$CMD --dry-run --aggressive-compress .", # {{{
660 $compress_output,
661 '/^' .
662 'git-update-dirs: Simulating \'git count-objects -vH\'\.\.\.\n' .
663 'git-update-dirs: Simulating \'git gc --aggressive\'\.\.\.\n' .
664 '$/',
666 "$repo: Test --aggressive-compress option",
669 # }}}
670 system("git config git-update-dirs.no-aggressive-compress true");
671 likecmd("$CMD -n -C .", # {{{
672 "/^================ $absrepo_r ================\\n\\n" .
673 'Before: \d+\n' .
674 'After : \d+\n' .
675 'Number of object files: before: \d+, after: \d+, saved: \d+\n/',
676 '/^$/',
678 "$repo: Test disabling of -C",
681 # }}}
682 system("git config --unset git-update-dirs.no-aggressive-compress");
683 diag('--delete-dangling');
684 if ($is_bare) {
685 # FIXME: This behaviour is up for debate. Should -D be ignored
686 # in bare repositories by default?
687 testcmd("$CMD -n -D .", # {{{
688 "$sep\n",
691 "$repo: Test -D",
694 # }}}
695 testcmd("$CMD -n --delete-dangling .", # {{{
696 "$sep\n",
699 "$repo: Test --delete-dangling",
702 # }}}
703 } else {
704 test_option('-D', 'git dangling -D', $absrepo);
705 test_option('--delete-dangling', 'git dangling -D', $absrepo);
707 diag('--exec-after');
708 testcmd("$CMD -e 'echo This is nice' .", # {{{
709 "${sep}This is nice\n\n",
710 "git-update-dirs: Executing 'echo This is nice'...\n",
712 "$repo: Test -e option",
715 # }}}
716 testcmd("$CMD --exec-after 'echo This is nice' .", # {{{
717 "${sep}This is nice\n\n",
718 "git-update-dirs: Executing 'echo This is nice'...\n",
720 "$repo: Test --exec-after option",
723 # }}}
724 test_disabled("exec-after", "$CMD --exec-after echo .", $absrepo);
725 diag('--all-options');
726 my ($allbr_str, $pull_str);
727 if ($is_bare) {
728 $allbr_str = <<END;
729 git-update-dirs: Simulating 'git nobr'...
730 git-update-dirs: Simulating 'git allbr -a'...
731 git-update-dirs: Simulating 'git checkout -'...
733 $pull_str = "";
734 } else {
735 $allbr_str = "";
736 $pull_str = "git-update-dirs: Simulating 'git pull --ff-only'...\n";
738 testcmd("$CMD --all-options -n .", # {{{
739 "$sep\n",
740 <<END,
741 git-update-dirs: Simulating 'lpar'...
742 git-update-dirs: Simulating 'git fetch --all --prune'...
743 ${pull_str}git-update-dirs: Simulating 'ga sync'...
744 git-update-dirs: Simulating 'ga update-desc'...
745 git-update-dirs: Simulating 'git dangling'...
746 ${allbr_str}git-update-dirs: Simulating 'git pa'...
747 git-update-dirs: Simulating 'git submodule init'...
748 git-update-dirs: Simulating 'git submodule update'...
749 git-update-dirs: Simulating 'lpar'...
752 "$repo: Test --all-options, allbr is ignored",
755 # }}}
756 testcmd("$CMD -Ana .", # {{{
757 "$sep\n",
758 <<END,
759 git-update-dirs: Simulating 'lpar'...
760 git-update-dirs: Simulating 'git fetch --all --prune'...
761 ${pull_str}git-update-dirs: Simulating 'ga sync'...
762 git-update-dirs: Simulating 'ga update-desc'...
763 git-update-dirs: Simulating 'git dangling'...
764 git-update-dirs: Simulating 'git nobr'...
765 git-update-dirs: Simulating 'git allbr -a'...
766 git-update-dirs: Simulating 'git checkout -'...
767 git-update-dirs: Simulating 'git pa'...
768 git-update-dirs: Simulating 'git submodule init'...
769 git-update-dirs: Simulating 'git submodule update'...
770 git-update-dirs: Simulating 'lpar'...
773 "$repo: Test the -A option with an extra -a to get some allbr action",
776 # }}}
777 ok(chdir('..'), "$repo: chdir ..");
778 $CMD = "../../$CMDB";
779 return;
780 # }}}
781 } # test_repo()
783 sub nolf {
784 # Strip \n from string, replacement for chomp() {{{
785 my $str = shift;
786 $str =~ s/\n$//s;
787 return($str);
788 # }}}
789 } # nolf()
791 sub test_option {
792 # {{{
793 my ($option, $cmd, $absrepo) = @_;
795 if (!-e $CMD) {
796 BAIL_OUT("\$CMD is '$CMD', that's wrong");
798 testcmd("$CMD -n $option .",
799 "================ $absrepo ================\n\n",
800 "git-update-dirs: Simulating '$cmd'...\n",
802 "$current_repo: Test $option option",
804 if ($option =~ /^--(.+)$/ && !defined($disable_already_tested{$1})) {
805 test_disabled($1, undef, $absrepo);
807 return;
808 # }}}
809 } # test_option()
811 sub test_disabled {
812 # Test disabling of commands {{{
813 my ($longopt, $command, $absrepo) = @_;
814 system("git config git-update-dirs.no-$longopt true");
815 # Some commands calls "ga sync", so also disable "ga sync" to
816 # avoid that single line appear in the output.
817 if ($longopt =~ /^(ga-dropget|ga-dropunused|ga-moveunused)$/) {
818 system("git config git-update-dirs.no-ga-sync true");
820 defined($command) || ($command = "../../../$CMDB -n --$longopt .");
821 testcmd($command,
822 "================ $absrepo ================\n\n",
825 "$current_repo: --$longopt is disabled",
827 system("git config --unset git-update-dirs.no-$longopt");
828 if ($longopt =~ /^(ga-dropget|ga-dropunused|ga-moveunused)$/) {
829 system("git config --unset git-update-dirs.no-ga-sync");
831 $disable_already_tested{$longopt} = 1;
832 return;
833 # }}}
834 } # test_disabled()
836 sub testcmd {
837 # {{{
838 my ($Cmd, $Exp_stdout, $Exp_stderr, $Exp_retval, $Desc) = @_;
839 defined($descriptions{$Desc}) &&
840 BAIL_OUT("testcmd(): '$Desc' description is used twice");
841 $descriptions{$Desc} = 1;
842 my $stderr_cmd = '';
843 my $cmd_outp_str = $Opt{'verbose'} >= 1 ? "\"$Cmd\" - " : '';
844 my $Txt = join('', $cmd_outp_str, defined($Desc) ? $Desc : '');
845 my $TMP_STDERR = "$CMDB-stderr.tmp";
846 my $retval = 1;
848 if (defined($Exp_stderr)) {
849 $stderr_cmd = " 2>$TMP_STDERR";
851 $retval &= is(`$Cmd$stderr_cmd`, $Exp_stdout, "$Txt (stdout)");
852 my $ret_val = $?;
853 if (defined($Exp_stderr)) {
854 $retval &= is(file_data($TMP_STDERR), $Exp_stderr, "$Txt (stderr)");
855 unlink($TMP_STDERR);
856 } else {
857 diag("Warning: stderr not defined for '$Txt'");
859 $retval &= is($ret_val >> 8, $Exp_retval, "$Txt (retval)");
861 return $retval;
862 # }}}
863 } # testcmd()
865 sub likecmd {
866 # {{{
867 my ($Cmd, $Exp_stdout, $Exp_stderr, $Exp_retval, $Desc) = @_;
868 defined($descriptions{$Desc}) &&
869 BAIL_OUT("likecmd(): '$Desc' description is used twice");
870 $descriptions{$Desc} = 1;
871 my $stderr_cmd = '';
872 my $cmd_outp_str = $Opt{'verbose'} >= 1 ? "\"$Cmd\" - " : '';
873 my $Txt = join('', $cmd_outp_str, defined($Desc) ? $Desc : '');
874 my $TMP_STDERR = "$CMDB-stderr.tmp";
875 my $retval = 1;
877 if (defined($Exp_stderr)) {
878 $stderr_cmd = " 2>$TMP_STDERR";
880 $retval &= like(`$Cmd$stderr_cmd`, $Exp_stdout, "$Txt (stdout)");
881 my $ret_val = $?;
882 if (defined($Exp_stderr)) {
883 $retval &= like(file_data($TMP_STDERR), $Exp_stderr, "$Txt (stderr)");
884 unlink($TMP_STDERR);
885 } else {
886 diag("Warning: stderr not defined for '$Txt'");
888 $retval &= is($ret_val >> 8, $Exp_retval, "$Txt (retval)");
890 return $retval;
891 # }}}
892 } # likecmd()
894 sub file_data {
895 # Return file content as a string {{{
896 my $File = shift;
897 my $Txt;
899 open(my $fp, '<', $File) or return undef;
900 local $/ = undef;
901 $Txt = <$fp>;
902 close($fp);
903 return $Txt;
904 # }}}
905 } # file_data()
907 sub create_file {
908 # Create new file and fill it with data {{{
909 my ($file, $text) = @_;
910 my $retval = 0;
911 if (open(my $fp, ">$file")) {
912 print($fp $text);
913 close($fp);
914 $retval = is(
915 file_data($file),
916 $text,
917 "$file was successfully created",
920 return($retval); # 0 if error, 1 if ok
921 # }}}
922 } # create_file()
924 sub print_version {
925 # Print program version {{{
926 print("$progname $VERSION\n");
927 return;
928 # }}}
929 } # print_version()
931 sub usage {
932 # Send the help message to stdout {{{
933 my $Retval = shift;
935 if ($Opt{'verbose'}) {
936 print("\n");
937 print_version();
939 print(<<"END");
941 Usage: $progname [options]
943 Contains tests for the $CMDB(1) program.
945 Options:
947 -a, --all
948 Run all tests, also TODOs.
949 -h, --help
950 Show this help.
951 -q, --quiet
952 Be more quiet. Can be repeated to increase silence.
953 -t, --todo
954 Run only the TODO tests.
955 -v, --verbose
956 Increase level of verbosity. Can be repeated.
957 --version
958 Print version information.
961 exit($Retval);
962 # }}}
963 } # usage()
965 sub msg {
966 # Print a status message to stderr based on verbosity level {{{
967 my ($verbose_level, $Txt) = @_;
969 $verbose_level > $Opt{'verbose'} && return;
970 print(STDERR "$progname: $Txt\n");
971 return;
972 # }}}
973 } # msg()
975 __END__
977 # This program is free software; you can redistribute it and/or modify
978 # it under the terms of the GNU General Public License as published by
979 # the Free Software Foundation; either version 2 of the License, or (at
980 # your option) any later version.
982 # This program is distributed in the hope that it will be useful, but
983 # WITHOUT ANY WARRANTY; without even the implied warranty of
984 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
985 # See the GNU General Public License for more details.
987 # You should have received a copy of the GNU General Public License
988 # along with this program.
989 # If not, see L<http://www.gnu.org/licenses/>.
991 # vim: set fenc=UTF-8 ft=perl fdm=marker ts=4 sw=4 sts=4 et fo+=w :