tests/keywords.pl

   1 #!/usr/bin/env perl
   2 #***************************************************************************
   3 #                                  _   _ ____  _
   4 #  Project                     ___| | | |  _ \| |
   5 #                             / __| | | | |_) | |
   6 #                            | (__| |_| |  _ <| |___
   7 #                             \___|\___/|_| \_\_____|
   8 #
   9 # Copyright (C) 1998 - 2014, Daniel Stenberg, <daniel@haxx.se>, et al.
  10 #
  11 # This software is licensed as described in the file COPYING, which
  12 # you should have received as part of this distribution. The terms
  13 # are also available at http://curl.haxx.se/docs/copyright.html.
  14 #
  15 # You may opt to use, copy, modify, merge, publish, distribute and/or sell
  16 # copies of the Software, and permit persons to whom the Software is
  17 # furnished to do so, under the terms of the COPYING file.
  18 #
  19 # This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
  20 # KIND, either express or implied.
  21 #
  22 ###########################################################################
  23
  24 use strict;
  25
  26 push(@INC, $ENV{'srcdir'}) if(defined $ENV{'srcdir'});
  27 push(@INC, ".");
  28
  29 require "getpart.pm"; # array functions
  30
  31 my $srcdir = $ENV{'srcdir'} || '.';
  32 my $TESTDIR="$srcdir/data";
  33
  34 # Get all commands and find out their test numbers
  35 opendir(DIR, $TESTDIR) || die "can't opendir $TESTDIR: $!";
  36 my @cmds = grep { /^test([0-9]+)$/ && -f "$TESTDIR/$_" } readdir(DIR);
  37 closedir DIR;
  38
  39 my $TESTCASES; # start with no test cases
  40
  41 # cut off everything but the digits
  42 for(@cmds) {
  43     $_ =~ s/[a-z\/\.]*//g;
  44 }
  45 # the the numbers from low to high
  46 for(sort { $a <=> $b } @cmds) {
  47     $TESTCASES .= " $_";
  48 }
  49
  50 my $t;
  51
  52 my %k; # keyword count
  53 my %t; # keyword to test case mapping
  54 my @miss; # test cases without keywords set
  55
  56 my $count;
  57
  58 my %errors;
  59
  60 for $t (split(/ /, $TESTCASES)) {
  61     if(loadtest("${TESTDIR}/test${t}")) {
  62         # bad case
  63         next;
  64     }
  65
  66     my @ec = getpart("verify", "errorcode");
  67     if($ec[0]) {
  68         # count number of check error codes
  69         $errors{ 0 + $ec[0] } ++;
  70     }
  71
  72
  73     my @what = getpart("info", "keywords");
  74
  75     if(!$what[0]) {
  76         push @miss, $t;
  77         next;
  78     }
  79
  80     for(@what) {
  81         chomp;
  82         #print "Test $t: $_\n";
  83         $k{$_}++;
  84         $t{$_} .= "$t ";
  85     }
  86
  87
  88
  89
  90
  91
  92
  93
  94     $count++;
  95 }
  96
  97 sub show {
  98     my ($list)=@_;
  99     my @a = split(" ", $list);
 100     my $ret;
 101
 102     my $c;
 103     my @l = sort {rand(100) - 50} @a;
 104     my @ll;
 105
 106     for(1 .. 11) {
 107         my $v = shift @l;
 108         if($v) {
 109             push @ll, $v;
 110         }
 111     }
 112
 113     for (sort {$a <=> $b} @ll) {
 114         if($c++ == 10) {
 115             $ret .= "...";
 116             last;
 117         }
 118         $ret .= "$_ ";
 119     }
 120     return $ret;
 121 }
 122
 123 # sort alphabetically
 124 my @mtest = reverse sort { lc($b) cmp lc($a) } keys %k;
 125
 126 print <<TOP
 127 <table><tr><th>Num</th><th>Keyword</th><th>Test Cases</th></tr>
 128 TOP
 129     ;
 130 for $t (@mtest) {
 131     printf "<tr><td>%d</td><td>$t</td><td>%s</td></tr>\n", $k{$t},
 132     show($t{$t});
 133 }
 134 printf "</table><p> $count out of %d tests (%d lack keywords)\n",
 135     scalar(@miss) + $count,
 136     scalar(@miss);
 137
 138 for(@miss) {
 139     print "$_ ";
 140 }
 141
 142 print "\n";
 143
 144 printf "<p> %d different error codes tested for:<br>\n",
 145     scalar(keys %errors);
 146
 147 # numerically on amount, or alphebetically if same amount
 148 my @etest = sort { $a <=> $b} keys %errors;
 149
 150 for(@etest) {
 151     print "$_ ";
 152 }
 153 print "\n";