tests/check-deprecated.pl

   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 #
  27 # Check that the deprecated statuses of functions and enum values in header
  28 # files, man pages and symbols-in-versions are in sync.
  29
  30 use strict;
  31 use warnings;
  32
  33 use File::Basename;
  34
  35 my $root=$ARGV[0] || ".";
  36 my $incdir = "$root/include/curl";
  37 my $docdir = "$root/docs";
  38 my $libdocdir = "$docdir/libcurl";
  39 my $errcode = 0;
  40
  41 # Symbol-indexed hashes.
  42 # Values are:
  43 #     X       Not deprecated
  44 #     ?       Deprecated in unknown version
  45 #     x.yy.z  Deprecated in version x.yy.z
  46 my %syminver;       # Symbols-in-versions deprecations.
  47 my %hdr;            # Public header files deprecations.
  48 my %funcman;        # Function man pages deprecations.
  49 my %optman;         # Option man pages deprecations.
  50
  51
  52 # Scan header file for public function and enum values. Flag them with
  53 # the version they are deprecated in, if some.
  54 sub scan_header {
  55     my ($f)=@_;
  56     my $line = "";
  57     my $incomment = 0;
  58     my $inenum = 0;
  59
  60     open(my $h, "<", "$f");
  61     while(<$h>) {
  62       s/^\s*(.*?)\s*$/$1/;      # Trim.
  63       # Remove multi-line comment trail.
  64       if($incomment) {
  65         if($_ !~ /.*?\*\/\s*(.*)$/) {
  66           next;
  67         }
  68         $_ = $1;
  69         $incomment = 0;
  70       }
  71       if($line ne "") {
  72         # Unfold line.
  73         $_ = "$line $1";
  74         $line = "";
  75       }
  76       # Remove comments.
  77       while($_ =~ /^(.*?)\/\*.*?\*\/(.*)$/) {
  78         $_ = "$1 $2";
  79       }
  80       if($_ =~ /^(.*)\/\*/) {
  81         $_ = "$1 ";
  82         $incomment = 1;
  83       }
  84       s/^\s*(.*?)\s*$/$1/;      # Trim again.
  85       # Ignore preprocessor directives and blank lines.
  86       if($_ =~ /^(?:#|$)/) {
  87         next;
  88       }
  89       # Handle lines that may be continued as if they were folded.
  90       if($_ !~ /[;,{}]$/) {
  91         # Folded line.
  92         $line = $_;
  93         next;
  94       }
  95       if($_ =~ /CURLOPTDEPRECATED\(/) {
  96         # Handle deprecated CURLOPT_* option.
  97         if($_ !~ /CURLOPTDEPRECATED\(\s*(\S+)\s*,(?:.*?,){2}\s*(.*?)\s*,.*"\)/) {
  98           # Folded line.
  99           $line = $_;
 100           next;
 101         }
 102         $hdr{$1} = $2;
 103       }
 104       elsif($_ =~ /CURLOPT\(/) {
 105         # Handle non-deprecated CURLOPT_* option.
 106         if($_ !~ /CURLOPT\(\s*(\S+)\s*(?:,.*?){2}\)/) {
 107           # Folded line.
 108           $line = $_;
 109           next;
 110         }
 111         $hdr{$1} = "X";
 112       }
 113       else {
 114         my $version = "X";
 115
 116         # Get other kind of deprecation from this line.
 117         if($_ =~ /CURL_DEPRECATED\(/) {
 118           if($_ !~ /^(.*)CURL_DEPRECATED\(\s*(\S+?)\s*,.*?"\)(.*)$/) {
 119             # Folded line.
 120             $line = $_;
 121             next;
 122           }
 123          $version = $2;
 124          $_ = "$1 $3";
 125         }
 126         if($_ =~ /^CURL_EXTERN\s+.*\s+(\S+?)\s*\(/) {
 127           # Flag public function.
 128           $hdr{$1} = $version;
 129         }
 130         elsif($inenum && $_ =~ /(\w+)\s*[,=}]/) {
 131           # Flag enum value.
 132           $hdr{$1} = $version;
 133         }
 134       }
 135       # Remember if we are in an enum definition.
 136       $inenum |= ($_ =~ /\benum\b/);
 137       if($_ =~ /}/) {
 138         $inenum = 0;
 139       }
 140     }
 141     close $h;
 142 }
 143
 144 # Scan function man page for options.
 145 # Each option has to be declared as ".IP <option>" where <option> starts with
 146 # the prefix. Flag each option with its deprecation version, if some.
 147 sub scan_man_for_opts {
 148     my ($f, $prefix)=@_;
 149     my $opt = "";
 150     my $line = "";
 151
 152     open(my $m, "<", "$f");
 153     while(<$m>) {
 154       if($_ =~ /^\./) {
 155         # roff directive found: end current option paragraph.
 156         my $o = $opt;
 157         $opt = "";
 158         if($_ =~ /^\.IP\s+((?:$prefix)_\w+)/) {
 159           # A new option has been found.
 160           $opt = $1;
 161         }
 162         $_ = $line;     # Get full paragraph.
 163         $line = "";
 164         s/\\f.//g;      # Remove font formatting.
 165         s/\s+/ /g;      # One line with single space only.
 166         if($o) {
 167           $funcman{$o} = "X";
 168           # Check if paragraph is mentioning deprecation.
 169           while($_ =~ /(?:deprecated|obsoleted?)\b\s*(?:in\b|since\b)?\s*(?:version\b|curl\b|libcurl\b)?\s*(\d[0-9.]*\d)?\b\s*(.*)$/i) {
 170             $funcman{$o} = $1 || "?";
 171             $_ = $2;
 172           }
 173         }
 174       }
 175       else {
 176         # Text line: accumulate.
 177         $line .= $_;
 178       }
 179     }
 180     close $m;
 181 }
 182
 183 # Scan man page for deprecation in DESCRIPTION and/or AVAILABILITY sections.
 184 sub scan_man_page {
 185     my ($path, $sym, $table)=@_;
 186     my $version = "X";
 187
 188     if(open(my $fh, "<", "$path")) {
 189       my $section = "";
 190       my $line = "";
 191
 192       while(<$fh>) {
 193         if($_ =~ /\.so\s+man3\/(.*\.3\b)/) {
 194           # Handle man page inclusion.
 195           scan_man_page(dirname($path) . "/$1", $sym, $table);
 196           $version = exists($$table{$sym})? $$table{$sym}: $version;
 197         }
 198         elsif($_ =~ /^\./) {
 199           # Line is a roff directive.
 200           if($_ =~ /^\.SH\b\s*(\w*)/) {
 201             # Section starts. End previous one.
 202             my $sh = $section;
 203
 204             $section = $1;
 205             $_ = $line;     # Previous section text.
 206             $line = "";
 207             s/\\f.//g;
 208             s/\s+/ /g;
 209             s/\\f.//g;      # Remove font formatting.
 210             s/\s+/ /g;      # One line with single space only.
 211             if($sh =~ /DESCRIPTION|AVAILABILITY/) {
 212               while($_ =~ /(?:deprecated|obsoleted?)\b\s*(?:in\b|since\b)?\s*(?:version\b|curl\b|libcurl\b)?\s*(\d[0-9.]*\d)?\b\s*(.*)$/i) {
 213                 # Flag deprecation status.
 214                 if($version ne "X" && $version ne "?") {
 215                   if($1 && $1 ne $version) {
 216                     print "error: $sym man page lists unmatching deprecation versions $version and $1\n";
 217                     $errcode++;
 218                   }
 219                 }
 220                 else {
 221                   $version = $1 || "?";
 222                 }
 223                 $_ = $2;
 224               }
 225             }
 226           }
 227         }
 228         else {
 229           # Text line: accumulate.
 230           $line .= $_;
 231         }
 232       }
 233       close $fh;
 234       $$table{$sym} = $version;
 235     }
 236 }
 237
 238
 239 # Read symbols-in-versions.
 240 open(my $fh, "<", "$libdocdir/symbols-in-versions") ||
 241   die "$libdocdir/symbols-in-versions";
 242 while(<$fh>) {
 243   if($_ =~ /^((?:CURL|LIBCURL)\S+)\s+\S+\s*(\S*)\s*(\S*)$/) {
 244     if($3 eq "") {
 245       $syminver{$1} = "X";
 246       if($2 ne "" && $2 ne ".") {
 247         $syminver{$1} = $2;
 248       }
 249     }
 250   }
 251 }
 252 close($fh);
 253
 254 # Get header file names,
 255 opendir(my $dh, $incdir) || die "Can't opendir $incdir";
 256 my @hfiles = grep { /\.h$/ } readdir($dh);
 257 closedir $dh;
 258
 259 # Get functions and enum symbols from header files.
 260 for(@hfiles) {
 261   scan_header("$incdir/$_");
 262 }
 263
 264 # Get function statuses from man pages.
 265 foreach my $sym (keys %hdr) {
 266   if($sym =~/^(?:curl|curlx)_\w/) {
 267     scan_man_page("$libdocdir/$sym.3", $sym, \%funcman);
 268   }
 269 }
 270
 271 # Get options from function man pages.
 272 scan_man_for_opts("$libdocdir/curl_easy_setopt.3", "CURLOPT");
 273 scan_man_for_opts("$libdocdir/curl_easy_getinfo.3", "CURLINFO");
 274
 275 # Get deprecation status from option man pages.
 276 foreach my $sym (keys %syminver) {
 277   if($sym =~ /^(?:CURLOPT|CURLINFO)_\w+$/) {
 278     scan_man_page("$libdocdir/opts/$sym.3", $sym, \%optman);
 279   }
 280 }
 281
 282 # Print results.
 283 my %keys = (%syminver, %funcman, %optman, %hdr);
 284 my $leader = <<HEADER
 285 Legend:
 286 <empty> Not listed
 287 X       Not deprecated
 288 ?       Deprecated in unknown version
 289 x.yy.z  Deprecated in version x.yy.z
 290
 291 Symbol                                 symbols-in  func man  opt man   .h
 292                                        -versions
 293 HEADER
 294         ;
 295 foreach my $sym (sort {$a cmp $b} keys %keys) {
 296   if($sym =~ /^(?:CURLOPT|CURLINFO|curl|curlx)_\w/) {
 297     my $s = exists($syminver{$sym})? $syminver{$sym}: " ";
 298     my $f = exists($funcman{$sym})? $funcman{$sym}: " ";
 299     my $o = exists($optman{$sym})? $optman{$sym}: " ";
 300     my $h = exists($hdr{$sym})? $hdr{$sym}: " ";
 301     my $r = " ";
 302
 303     # There are deprecated symbols in symbols-in-versions that are aliases
 304     # and thus not listed anywhere else. Ignore them.
 305     "$f$o$h" =~ /[X ]{3}/ && next;
 306
 307     # Check for inconsistencies between deprecations from the different sources.
 308     foreach my $k ($s, $f, $o, $h) {
 309       $r = $r eq " "? $k: $r;
 310       if($k ne " " && $r ne $k) {
 311         if($r eq "?") {
 312           $r = $k ne "X"? $k: "!";
 313         }
 314         elsif($r eq "X" || $k ne "?") {
 315           $r = "!";
 316         }
 317       }
 318     }
 319
 320     if($r eq "!") {
 321       print $leader;
 322       $leader = "";
 323       printf("%-38s %-11s %-9s %-9s %s\n", $sym, $s, $f, $o, $h);
 324       $errcode++;
 325     }
 326   }
 327 }
 328
 329 exit $errcode;