1#!/usr/bin/env perl
2#use strict;
3#use warnings;
4
5use vars qw(%ENV);
6
7my $debug = 0;
8$debug = 1 if $ARGV[0] and $ARGV[0] eq '-d';
9
10$ENV{LESSOPEN} = "|./lesspipe.sh %s";
11# to check all test cases with the filter
12$ENV{LESS_ADVANCED_PREPROCESSOR} =1;
13open F, "TESTCMDS" or die "Could not read TESTCMDS:$!\n";
14my $retcode = 0;
15my $duration = time();
16my $sumok = 0;
17my $sumignore = 0;
18my $sumnok = 0;
19while (<F>) {
20  next if /^#/;
21  next if /^\s*$/;
22  chomp;
23  my $ignore = $1 if s/#\s*needs (.*)//;
24  my $res = `$_ 2>&1`;
25  my $ok = 0;
26  my $lines = 0;
27  if ( $res and $res =~ /command not found: (\S+)/m ) {  # zsh style
28    print "result:$res" if $debug;
29    $res = "NOT found: $1";
30    $ok = 1;
31  } elsif ( $res and $res =~ /(\S+):\s+command not found/m ) { # bash style
32    print "result:$res" if $debug;
33    $res = "NOT found: $1";
34    $ok = 1;
35  } elsif ( $res and $res =~ /(\S+):\s+not found/m ) { # ksh style
36    print "result:$res" if $debug;
37    $res = "NOT found: $1";
38    $ok = 1;
39  } elsif ( $res and $res =~ /no such file or directory: .*?([^\/]+)\b$/m ) {
40    print "result:$res" if $debug;
41    $res = "NOT found: $1";
42    $ok = 1;
43  } elsif ( $res ) {
44    print "result:$res" if $debug;
45    my @res = split /\n/, $res;
46    shift @res if $res[0] =~ /^==>/;
47    $res[0] =~ s/^pst0$//;
48    shift @res while @res and $res[0] =~ /^\s*$/;
49    # special case for directory listing
50    $res[0] = 'test' if $res =~ /-rw-r--r--.*test/;
51    $ok = $res[0] =~ /^\s*(\e\[36m)?test(\e\[0m)?\s*$/ if $res[0];
52    # special case for nroff
53    $ok = $res[0] =~ s/^test \(1\)\s+.*/test/ if $res[0] and ! $ok;
54    # special case for perl storable
55    $ok = $res[0] =~ s/^\$VAR1 = \\'test';$/test/ if $res[0] and ! $ok;
56    # special case for mp3
57    if ($res[1] and ! $ok) {
58        $ok = $res[1] =~ s/.*Title.*:\s+test\b.*/test/;
59        $res[0] = $res[1] if $ok;
60    }
61    $res = $res[0] if $res[0];
62    $lines = $#res;
63  }
64  if ( $ok ) {
65    $res =~ s/test/ok/ if $ok;
66    $res =~ s/^\s+// if $ok;
67    #$res .= " ($lines trailing lines)" if $lines;
68    $sumok++;
69  } else {
70    my $failed = is_exec($ignore);
71    $retcode++ if ! $ok and $failed;
72    $res = "NOT ok";
73    $res = "ignored, needs " . (split ' ', $ignore)[0] if ! $failed;
74    $sumnok++ if $failed;
75    $sumignore++ if ! $failed;
76  }
77  printf "%-56s %s\n", $_, $res;
78}
79close F;
80$duration = time() - $duration;
81print "$sumok/$sumignore/$sumnok tests passed/ignored/failed in $duration seconds\n";
82exit $retcode;
83
84sub is_exec {
85  my $arg = shift;
86  return 1 if ! $arg;
87  for my $prog (split ' ', $arg) {
88    return 1 if grep {-x "$_/$prog"} split /:/, $ENV{PATH};
89  }
90  return 0
91}
92