keywords.pl 3.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153
  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.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. use strict;
  24. push(@INC, $ENV{'srcdir'}) if(defined $ENV{'srcdir'});
  25. push(@INC, ".");
  26. require "getpart.pm"; # array functions
  27. my $srcdir = $ENV{'srcdir'} || '.';
  28. my $TESTDIR="$srcdir/data";
  29. # Get all commands and find out their test numbers
  30. opendir(DIR, $TESTDIR) || die "can't opendir $TESTDIR: $!";
  31. my @cmds = grep { /^test([0-9]+)$/ && -f "$TESTDIR/$_" } readdir(DIR);
  32. closedir DIR;
  33. my $TESTCASES; # start with no test cases
  34. # cut off everything but the digits
  35. for(@cmds) {
  36. $_ =~ s/[a-z\/\.]*//g;
  37. }
  38. # the numbers from low to high
  39. for(sort { $a <=> $b } @cmds) {
  40. $TESTCASES .= " $_";
  41. }
  42. my $t;
  43. my %k; # keyword count
  44. my %t; # keyword to test case mapping
  45. my @miss; # test cases without keywords set
  46. my $count;
  47. my %errors;
  48. for $t (split(/ /, $TESTCASES)) {
  49. if(loadtest("${TESTDIR}/test${t}")) {
  50. # bad case
  51. next;
  52. }
  53. my @ec = getpart("verify", "errorcode");
  54. if($ec[0]) {
  55. # count number of check error codes
  56. $errors{ 0 + $ec[0] } ++;
  57. }
  58. my @what = getpart("info", "keywords");
  59. if(!$what[0]) {
  60. push @miss, $t;
  61. next;
  62. }
  63. for(@what) {
  64. chomp;
  65. #print "Test $t: $_\n";
  66. $k{$_}++;
  67. $t{$_} .= "$t ";
  68. }
  69. $count++;
  70. }
  71. sub show {
  72. my ($list)=@_;
  73. my @a = split(" ", $list);
  74. my $ret;
  75. my $c;
  76. my @l = sort {rand(100) - 50} @a;
  77. my @ll;
  78. for(1 .. 11) {
  79. my $v = shift @l;
  80. if($v) {
  81. push @ll, $v;
  82. }
  83. }
  84. for (sort {$a <=> $b} @ll) {
  85. if($c++ == 10) {
  86. $ret .= "...";
  87. last;
  88. }
  89. $ret .= "$_ ";
  90. }
  91. return $ret;
  92. }
  93. # sort alphabetically
  94. my @mtest = reverse sort { lc($b) cmp lc($a) } keys %k;
  95. print <<TOP
  96. <table><tr><th>Num</th><th>Keyword</th><th>Test Cases</th></tr>
  97. TOP
  98. ;
  99. for $t (@mtest) {
  100. printf "<tr><td>%d</td><td>$t</td><td>%s</td></tr>\n", $k{$t},
  101. show($t{$t});
  102. }
  103. printf "</table><p> $count out of %d tests (%d lack keywords)\n",
  104. scalar(@miss) + $count,
  105. scalar(@miss);
  106. for(@miss) {
  107. print "$_ ";
  108. }
  109. print "\n";
  110. printf "<p> %d different error codes tested for:<br>\n",
  111. scalar(keys %errors);
  112. # numerically on amount, or alphebetically if same amount
  113. my @etest = sort { $a <=> $b} keys %errors;
  114. for(@etest) {
  115. print "$_ ";
  116. }
  117. print "\n";