1#!/usr/bin/env perl 2#*************************************************************************** 3# _ _ ____ _ 4# Project ___| | | | _ \| | 5# / __| | | | |_) | | 6# | (__| |_| | _ <| |___ 7# \___|\___/|_| \_\_____| 8# 9# Copyright (C) 1998 - 2020, 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 https://curl.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 24use strict; 25 26push(@INC, $ENV{'srcdir'}) if(defined $ENV{'srcdir'}); 27push(@INC, "."); 28 29require "getpart.pm"; # array functions 30 31my $srcdir = $ENV{'srcdir'} || '.'; 32my $TESTDIR="$srcdir/data"; 33 34# Get all commands and find out their test numbers 35opendir(DIR, $TESTDIR) || die "can't opendir $TESTDIR: $!"; 36my @cmds = grep { /^test([0-9]+)$/ && -f "$TESTDIR/$_" } readdir(DIR); 37closedir DIR; 38 39my $TESTCASES; # start with no test cases 40 41# cut off everything but the digits 42for(@cmds) { 43 $_ =~ s/[a-z\/\.]*//g; 44} 45# the numbers from low to high 46for(sort { $a <=> $b } @cmds) { 47 $TESTCASES .= " $_"; 48} 49 50my $t; 51 52my %k; # keyword count 53my %t; # keyword to test case mapping 54my @miss; # test cases without keywords set 55 56my $count; 57 58my %errors; 59 60for $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 97sub 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 124my @mtest = reverse sort { lc($b) cmp lc($a) } keys %k; 125 126print <<TOP 127<table><tr><th>Num</th><th>Keyword</th><th>Test Cases</th></tr> 128TOP 129 ; 130for $t (@mtest) { 131 printf "<tr><td>%d</td><td>$t</td><td>%s</td></tr>\n", $k{$t}, 132 show($t{$t}); 133} 134printf "</table><p> $count out of %d tests (%d lack keywords)\n", 135 scalar(@miss) + $count, 136 scalar(@miss); 137 138for(@miss) { 139 print "$_ "; 140} 141 142print "\n"; 143 144printf "<p> %d different error codes tested for:<br>\n", 145 scalar(keys %errors); 146 147# numerically on amount, or alphebetically if same amount 148my @etest = sort { $a <=> $b} keys %errors; 149 150for(@etest) { 151 print "$_ "; 152} 153print "\n"; 154