installed_progs.t: Python checks stdout too, 150 ok
[sunny256-utils.git] / tests / ga.t
blobcf139621d9dc2c6d7a96d124cd90eca4d29efda4
1 #!/usr/bin/env perl
3 #==============================================================================
4 # ga.t
5 # File ID: c4726d6a-bf17-11eb-9d68-4f45262dc9b5
7 # Test suite for ga(1).
9 # Character set: UTF-8
10 # ©opyleft 2021– Øyvind A. Holm <sunny@sunbase.org>
11 # License: GNU General Public License version 2 or later, see end of file for
12 # 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 Getopt::Long;
25 local $| = 1;
27 our $CMDB = "ga";
29 our $CMD = "../$CMDB";
31 my $Lh = "[0-9a-fA-F]";
32 my $v1_templ = "$Lh\{8}-$Lh\{4}-1$Lh\{3}-$Lh\{4}-$Lh\{12}";
34 our %Opt = (
36 'all' => 0,
37 'git' => 'git',
38 'git-annex' => 'git-annex',
39 'help' => 0,
40 'quiet' => 0,
41 'todo' => 0,
42 'verbose' => 0,
43 'version' => 0,
47 our $progname = $0;
48 $progname =~ s/^.*\/(.*?)$/$1/;
49 our $VERSION = '0.0.0'; # Not used here, $CMD decides
51 my %descriptions = ();
53 Getopt::Long::Configure('bundling');
54 GetOptions(
56 'all|a' => \$Opt{'all'},
57 'git-annex=s' => \$Opt{'git-annex'},
58 'git=s' => \$Opt{'git'},
59 'help|h' => \$Opt{'help'},
60 'quiet|q+' => \$Opt{'quiet'},
61 'todo|t' => \$Opt{'todo'},
62 'verbose|v+' => \$Opt{'verbose'},
63 'version' => \$Opt{'version'},
65 ) || die("$progname: Option error. Use -h for help.\n");
67 $Opt{'verbose'} -= $Opt{'quiet'};
68 $Opt{'help'} && usage(0);
69 if ($Opt{'version'}) {
70 print_version();
71 exit(0);
74 my $GIT = $Opt{'git'};
75 my $GIT_ANNEX = $Opt{'git-annex'};
76 my $exec_version = `$CMD --version`;
77 my $is_root = $< ? 0 : 1;
79 exit(main());
81 sub main {
82 my $Retval = 0;
84 diag('========== BEGIN version info ==========');
85 diag($exec_version);
86 diag('=========== END version info ===========');
88 if ($Opt{'todo'} && !$Opt{'all'}) {
89 goto todo_section;
92 test_standard_options();
93 if (`$GIT_ANNEX version 2>/dev/null` !~ /^git-annex version/) {
94 diag("git-annex is not installed here, skipping tests");
95 return 0;
97 test_executable();
99 diag('========== BEGIN version info ==========');
100 diag($exec_version);
101 diag('=========== END version info ===========');
103 todo_section:
106 if ($Opt{'all'} || $Opt{'todo'}) {
107 diag('Running TODO tests...');
108 TODO: {
109 local $TODO = '';
110 # Insert TODO tests here.
114 diag('Testing finished.');
116 return $Retval;
119 sub test_standard_options {
120 diag('Testing -h (--help) option...');
121 likecmd("$CMD -h",
122 '/ Show this help/i',
123 '/^$/',
125 'Option -h prints help screen');
127 diag('Testing --version option...');
128 likecmd("$CMD --version",
129 '/^\S+ \d+\.\d+\.\d+/',
130 '/^$/',
132 'Option --version returns version number');
134 return;
137 sub test_executable {
138 my $Tmptop = "tmp-$CMDB-t-$$-" . substr(rand, 2, 8);
140 ok(mkdir($Tmptop), "mkdir [Tmptop]");
141 safe_chdir($Tmptop, "chdir [Tmptop]");
143 chomp($ENV{'HOME'} = `pwd`);
144 like($ENV{'HOME'}, "/$Tmptop\$/",
145 "HOME environment variable contains [Tmptop]");
146 testcmd("$GIT config --global user.name 'Suttleif Fisen'", "", "", 0,
147 "$GIT config --global user.name 'Suttleif Fisen'");
148 testcmd("$GIT config --global user.email suttleif\@example.com",
149 "", "", 0,
150 "$GIT config --global user.email suttleif\@example.com");
151 testcmd("$GIT config --global init.defaultbranch master", "", "", 0,
152 "$GIT config --global init.defaultbranch master");
153 testcmd("$GIT config --global annex.backend SHA256", "", "", 0,
154 "$GIT config --global annex.backend SHA256");
155 ok(-f ".gitconfig", ".gitconfig exists");
157 my $suuid_logdir = "$ENV{'HOME'}/suuid_logdir";
158 $ENV{'SUUID_LOGDIR'} = $suuid_logdir;
159 like($ENV{'SUUID_LOGDIR'}, "/suuid_logdir\$/",
160 'SUUID_LOGDIR environment variable contains "suuid_logdir"');
161 ok(mkdir($suuid_logdir), "mkdir suuid_logdir");
163 test_init_command();
164 my $suuid_file = glob("$suuid_logdir/*.xml");
165 like($suuid_file, '/.*\.xml$/', 'suuid file found by glob()');
166 test_chk_command();
167 test_copnum_command();
169 diag("Clean up");
170 ok(unlink($suuid_file), 'Delete suuid file');
171 ok(rmdir($suuid_logdir), 'Delete suuid_logdir');
172 delete_dir(".cache");
173 delete_dir(".ssh");
174 ok(unlink(".gitconfig"), "Delete .gitconfig");
175 safe_chdir("..");
176 ok(rmdir($Tmptop), "rmdir [Tmptop]");
178 return;
181 sub test_init_command {
182 diag("init");
183 init_annex("t_init");
184 safe_chdir("t_init");
185 ok(-d ".git/annex", ".git/annex directory exists");
186 like(`$GIT config --get annex.uuid`, "/^$v1_templ\\n/",
187 "UUID is version 1");
188 safe_chdir("..");
189 delete_dir("t_init");
191 return;
194 sub test_chk_command {
195 init_annex('t_chk');
196 safe_chdir('t_chk');
198 create_file('okfile', "This is file 1.\n");
199 ga_add('okfile', 'Add okfile in t_chk/');
200 git_commit('Add okfile', 'Commit okfile in t_chk/');
201 testcmd("$CMD chk okfile",
202 "okfile ok\n",
205 "Check okfile");
207 create_file('with space.txt', "File with space in filname.\n");
208 ga_add('"with space.txt"', 'Add "with space.txt" in t_chk/');
209 git_commit('Add file with space in filename',
210 'Commit "with space.txt" in t_chk/');
211 testcmd("$CMD chk 'with space.txt'",
212 "with space.txt ok\n",
215 'Check "with space.txt"');
217 create_file('errfile', "File with frrors.\n");
218 ga_add('errfile', 'Add errfile in t_chk/');
219 git_commit('Add errfile', 'Commit errfile in t_chk/');
220 my $errkey = 'SHA256-s18--db1f5def94d1ace370d322ebb5bb8ee84b3f2ea7eb7445c8b8143fe1c9455c96';
221 my $errobjdir = ".git/annex/objects/pJ/gJ/$errkey";
222 my $errobjfile = "$errobjdir/$errkey";
223 testcmd("chmod +w -R \"$errobjdir\"", "", "", 0,
224 "Make [errobjdir] writable");
225 create_file($errobjfile, "File with errors.\n",
226 "Overwrite [errobjfile] with different data");
227 testcmd("$CMD chk errfile",
228 "errfile fail\n",
231 "Check errfile");
233 SKIP: {
234 skip("Running tests as root", 14) if ($is_root);
236 create_file('unrfile', "Unreadable file.\n");
237 ga_add('unrfile', 'Add unrfile in t_chk/');
238 git_commit('Add unrfile', 'Commit unrfile in t_chk/');
239 my $unrkey = 'SHA256-s17--93bd33a38896168b87271a6ee3ffacbed5b2b6c32b07dd784eb1e9be2e8c9c1a';
240 my $unrobjdir = ".git/annex/objects/64/5V/$unrkey";
241 my $unrobjfile = "$unrobjdir/$unrkey";
242 testcmd("chmod +w -R \"$unrobjdir\"", "", "", 0,
243 "Make [unrobjdir] writable");
244 ok(chmod(0000, $unrobjfile),
245 'Remove all permissions from [unrobjfile]');
246 testcmd("$CMD chk unrfile",
248 "$CMDB: unrfile: File is not readable by you\n",
250 "Check unrfile when it's not readable");
253 testcmd("$CMD chk nonexistent",
255 "$CMDB: nonexistent: File not found\n",
257 "Check nonexistent");
259 testcmd("$CMD chk ''",
261 "$CMDB: : File not found\n",
263 "Check empty filename");
265 ok(mkdir('directory'), 'mkdir directory');
266 testcmd("$CMD chk directory",
268 "$CMDB: directory: Is a directory\n",
270 "File is a directory");
272 ok(symlink('directory', 'dirlink'), 'Create symlink to directory');
273 testcmd("$CMD chk dirlink",
275 "$CMDB: dirlink: Is a symlink to a directory\n",
277 "File is a symlink to a directory");
279 create_file('not-here', "This file is not here.\n");
280 ga_add('not-here', 'Add not-here in t_chk/');
281 git_commit('Add not-here', 'Commit not-here in t_chk/');
282 ga_drop('not-here', 'Drop not-here');
283 testcmd("$CMD chk not-here",
285 "$CMDB: not-here: File not present here\n",
287 "Check not-here");
289 create_file('regfile', "Regular file.\n");
290 testcmd("$CMD chk regfile",
292 "$CMDB: regfile: Not a symbolic link\n",
294 "Check regfile");
296 ok(symlink('regfile', 'regfilelink'), 'Create regfilelink');
297 testcmd("$CMD chk regfilelink",
299 "$CMDB: regfilelink: SHA256 key not found in symlink\n",
301 "Check regfilelink");
303 ok(symlink('brokendest', 'brokenlink'), 'Create brokenlink');
304 testcmd("$CMD chk brokenlink",
306 "$CMDB: brokenlink: Broken symlink\n",
308 "Check brokenlink");
310 testcmd("$CMD chk *",
312 . "errfile fail\n"
313 . "okfile ok\n"
314 . "with space.txt ok\n",
316 . "$CMDB: brokenlink: Broken symlink\n"
317 . "$CMDB: directory: Is a directory\n"
318 . "$CMDB: dirlink: Is a symlink to a directory\n"
319 . "$CMDB: not-here: File not present here\n"
320 . "$CMDB: regfile: Not a symbolic link\n"
321 . "$CMDB: regfilelink: SHA256 key not found in symlink\n"
322 . ($is_root ? ""
323 : "$CMDB: unrfile: File is not readable by you\n"),
325 'Test all files');
327 safe_chdir('..');
328 delete_dir('t_chk');
330 return;
333 sub test_copnum_command {
334 diag("copnum");
335 init_annex("t_copnum");
336 safe_chdir("t_copnum");
337 testcmd("$CMD copnum", "1\n", "", 0, "copnum is 1 by default");
338 testcmd("$GIT_ANNEX numcopies 3",
339 "numcopies 3 ok\n"
340 . "(recording state in git...)\n",
343 "Set numcopies to 3");
344 testcmd("$CMD copnum", "3\n", "", 0, "copnum is 3");
345 safe_chdir("..");
346 delete_dir("t_copnum");
348 return;
351 sub delete_dir {
352 my $dir = shift;
354 SKIP: {
355 skip("delete_dir(): $dir doesn't exist", 6) unless (-d $dir);
356 testcmd("chmod +w -R \"$dir\"", "", "", 0,
357 "Make everything in $dir/ writable");
358 testcmd("rm -rf \"$dir\"", "", "", 0,
359 "Delete $dir/");
362 return;
365 sub ga_add {
366 my ($file, $desc) = @_;
368 if (!defined($desc) || !length($desc)) {
369 $desc = "ga add $file";
372 likecmd("$CMD add $file",
373 '/^add .*ok\n/s',
374 '/^$/',
376 $desc);
378 return;
381 sub ga_drop {
382 my ($file, $desc) = @_;
384 if (!defined($desc) || !length($desc)) {
385 $desc = "ga add $file";
388 ok(-e $file, "$file exists");
389 likecmd("$CMD drop --force $file",
390 '/^drop .* ok\n/',
391 '/^$/',
393 $desc);
395 return;
398 sub git_commit {
399 my ($logmsg, $desc) = @_;
401 if (!defined($logmsg) || !length($logmsg)) {
402 BAIL_OUT('git_commit(): $logmsg not defined');
405 likecmd("$GIT commit -m \"$logmsg\"",
407 . '.*'
408 . quotemeta($logmsg)
409 . '.*'
410 . '/',
411 '/^$/',
413 $desc);
415 return;
418 sub git_init {
419 my $dir = shift;
421 ok(!-e $dir, "git_init(): $dir doesn't exist")
422 || BAIL_OUT("git_init(): $dir already exists, aborting");
423 likecmd("$GIT init \"$dir\"", '/.*/', '/^$/', 0, "$GIT init \"$dir\"");
425 return;
428 sub init_annex {
429 my $dir = shift;
431 git_init($dir);
432 safe_chdir($dir);
433 likecmd("$CMD init",
434 '/^'
435 . 'init \S+:.*\/'
436 . $dir
437 . " .*" # New versions print "(scanning for unlocked files...)"
438 . 'ok\n'
439 . '.*'
440 . '/s',
441 "/^$v1_templ\\n\$/",
443 "ga init in $dir");
444 likecmd("$CMD info",
445 "/$v1_templ -- "
446 . '\S+:.*\/' . $dir . ' \[here\]\n'
447 . '/',
448 '/Have disabled git annex pre-commit/',
450 "ga info in $dir");
451 safe_chdir("..");
453 return;
456 sub safe_chdir {
457 my ($dir, $desc) = @_;
458 defined($desc) || ($desc = '');
460 ok(chdir($dir), length($desc) ? $desc : "chdir $dir")
461 || BAIL_OUT("$progname: Can't chdir to $dir, aborting");
462 if ($dir eq "..") {
463 $CMD =~ s!^\.\./!!
464 || BAIL_OUT('safe_chdir(): $dir is "..",'
465 . ' but $CMD doesn\'t start with "../"');
466 } else {
467 $CMD = "../$CMD";
470 return;
473 sub testcmd {
474 my ($Cmd, $Exp_stdout, $Exp_stderr, $Exp_retval, $Desc) = @_;
475 defined($descriptions{$Desc})
476 && BAIL_OUT("testcmd(): '$Desc' description is used twice");
477 $descriptions{$Desc} = 1;
478 my $stderr_cmd = '';
479 my $cmd_outp_str = $Opt{'verbose'} >= 1 ? "\"$Cmd\" - " : '';
480 my $Txt = join('', $cmd_outp_str, defined($Desc) ? $Desc : '');
481 my $TMP_STDERR = "$CMDB-stderr.tmp";
482 my $retval = 1;
484 if (defined($Exp_stderr)) {
485 $stderr_cmd = " 2>$TMP_STDERR";
487 $retval &= is(`$Cmd$stderr_cmd`, $Exp_stdout, "$Txt (stdout)");
488 my $ret_val = $?;
489 if (defined($Exp_stderr)) {
490 $retval &= is(file_data($TMP_STDERR),
491 $Exp_stderr, "$Txt (stderr)");
492 unlink($TMP_STDERR);
493 } else {
494 diag("Warning: stderr not defined for '$Txt'");
496 $retval &= is($ret_val >> 8, $Exp_retval, "$Txt (retval)");
498 return $retval;
501 sub likecmd {
502 my ($Cmd, $Exp_stdout, $Exp_stderr, $Exp_retval, $Desc) = @_;
503 defined($descriptions{$Desc})
504 && BAIL_OUT("likecmd(): '$Desc' description is used twice");
505 $descriptions{$Desc} = 1;
506 my $stderr_cmd = '';
507 my $cmd_outp_str = $Opt{'verbose'} >= 1 ? "\"$Cmd\" - " : '';
508 my $Txt = join('', $cmd_outp_str, defined($Desc) ? $Desc : '');
509 my $TMP_STDERR = "$CMDB-stderr.tmp";
510 my $retval = 1;
512 if (defined($Exp_stderr)) {
513 $stderr_cmd = " 2>$TMP_STDERR";
515 $retval &= like(`$Cmd$stderr_cmd`, $Exp_stdout, "$Txt (stdout)");
516 my $ret_val = $?;
517 if (defined($Exp_stderr)) {
518 $retval &= like(file_data($TMP_STDERR),
519 $Exp_stderr, "$Txt (stderr)");
520 unlink($TMP_STDERR);
521 } else {
522 diag("Warning: stderr not defined for '$Txt'");
524 $retval &= is($ret_val >> 8, $Exp_retval, "$Txt (retval)");
526 return $retval;
529 sub file_data {
530 # Return file content as a string
531 my $File = shift;
532 my $Txt;
534 open(my $fp, '<', $File) or return undef;
535 local $/ = undef;
536 $Txt = <$fp>;
537 close($fp);
539 return $Txt;
542 sub create_file {
543 # Create new file and fill it with data
544 my ($file, $text, $desc) = @_;
545 my $retval = 0;
547 if (!defined($desc) || !length($desc)) {
548 $desc = "$file was successfully created";
551 open(my $fp, ">", $file) or return 0;
552 print($fp $text);
553 close($fp);
554 $retval = is(file_data($file), $text, $desc);
556 return $retval; # 0 if error, 1 if ok
559 sub print_version {
560 # Print program version
561 print("$progname $VERSION\n");
563 return;
566 sub usage {
567 # Send the help message to stdout
568 my $Retval = shift;
570 if ($Opt{'verbose'}) {
571 print("\n");
572 print_version();
574 print(<<"END");
576 Usage: $progname [options]
578 Contains tests for the $CMDB(1) program.
580 Options:
582 -a, --all
583 Run all tests, also TODOs.
584 --git PATH
585 Specify path to alternative git(1) executable.
586 --git-annex PATH
587 Specify path to alternative git-annex(1) executable.
588 -h, --help
589 Show this help.
590 -q, --quiet
591 Be more quiet. Can be repeated to increase silence.
592 -t, --todo
593 Run only the TODO tests.
594 -v, --verbose
595 Increase level of verbosity. Can be repeated.
596 --version
597 Print version information.
600 exit($Retval);
603 sub msg {
604 # Print a status message to stderr based on verbosity level
605 my ($verbose_level, $Txt) = @_;
607 $verbose_level > $Opt{'verbose'} && return;
608 print(STDERR "$progname: $Txt\n");
610 return;
613 __END__
615 # This program is free software; you can redistribute it and/or modify it under
616 # the terms of the GNU General Public License as published by the Free Software
617 # Foundation; either version 2 of the License, or (at your option) any later
618 # version.
620 # This program is distributed in the hope that it will be useful, but WITHOUT
621 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
622 # FOR A PARTICULAR PURPOSE.
623 # See the GNU General Public License for more details.
625 # You should have received a copy of the GNU General Public License along with
626 # this program.
627 # If not, see L<http://www.gnu.org/licenses/>.
629 # vim: set ts=8 sw=8 sts=8 noet fo+=w tw=79 fenc=UTF-8 :