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