tests/test1222.pl - master - githubmirror/curl

tests/test1222.pl
335 строк10 KB
Viktor Szakats
perl: `open... || ` -> `open... or` (cont.)
16 июн 2026, 20:11
16 июн 2026, 20:11be8f243
#!/usr/bin/env perl
#***************************************************************************
#                                  _   _ ____  _
#  Project                     ___| | | |  _ \| |
#                             / __| | | | |_) | |
#                            | (__| |_| |  _ <| |___
#                             \___|\___/|_| \_\_____|
#
# Copyright (C) Daniel Stenberg, <daniel@haxx.se>, et al.
#
# This software is licensed as described in the file COPYING, which
# you should have received as part of this distribution. The terms
# are also available at https://curl.se/docs/copyright.html.
#
# You may opt to use, copy, modify, merge, publish, distribute and/or sell
# copies of the Software, and permit persons to whom the Software is
# furnished to do so, under the terms of the COPYING file.
#
# This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
# KIND, either express or implied.
#
# SPDX-License-Identifier: curl
#
#
###########################################################################
#
# Check that the deprecated statuses of functions and enum values in header
# files, man pages and symbols-in-versions are in sync.

use strict;
use warnings;

use File::Basename;

my $root = $ARGV[0] || ".";
my $bldroot = $ARGV[1] || ".";

my $incdir = "$root/include/curl";
my $docdir = "$bldroot/docs";
my $libdocdir = "$docdir/libcurl";

my $errcode = 0;

# Symbol-indexed hashes.
# Values are:
#     X       Not deprecated
#     ?       Deprecated in unknown version
#     x.yy.z  Deprecated in version x.yy.z
my %syminver;       # Symbols-in-versions deprecations.
my %hdr;            # Public header files deprecations.
my %funcman;        # Function man pages deprecations.
my %optman;         # Option man pages deprecations.

# Scan header file for public function and enum values. Flag them with
# the version they are deprecated in, if some.
sub scan_header {
    my ($f) = @_;
    my $line = "";
    my $incomment = 0;
    my $inenum = 0;

    open(my $h, "<", $f);
    while(<$h>) {
        s/^\s*(.*?)\s*$/$1/;      # Trim.
        # Remove multi-line comment trail.
        if($incomment) {
            if($_ !~ /.*?\*\/\s*(.*)$/) {
                next;
            }
            $_ = $1;
            $incomment = 0;
        }
        if($line ne "") {
            # Unfold line.
            $_ = "$line $1";
            $line = "";
        }
        # Remove comments.
        while($_ =~ /^(.*?)\/\*.*?\*\/(.*)$/) {
            $_ = "$1 $2";
        }
        if($_ =~ /^(.*)\/\*/) {
            $_ = "$1 ";
            $incomment = 1;
        }
        s/^\s*(.*?)\s*$/$1/;      # Trim again.
        # Ignore preprocessor directives and blank lines.
        if($_ =~ /^(?:#|$)/) {
            next;
        }
        # Handle lines that may be continued as if they were folded.
        if($_ !~ /[;,{}]$/) {
            # Folded line.
            $line = $_;
            next;
        }
        if($_ =~ /CURLOPTDEPRECATED\(/) {
            # Handle deprecated CURLOPT_* option.
            if($_ !~ /CURLOPTDEPRECATED\(\s*(\S+)\s*,(?:.*?,){2}\s*(.*?)\s*,.*"\)/) {
                # Folded line.
                $line = $_;
                next;
            }
            $hdr{$1} = $2;
        }
        elsif($_ =~ /CURLOPT\(/) {
            # Handle non-deprecated CURLOPT_* option.
            if($_ !~ /CURLOPT\(\s*(\S+)\s*(?:,.*?){2}\)/) {
                # Folded line.
                $line = $_;
                next;
            }
            $hdr{$1} = "X";
        }
        else {
            my $version = "X";

            # Get other kind of deprecation from this line.
            if($_ =~ /CURL_DEPRECATED\(/) {
                if($_ !~ /^(.*)CURL_DEPRECATED\(\s*(\S+?)\s*,.*?"\)(.*)$/) {
                    # Folded line.
                    $line = $_;
                    next;
                }
                $version = $2;
                $_ = "$1 $3";
            }
            if($_ =~ /^CURL_EXTERN\s+.*\s+(\S+?)\s*\(/) {
                # Flag public function.
                $hdr{$1} = $version;
            }
            elsif($inenum && $_ =~ /(\w+)\s*[,=}]/) {
                # Flag enum value.
                $hdr{$1} = $version;
            }
        }
        # Remember if we are in an enum definition.
        $inenum |= ($_ =~ /\benum\b/);
        if($_ =~ /}/) {
            $inenum = 0;
        }
    }
    close $h;
}

# Scan function man page for options.
# Each option has to be declared as ".IP <option>" where <option> starts with
# the prefix. Flag each option with its deprecation version, if some.
sub scan_man_for_opts {
    my ($f, $prefix) = @_;
    my $opt = "";
    my $line = "";

    open(my $m, "<", $f);
    while(<$m>) {
        if($_ =~ /^\./) {
            # roff directive found: end current option paragraph.
            my $o = $opt;
            $opt = "";
            if($_ =~ /^\.IP\s+((?:$prefix)_\w+)/) {
                # A new option has been found.
                $opt = $1;
            }
            $_ = $line;     # Get full paragraph.
            $line = "";
            s/\\f.//g;      # Remove font formatting.
            s/\s+/ /g;      # One line with single space only.
            if($o) {
                $funcman{$o} = "X";
                # Check if paragraph is mentioning deprecation.
                while($_ =~ /(?:deprecated|obsoleted?)\b\s*(?:in\b|since\b)?\s*(?:version\b|curl\b|libcurl\b)?\s*(\d[0-9.]*\d)?\b\s*(.*)$/i) {
                    $funcman{$o} = $1 || "?";
                    $_ = $2;
                }
            }
        }
        else {
            # Text line: accumulate.
            $line .= $_;
        }
    }
    close $m;
}

# Scan man page for deprecation in DESCRIPTION and/or AVAILABILITY sections.
sub scan_man_page {
    my ($path, $sym, $table) = @_;
    my $version = "X";

    if(open(my $fh, "<", $path)) {
        my $section = "";
        my $line = "";

        while(<$fh>) {
            if($_ =~ /\.so\s+man3\/(.*\.3\b)/) {
                # Handle man page inclusion.
                scan_man_page(dirname($path) . "/$1", $sym, $table);
                $version = exists($$table{$sym})? $$table{$sym}: $version;
            }
            elsif($_ =~ /^\./) {
                # Line is a roff directive.
                if($_ =~ /^\.SH\b\s*(\w*)/) {
                    # Section starts. End previous one.
                    my $sh = $section;

                    $section = $1;
                    $_ = $line;     # Previous section text.
                    $line = "";
                    s/\\f.//g;
                    s/\s+/ /g;
                    s/\\f.//g;      # Remove font formatting.
                    s/\s+/ /g;      # One line with single space only.
                    if($sh =~ /DESCRIPTION|DEPRECATED/) {
                        while($_ =~ /(?:deprecated|obsoleted?)\b\s*(?:in\b|since\b)?\s*(?:version\b|curl\b|libcurl\b)?\s*(\d[0-9.]*\d)?\b\s*(.*)$/i) {
                            # Flag deprecation status.
                            if($version ne "X" && $version ne "?") {
                                if($1 && $1 ne $version) {
                                    print "error: $sym man page lists unmatching deprecation versions $version and $1\n";
                                    $errcode++;
                                }
                            }
                            else {
                                $version = $1 || "?";
                            }
                            $_ = $2;
                        }
                    }
                }
            }
            else {
                # Text line: accumulate.
                $line .= $_;
            }
        }
        close $fh;
        $$table{$sym} = $version;
    }
}

# Read symbols-in-versions.
open(my $fh, "<", "$root/docs/libcurl/symbols-in-versions") or
    die "$root/docs/libcurl/symbols-in-versions";
while(<$fh>) {
    if($_ =~ /^((?:CURL|LIBCURL)\S+)\s+\S+\s*(\S*)\s*(\S*)$/) {
        if($3 eq "") {
            $syminver{$1} = "X";
            if($2 ne "" && $2 ne ".") {
                $syminver{$1} = $2;
            }
        }
    }
}
close($fh);

if(!glob("$libdocdir/*.3")) {
    print "curl built without the libcurl manual. Skipping test 1222.\n";
    exit 0;
}

# Get header filenames,
opendir(my $dh, $incdir) or die "Cannot opendir $incdir";
my @hfiles = grep { /\.h$/ } readdir($dh);
closedir $dh;

# Get functions and enum symbols from header files.
for(@hfiles) {
    scan_header("$incdir/$_");
}

# Get function statuses from man pages.
foreach my $sym (keys %hdr) {
    if($sym =~ /^(?:curl|curlx)_\w/) {
        scan_man_page("$libdocdir/$sym.3", $sym, \%funcman);
    }
}

# Get options from function man pages.
scan_man_for_opts("$libdocdir/curl_easy_setopt.3", "CURLOPT");
scan_man_for_opts("$libdocdir/curl_easy_getinfo.3", "CURLINFO");

# Get deprecation status from option man pages.
foreach my $sym (keys %syminver) {
    if($sym =~ /^(?:CURLOPT|CURLINFO)_\w+$/) {
        scan_man_page("$libdocdir/opts/$sym.3", $sym, \%optman);
    }
}

# Print results.
my %keys = (%syminver, %funcman, %optman, %hdr);
my $leader = <<HEADER
Legend:
<empty> Not listed
X       Not deprecated
?       Deprecated in unknown version
x.yy.z  Deprecated in version x.yy.z

Symbol                                 symbols-in  func man  opt man   .h
                                       -versions
HEADER
        ;
foreach my $sym (sort {$a cmp $b} keys %keys) {
    if($sym =~ /^(?:CURLOPT|CURLINFO|curl|curlx)_\w/) {
        my $s = exists($syminver{$sym})? $syminver{$sym}: " ";
        my $f = exists($funcman{$sym})? $funcman{$sym}: " ";
        my $o = exists($optman{$sym})? $optman{$sym}: " ";
        my $h = exists($hdr{$sym})? $hdr{$sym}: " ";
        my $r = " ";

        # There are deprecated symbols in symbols-in-versions that are aliases
        # and thus not listed anywhere else. Ignore them.
        "$f$o$h" =~ /[X ]{3}/ && next;

        # Check for inconsistencies between deprecations from the different sources.
        foreach my $k ($s, $f, $o, $h) {
            $r = $r eq " "? $k: $r;
            if($k ne " " && $r ne $k) {
                if($r eq "?") {
                    $r = $k ne "X"? $k: "!";
                }
                elsif($r eq "X" || $k ne "?") {
                    $r = "!";
                }
            }
        }

        if($r eq "!") {
            print $leader;
            $leader = "";
            printf("%-38s %-11s %-9s %-9s %s\n", $sym, $s, $f, $o, $h);
            $errcode++;
        }
    }
}

exit $errcode;