2 # This is probably horrific code to any Perl coder. I'm sorry,
3 # I'm not one. It runs.
5 # Proposed Coding Standard:
7 # * Subroutines starting with test_ should be TAP tests
8 # utilizing ok(), is(), etc... and return the number
9 # of tests run if they get that far (could exit early
15 sub check_command_binary {
18 BAIL_OUT("Cannot find $c");
23 # Run the command help to determine the list of sub-commands.
25 sub lookup_sub_commands {
26 my ($srcdir, $command) = @_;
28 my $fullpathcommand = "$srcdir/$command";
29 check_command_binary($fullpathcommand);
31 # build up our list of available commands from the help output
32 open(HELPOUT, "$fullpathcommand help 2>&1 |") or BAIL_OUT("can't fork: $!");
36 # Skip the header thingy
37 next if /Commands are/;
38 # Skip the version subcommand, it's always present but not interesting
41 push(@subcommlist, $comm[0]);
44 @subcommlist = sort(@subcommlist);
48 # TAP test: test_command_man_pages
50 # Test if a man page exists for each command sub-command.
51 # Runs one test per sub-command.
55 # srcdir : A path to the OpenAFS source directory,
58 # command : the name of the command (e.g. vos)
60 # subcommlist : a list of sub-commands for command
62 sub test_command_man_pages {
63 my ($srcdir, $command, @subcommlist) = @_;
65 # The following is because File::Find makes no sense to me
66 # for this purpose, and actually seems totally misnamed
70 # Since we don't know what man section it might be in,
71 # search all existing man page files for a filename match
72 my @mandirglob = glob("$srcdir/doc/man-pages/man[1-8]/*");
73 # For every subcommand, see if command_subcommand.[1-8] exists
74 # in our man page source dir.
75 foreach (@subcommlist) {
78 my $frex = $command . '_' . $subcommand . '.[1-8]';
79 # diag("Looking for $frex");
80 foreach my $x (@mandirglob) {
89 ok($found eq 1, "existence of man page for $command" . "_$subcommand");
94 # Setup the test plan and run all of the tests for the given command suite.
97 # run_manpage_tests("src/ptserver", "pts");
99 sub run_manpage_tests($$) {
100 my ($subdir, $command) = @_;
102 # When run from 'runtests', our cwd will be TOP_OBJDIR/tests. $SOURCE is
103 # set to TOP_SRCDIR/tests, and $BUILD is set to TOP_OBJDIR/tests. We want
104 # the top-level src and obj dirs, in order to find the relevant binaries
106 my $srcdir = $ENV{SOURCE} . "/..";
107 my $objdir = $ENV{BUILD} . "/..";
109 my @sub_commands = lookup_sub_commands("$objdir/$subdir", $command);
110 die("No subcommands found in $objdir/$subdir/$command?") unless(@sub_commands);
112 plan tests => scalar @sub_commands;
114 test_command_man_pages($srcdir, $command, @sub_commands);