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
14 use afstest qw(src_path obj_path);
16 sub check_command_binary {
19 BAIL_OUT("Cannot find $c");
24 # Run the command help to determine the list of sub-commands.
26 sub lookup_sub_commands {
27 my ($srcdir, $command) = @_;
29 my $fullpathcommand = "$srcdir/$command";
30 check_command_binary($fullpathcommand);
32 # build up our list of available commands from the help output
33 open(HELPOUT, "$fullpathcommand help 2>&1 |") or BAIL_OUT("can't fork: $!");
37 # Skip the header thingy
38 next if /Commands are/;
39 # Skip the version subcommand, it's always present but not interesting
42 push(@subcommlist, $comm[0]);
45 @subcommlist = sort(@subcommlist);
49 # TAP test: test_command_man_pages
51 # Test if a man page exists for each command sub-command.
52 # Runs one test per sub-command.
56 # srcdir : A path to the OpenAFS source directory,
59 # command : the name of the command (e.g. vos)
61 # subcommlist : a list of sub-commands for command
63 sub test_command_man_pages {
64 my ($srcdir, $command, @subcommlist) = @_;
66 # The following is because File::Find makes no sense to me
67 # for this purpose, and actually seems totally misnamed
71 # Since we don't know what man section it might be in,
72 # search all existing man page files for a filename match
73 my @mandirglob = glob("$srcdir/doc/man-pages/man[1-8]/*");
74 # For every subcommand, see if command_subcommand.[1-8] exists
75 # in our man page source dir.
76 foreach (@subcommlist) {
79 my $frex = $command . '_' . $subcommand . '.[1-8]';
80 # diag("Looking for $frex");
81 foreach my $x (@mandirglob) {
90 ok($found eq 1, "existence of man page for $command" . "_$subcommand");
95 # Setup the test plan and run all of the tests for the given command suite.
98 # run_manpage_tests("src/ptserver", "pts");
100 sub run_manpage_tests($$) {
101 my ($subdir, $command) = @_;
103 my $srcdir = src_path();
104 my $objdir = obj_path();
106 my @sub_commands = lookup_sub_commands("$objdir/$subdir", $command);
107 die("No subcommands found in $objdir/$subdir/$command?") unless(@sub_commands);
109 plan tests => scalar @sub_commands;
111 test_command_man_pages($srcdir, $command, @sub_commands);