quickjs-tart

quickjs-based runtime for wallet-core logic
Log | Files | Refs | README | LICENSE

test1173.pl (11281B)

      1 #!/usr/bin/env perl
      2 #***************************************************************************
      3 #                                  _   _ ____  _
      4 #  Project                     ___| | | |  _ \| |
      5 #                             / __| | | | |_) | |
      6 #                            | (__| |_| |  _ <| |___
      7 #                             \___|\___/|_| \_\_____|
      8 #
      9 # Copyright (C) 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 # SPDX-License-Identifier: curl
     23 #
     24 ###########################################################################
     25 #
     26 # Scan manpage(s) and detect some simple and yet common formatting mistakes.
     27 #
     28 # Output all deviances to stderr.
     29 
     30 use strict;
     31 use warnings;
     32 use File::Basename;
     33 
     34 # get the file name first
     35 my $symbolsinversions=shift @ARGV;
     36 
     37 # we may get the dir roots pointed out
     38 my @manpages=@ARGV;
     39 my $errors = 0;
     40 
     41 my %docsdirs;
     42 my %optblessed;
     43 my %funcblessed;
     44 my @optorder = (
     45     'NAME',
     46     'SYNOPSIS',
     47     'DESCRIPTION',
     48      #'DEFAULT', # CURLINFO_ has no default
     49     'PROTOCOLS',
     50     'EXAMPLE',
     51     'AVAILABILITY',
     52     'RETURN VALUE',
     53     'SEE ALSO'
     54     );
     55 my @funcorder = (
     56     'NAME',
     57     'SYNOPSIS',
     58     'DESCRIPTION',
     59     'EXAMPLE',
     60     'AVAILABILITY',
     61     'RETURN VALUE',
     62     'SEE ALSO'
     63     );
     64 my %shline; # section => line number
     65 
     66 my %symbol;
     67 
     68 # some CURLINFO_ symbols are not actual options for curl_easy_getinfo,
     69 # mark them as "deprecated" to hide them from link-warnings
     70 my %deprecated = (
     71     CURLINFO_TEXT => 1,
     72     CURLINFO_HEADER_IN => 1,
     73     CURLINFO_HEADER_OUT => 1,
     74     CURLINFO_DATA_IN => 1,
     75     CURLINFO_DATA_OUT => 1,
     76     CURLINFO_SSL_DATA_IN => 1,
     77     CURLINFO_SSL_DATA_OUT => 1,
     78     CURLOPT_EGDSOCKET => 1,
     79     CURLOPT_RANDOM_FILE => 1,
     80     );
     81 sub allsymbols {
     82     open(my $f, "<", "$symbolsinversions") ||
     83         die "$symbolsinversions: $|";
     84     while(<$f>) {
     85         if($_ =~ /^([^ ]*) +(.*)/) {
     86             my ($name, $info) = ($1, $2);
     87             $symbol{$name}=$name;
     88 
     89             if($info =~ /([0-9.]+) +([0-9.]+)/) {
     90                 $deprecated{$name}=$info;
     91             }
     92         }
     93     }
     94     close($f);
     95 }
     96 
     97 
     98 my %ref = (
     99     'curl.1' => 1
    100     );
    101 sub checkref {
    102     my ($f, $sec, $file, $line)=@_;
    103     my $present = 0;
    104     #print STDERR "check $f.$sec\n";
    105     if($ref{"$f.$sec"}) {
    106         # present
    107         return;
    108     }
    109     foreach my $d (keys %docsdirs) {
    110         if(-f "$d/$f.$sec") {
    111             $present = 1;
    112             $ref{"$f.$sec"}=1;
    113             last;
    114         }
    115     }
    116     if(!$present) {
    117         print STDERR "$file:$line broken reference to $f($sec)\n";
    118         $errors++;
    119     }
    120 }
    121 
    122 # option-looking words that aren't options
    123 my %allownonref = (
    124     'CURLINFO_TEXT' => 1,
    125     'CURLINFO_HEADER_IN' => 1,
    126     'CURLINFO_HEADER_OUT' => 1,
    127     'CURLINFO_DATA_IN' => 1,
    128     'CURLINFO_DATA_OUT' => 1,
    129     'CURLINFO_SSL_DATA_IN' => 1,
    130     'CURLINFO_SSL_DATA_OUT' => 1,
    131     );
    132 
    133 sub scanmanpage {
    134     my ($file) = @_;
    135     my $reqex = 0;
    136     my $inseealso = 0;
    137     my $inex = 0;
    138     my $insynop = 0;
    139     my $exsize = 0;
    140     my $synopsize = 0;
    141     my $shc = 0;
    142     my $optpage = 0; # option or function
    143     my @sh;
    144     my $SH="";
    145     my @separators;
    146     my @sepline;
    147 
    148     open(my $m, "<", "$file") ||
    149         die "test1173.pl could not open $file";
    150     if($file =~ /[\/\\](CURL|curl_)([^\/\\]*).3/) {
    151         # This is a manpage for libcurl. It requires an example unless it's
    152         # considered deprecated.
    153         $reqex = 1 unless defined $deprecated{'CURL'.$2};
    154         if($1 eq "CURL") {
    155             $optpage = 1;
    156         }
    157     }
    158     my $line = 1;
    159     while(<$m>) {
    160         chomp;
    161         if($_ =~ /^.so /) {
    162             # this manpage is just a referral
    163             close($m);
    164             return;
    165         }
    166         if(($_ =~ /^\.SH SYNOPSIS/i) && ($reqex)) {
    167             # this is for libcurl manpage SYNOPSIS checks
    168             $insynop = 1;
    169             $inex = 0;
    170         }
    171         elsif($_ =~ /^\.SH EXAMPLE/i) {
    172             $insynop = 0;
    173             $inex = 1;
    174         }
    175         elsif($_ =~ /^\.SH \"SEE ALSO\"/i) {
    176             $inseealso = 1;
    177         }
    178         elsif($_ =~ /^\.SH/i) {
    179             $insynop = 0;
    180             $inex = 0;
    181         }
    182         elsif($inseealso) {
    183             if($_ =~ /^\.BR (.*)/i) {
    184                 my $f = $1;
    185                 if($f =~ /^(lib|)curl/i) {
    186                     $f =~ s/[\n\r]//g;
    187                     if($f =~ s/([a-z_0-9-]*) \(([13])\)([, ]*)//i) {
    188                         push @separators, $3;
    189                         push @sepline, $line;
    190                         checkref($1, $2, $file, $line);
    191                     }
    192                     if($f !~ /^ *$/) {
    193                         print STDERR "$file:$line bad SEE ALSO format\n";
    194                         $errors++;
    195                     }
    196                 }
    197                 else {
    198                     if($f =~ /.*(, *)\z/) {
    199                         push @separators, $1;
    200                         push @sepline, $line;
    201                     }
    202                     else {
    203                         push @separators, " ";
    204                         push @sepline, $line;
    205                     }
    206                 }
    207             }
    208         }
    209         elsif($inex) {
    210             $exsize++;
    211             if($_ =~ /[^\\]\\n/) {
    212                 print STDERR "$file:$line '\\n' need to be '\\\\n'!\n";
    213             }
    214         }
    215         elsif($insynop) {
    216             $synopsize++;
    217             if(($synopsize == 1) && ($_ !~ /\.nf/)) {
    218                 print STDERR "$file:$line:1:ERROR: be .nf for proper formatting\n";
    219             }
    220         }
    221         if($_ =~ /^\.SH ([^\r\n]*)/i) {
    222             my $n = $1;
    223             # remove enclosing quotes
    224             $n =~ s/\"(.*)\"\z/$1/;
    225             push @sh, $n;
    226             $shline{$n} = $line;
    227             $SH = $n;
    228         }
    229 
    230         if($_ =~ /^\'/) {
    231             print STDERR "$file:$line line starts with single quote!\n";
    232             $errors++;
    233         }
    234         if($_ =~ /\\f([BI])(.*)/) {
    235             my ($format, $rest) = ($1, $2);
    236             if($rest !~ /\\fP/) {
    237                 print STDERR "$file:$line missing \\f${format} terminator!\n";
    238                 $errors++;
    239             }
    240         }
    241         my $c = $_;
    242         while($c =~ s/\\f([BI])((lib|)curl[a-z_0-9-]*)\(([13])\)//i) {
    243             checkref($2, $4, $file, $line);
    244         }
    245         if(($_ =~ /\\f([BI])((libcurl|CURLOPT_|CURLSHOPT_|CURLINFO_|CURLMOPT_|curl_easy_|curl_multi_|curl_url|curl_mime|curl_global|curl_share)[a-zA-Z_0-9-]+)(.)/) &&
    246            ($4 ne "(")) {
    247             my $word = $2;
    248 
    249             if(!$allownonref{$word}) {
    250                 print STDERR "$file:$line curl ref to $word without section\n";
    251                 $errors++;
    252             }
    253         }
    254         if($_ =~ /(.*)\\f([^BIP])/) {
    255             my ($pre, $format) = ($1, $2);
    256             if($pre !~ /\\\z/) {
    257                 # only if there wasn't another backslash before the \f
    258                 print STDERR "$file:$line suspicious \\f format!\n";
    259                 $errors++;
    260             }
    261         }
    262         if(($SH =~ /^(DESCRIPTION|RETURN VALUE|AVAILABILITY)/i) &&
    263            ($_ =~ /(.*)((curl_multi|curl_easy|curl_url|curl_global|curl_url|curl_share)[a-zA-Z_0-9-]+)/) &&
    264            ($1 !~ /\\fI$/)) {
    265             print STDERR "$file:$line unrefed curl call: $2\n";
    266             $errors++;
    267         }
    268 
    269 
    270         if($optpage && $SH && ($SH !~ /^(SYNOPSIS|EXAMPLE|NAME|SEE ALSO)/i) &&
    271            ($_ =~ /(.*)(CURL(OPT_|MOPT_|INFO_|SHOPT_)[A-Z0-9_]*)/)) {
    272             # an option with its own manpage, check that it is tagged
    273             # for linking
    274             my ($pref, $symbol) = ($1, $2);
    275             if($deprecated{$symbol}) {
    276                 # let it be
    277             }
    278             elsif($pref !~ /\\fI\z/) {
    279                 print STDERR "$file:$line option $symbol missing \\fI tagging\n";
    280                 $errors++;
    281             }
    282         }
    283         if($_ =~ /[ \t]+$/) {
    284             print STDERR "$file:$line trailing whitespace\n";
    285             $errors++;
    286         }
    287         $line++;
    288     }
    289     close($m);
    290 
    291     if(@separators) {
    292         # all except the last one need comma
    293         for(0 .. $#separators - 1) {
    294             my $l = $_;
    295             my $sep = $separators[$l];
    296             if($sep ne ",") {
    297                 printf STDERR "$file:%d: bad not-last SEE ALSO separator: '%s'\n",
    298                     $sepline[$l], $sep;
    299                 $errors++;
    300             }
    301         }
    302         # the last one should not do comma
    303         my $sep = $separators[$#separators];
    304         if($sep eq ",") {
    305             printf STDERR "$file:%d: superfluous comma separator\n",
    306                 $sepline[$#separators];
    307             $errors++;
    308         }
    309     }
    310 
    311     if($reqex) {
    312         # only for libcurl options man-pages
    313 
    314         my $shcount = scalar(@sh); # before @sh gets shifted
    315         if($exsize < 2) {
    316             print STDERR "$file:$line missing EXAMPLE section\n";
    317             $errors++;
    318         }
    319 
    320         if($shcount < 3) {
    321             print STDERR "$file:$line too few manpage sections!\n";
    322             $errors++;
    323             return;
    324         }
    325 
    326         my $got = "start";
    327         my $i = 0;
    328         my $shused = 1;
    329         my @shorig = @sh;
    330         my @order = $optpage ? @optorder : @funcorder;
    331         my $blessed = $optpage ? \%optblessed : \%funcblessed;
    332 
    333         while($got) {
    334             my $finesh;
    335             $got = shift(@sh);
    336             if($got) {
    337                 if($$blessed{$got}) {
    338                     $i = $$blessed{$got};
    339                     $finesh = $got; # a mandatory one
    340                 }
    341             }
    342             if($i && defined($finesh)) {
    343                 # mandatory section
    344 
    345                 if($i != $shused) {
    346                     printf STDERR "$file:%u Got %s, when %s was expected\n",
    347                         $shline{$finesh},
    348                         $finesh,
    349                         $order[$shused-1];
    350                     $errors++;
    351                     return;
    352                 }
    353                 $shused++;
    354                 if($i == scalar(@order)) {
    355                     # last mandatory one, exit
    356                     last;
    357                 }
    358             }
    359         }
    360 
    361         if($i != scalar(@order)) {
    362             printf STDERR "$file:$line missing mandatory section: %s\n",
    363                 $order[$i];
    364             printf STDERR "$file:$line section found at index %u: '%s'\n",
    365                 $i, $shorig[$i];
    366             printf STDERR " Found %u used sections\n", $shcount;
    367             $errors++;
    368         }
    369     }
    370 }
    371 
    372 allsymbols();
    373 
    374 if(!$symbol{'CURLALTSVC_H1'}) {
    375     print STDERR "didn't get the symbols-in-version!\n";
    376     exit;
    377 }
    378 
    379 my $ind = 1;
    380 for my $s (@optorder) {
    381     $optblessed{$s} = $ind++
    382 }
    383 $ind = 1;
    384 for my $s (@funcorder) {
    385     $funcblessed{$s} = $ind++
    386 }
    387 
    388 for my $m (@manpages) {
    389     $docsdirs{dirname($m)}++;
    390 }
    391 
    392 for my $m (@manpages) {
    393     scanmanpage($m);
    394 }
    395 
    396 print STDERR "ok\n" if(!$errors);
    397 
    398 exit $errors;