scripts: enable strict warnings in Perl where missing, fix fallouts

- add 'use warnings' and 'use strict' where missing from Perl scripts.
- fix 'Use of uninitialized value'.
- fix missing declarations.
- test1140.pl: fix 'Possible precedence issue with control flow operator'.
- fix other misc issues.

Most actual errors found during this PR were fixed and merged via
separate PRs.

Likely there are remaining warnings not found and fixed in this PR.

Closes #17877
This commit is contained in:
Viktor Szakats 2025-07-09 21:18:29 +02:00
parent 89771d19d5
commit 2ec54556d4
No known key found for this signature in database
GPG key ID: B5ABD165E2AEF201
45 changed files with 323 additions and 97 deletions

View file

@ -13,7 +13,15 @@
# #
# ---(accepted word) # ---(accepted word)
# #
my $w;
use strict;
use warnings;
my @whitelist;
my %alt;
my %exactcase;
my @w;
while(<STDIN>) { while(<STDIN>) {
chomp; chomp;
if($_ =~ /^#/) { if($_ =~ /^#/) {

View file

@ -10,6 +10,11 @@
# might have a problem with that we still deem is fine. # might have a problem with that we still deem is fine.
# #
use strict;
use warnings;
my @asyms;
open(S, "<./docs/libcurl/symbols-in-versions") open(S, "<./docs/libcurl/symbols-in-versions")
|| die "can't find symbols-in-versions"; || die "can't find symbols-in-versions";
while(<S>) { while(<S>) {

View file

@ -23,6 +23,9 @@
# #
########################################################################### ###########################################################################
use strict;
use warnings;
my $autotools = $ARGV[0]; my $autotools = $ARGV[0];
my $cmake = $ARGV[1]; my $cmake = $ARGV[1];

View file

@ -18,6 +18,9 @@
# directory where it runs. # directory where it runs.
# #
use strict;
use warnings;
my $curl = "../src/curl"; my $curl = "../src/curl";
my $url = "localhost:7777"; # not listening to this my $url = "localhost:7777"; # not listening to this
@ -31,6 +34,14 @@ if(!$seconds) {
} }
print "Run $curl for $seconds seconds\n"; print "Run $curl for $seconds seconds\n";
my @opt;
my %arg;
my %uniq;
my %allrc;
my $totalargs = 0;
my $totalcmds = 0;
my $counter = 0xabcdef + time(); my $counter = 0xabcdef + time();
sub getnum { sub getnum {
my ($max) = @_; my ($max) = @_;
@ -164,6 +175,7 @@ sub runconfig {
my $o = getnum($nopts); my $o = getnum($nopts);
my $option = $opt[$o]; my $option = $opt[$o];
my $ar = ""; my $ar = "";
$uniq{$option} = 0 if(!exists $uniq{$option});
$uniq{$option}++; $uniq{$option}++;
if($arg{$option}) { if($arg{$option}) {
$ar = " ".randarg(); $ar = " ".randarg();

View file

@ -7,7 +7,10 @@
# Outputs: the same file, minus the header # Outputs: the same file, minus the header
# #
my $f = $ARGV[0]; use strict;
use warnings;
my $f = $ARGV[0] || '';
open(F, "<$f") or die; open(F, "<$f") or die;

View file

@ -23,12 +23,15 @@
# #
########################################################################### ###########################################################################
use strict;
use warnings;
my @files = @ARGV; my @files = @ARGV;
my $cfile = "test.c"; my $cfile = "test.c";
my $check = "./scripts/checksrc.pl"; my $check = "./scripts/checksrc.pl";
my $error; my $error = 0;
if($files[0] eq "-h") { if(!@files || $files[0] eq "-h") {
print "Usage: verify-examples [markdown pages]\n"; print "Usage: verify-examples [markdown pages]\n";
exit; exit;
} }
@ -82,7 +85,7 @@ sub extract {
return ($fail ? 0 : $l); return ($fail ? 0 : $l);
} }
my $count; my $count = 0;
for my $m (@files) { for my $m (@files) {
#print "Verify $m\n"; #print "Verify $m\n";
my $out = extract($m); my $out = extract($m);

View file

@ -23,10 +23,13 @@
# #
########################################################################### ###########################################################################
use strict;
use warnings;
my @files = @ARGV; my @files = @ARGV;
my $cfile = "test.c"; my $cfile = "test.c";
if($files[0] eq "-h") { if(!@files || $files[0] eq "-h") {
print "Usage: verify-synopsis [man pages]\n"; print "Usage: verify-synopsis [man pages]\n";
exit; exit;
} }

View file

@ -25,9 +25,12 @@
# pass files as argument(s) # pass files as argument(s)
use strict;
use warnings;
my $docroot="https://curl.se/libcurl/c"; my $docroot="https://curl.se/libcurl/c";
for $f (@ARGV) { for my $f (@ARGV) {
open(NEW, ">$f.new"); open(NEW, ">$f.new");
open(F, "<$f"); open(F, "<$f");
while(<F>) { while(<F>) {

View file

@ -38,6 +38,9 @@
# version-check.pl [source file] # version-check.pl [source file]
# #
use strict;
use warnings;
open(S, "<../libcurl/symbols-in-versions") || die; open(S, "<../libcurl/symbols-in-versions") || die;
my %doc; my %doc;
@ -64,7 +67,7 @@ sub age {
my ($ver)=@_; my ($ver)=@_;
my @s=split(/\./, $ver); my @s=split(/\./, $ver);
return $s[0]*10000+$s[1]*100+$s[2]; return $s[0]*10000+$s[1]*100+($s[2] || 0);
} }
my %used; my %used;

View file

@ -22,6 +22,8 @@
# * SPDX-License-Identifier: curl # * SPDX-License-Identifier: curl
# * # *
# *************************************************************************** # ***************************************************************************
use strict;
use warnings;
use POSIX qw(strftime); use POSIX qw(strftime);
my @ts; my @ts;

View file

@ -44,12 +44,15 @@
# #endif # #endif
# #
# #
use strict;
use warnings;
open F, "<symbols-in-versions"; open F, "<symbols-in-versions";
sub str2num { sub str2num {
my ($str)=@_; my ($str)=@_;
if($str =~ /([0-9]*)\.([0-9]*)\.*([0-9]*)/) { if($str && $str =~ /([0-9]*)\.([0-9]*)\.*([0-9]*)/) {
return sprintf("0x%06x", $1<<16 | $2 << 8 | $3); return sprintf("0x%06x", $1 <<16 | $2 << 8 | ($3 || '0'));
} }
} }

View file

@ -1,5 +1,8 @@
#!/usr/bin/env perl #!/usr/bin/env perl
use strict;
use warnings;
print <<HEAD print <<HEAD
/*************************************************************************** /***************************************************************************
* _ _ ____ _ * _ _ ____ _
@ -37,31 +40,36 @@ HEAD
my $lastnum=0; my $lastnum=0;
my %opt;
my %type;
my @names;
my %alias;
sub add { sub add {
my($opt, $type, $num)=@_; my($optstr, $typestr, $num)=@_;
my $name; my $name;
# remove all spaces from the type # remove all spaces from the type
$type =~ s/ //g; $typestr =~ s/ //g;
my $ext = $type; my $ext = $typestr;
if($opt =~ /OBSOLETE/) { if($optstr =~ /OBSOLETE/) {
# skip obsolete options # skip obsolete options
next; next;
} }
if($opt =~ /^CURLOPT_(.*)/) { if($optstr =~ /^CURLOPT_(.*)/) {
$name=$1; $name=$1;
} }
$ext =~ s/CURLOPTTYPE_//; $ext =~ s/CURLOPTTYPE_//;
$ext =~ s/CBPOINT/CBPTR/; $ext =~ s/CBPOINT/CBPTR/;
$ext =~ s/POINT\z//; $ext =~ s/POINT\z//;
$type = "CURLOT_$ext"; $typestr = "CURLOT_$ext";
$opt{$name} = $opt; $opt{$name} = $optstr;
$type{$name} = $type; $type{$name} = $typestr;
push @names, $name; push @names, $name;
if($num < $lastnum) { if($num < $lastnum) {
print STDERR "ERROR: $opt has bad number: $num < $lastnum\n"; print STDERR "ERROR: $optstr has bad number: $num < $lastnum\n";
exit 2; exit 2;
} }
else { else {
@ -123,8 +131,8 @@ for my $name (sort @names) {
$name = $alias{$name}; $name = $alias{$name};
$flag = "CURLOT_FLAG_ALIAS"; $flag = "CURLOT_FLAG_ALIAS";
} }
$o = sprintf(" {\"%s\", %s, %s, %s},\n", my $o = sprintf(" {\"%s\", %s, %s, %s},\n",
$oname, $opt{$name}, $type{$name}, $flag); $oname, $opt{$name}, $type{$name}, $flag);
if(length($o) < 80) { if(length($o) < 80) {
print $o; print $o;
} }

View file

@ -36,13 +36,16 @@ Example: cd2cd [--in-place] <file.md> > <file.md>
=end comment =end comment
=cut =cut
use strict;
use warnings;
my $cd2cd = "0.1"; # to keep check my $cd2cd = "0.1"; # to keep check
my $dir; my $dir;
my $extension; my $extension;
my $inplace = 0; my $inplace = 0;
while(1) { while(1) {
if($ARGV[0] eq "--in-place") { if(@ARGV && $ARGV[0] eq "--in-place") {
shift @ARGV; shift @ARGV;
$inplace = 1; $inplace = 1;
} }
@ -84,6 +87,9 @@ sub single {
my $start = 0; my $start = 0;
my $d; my $d;
my $line = 0; my $line = 0;
my $salist = 0;
my $copyright;
my $spdx;
open(F, "<:crlf", "$f") || open(F, "<:crlf", "$f") ||
return 1; return 1;
while(<F>) { while(<F>) {
@ -221,6 +227,6 @@ if($inplace) {
single($a); single($a);
} }
} }
else { elsif(@ARGV) {
exit single($ARGV[0]); exit single($ARGV[0]);
} }

View file

@ -25,6 +25,9 @@
# provide all dir names to scan on the cmdline # provide all dir names to scan on the cmdline
use strict;
use warnings;
sub convert { sub convert {
my ($dir)=@_; my ($dir)=@_;
opendir(my $dh, $dir) || die "could not open $dir"; opendir(my $dh, $dir) || die "could not open $dir";

View file

@ -23,6 +23,14 @@
# #
########################################################################### ###########################################################################
use strict;
use warnings;
my %with;
my %without;
my %used;
my %avail;
# these options are enabled by default in the sense that they will attempt to # these options are enabled by default in the sense that they will attempt to
# check for and use this feature without the configure flag # check for and use this feature without the configure flag
my %defaulton = ( my %defaulton = (

View file

@ -23,6 +23,9 @@
# #
########################################################################### ###########################################################################
use strict;
use warnings;
my %filelevel= ('file' => 1, my %filelevel= ('file' => 1,
'service' => 1); 'service' => 1);
@ -39,6 +42,8 @@ sub submit {
} }
} }
my %job;
sub githubactions { sub githubactions {
my ($tag)=@_; my ($tag)=@_;
my @files= `git ls-tree -r --name-only $tag .github/workflows 2>/dev/null`; my @files= `git ls-tree -r --name-only $tag .github/workflows 2>/dev/null`;
@ -341,6 +346,8 @@ sub circle {
my $cmds; my $cmds;
my $jobs; my $jobs;
my $workflow; my $workflow;
my $cmdname;
my $jobname;
$job{'file'} = ".circleci/config.yml"; $job{'file'} = ".circleci/config.yml";
$job{'service'} = "circleci"; $job{'service'} = "circleci";
while(<G>) { while(<G>) {
@ -408,6 +415,10 @@ sub zuul {
my %job; my %job;
my $line=0; my $line=0;
my $type; my $type;
my $jobmode;
my $apt = 0;
my $env = 0;
my $envcont;
$job{'file'} = "zuul.d/jobs.yaml"; $job{'file'} = "zuul.d/jobs.yaml";
$job{'service'} = "zuul"; $job{'service'} = "zuul";
while(<G>) { while(<G>) {

View file

@ -30,6 +30,9 @@
# #
# In the git clone root, invoke 'scripts/delta [release tag]' # In the git clone root, invoke 'scripts/delta [release tag]'
use strict;
use warnings;
$start = $ARGV[0]; $start = $ARGV[0];
if($start eq "-h") { if($start eq "-h") {

View file

@ -23,6 +23,12 @@
# #
########################################################################### ###########################################################################
use strict;
use warnings;
my @proto;
my %inc;
sub scanfile { sub scanfile {
my ($file) = @_; my ($file) = @_;
open(F, "<$file") || die "$file failed"; open(F, "<$file") || die "$file failed";

View file

@ -39,6 +39,9 @@ Unfortunately it seems some perls like msysgit cannot handle a global input-only
=end comment =end comment
=cut =cut
use strict;
use warnings;
my %optshort; my %optshort;
my %optlong; my %optlong;
my %helplong; my %helplong;
@ -65,7 +68,7 @@ my $indent = 4;
sub manpageify { sub manpageify {
my ($k)=@_; my ($k)=@_;
my $l; my $l;
my $trail; my $trail = '';
# the matching pattern might include a trailing dot that cannot be part of # the matching pattern might include a trailing dot that cannot be part of
# the option name # the option name
if($k =~ s/\.$//) { if($k =~ s/\.$//) {
@ -127,8 +130,10 @@ sub justline {
sub lastline { sub lastline {
my ($lvl, @line) = @_; my ($lvl, @line) = @_;
my $l = 0;
$line[0] =~ s/^( +)//; $line[0] =~ s/^( +)//;
prefixline($lvl * $indent + length($1)); $l = length($1) if($1);
prefixline($lvl * $indent + $l);
my $prev = 0; my $prev = 0;
for(@line) { for(@line) {
printf "%s%s", $prev?" ":"", $_; printf "%s%s", $prev?" ":"", $_;
@ -174,9 +179,11 @@ sub printdesc {
} }
else { else {
my $p = -1; my $p = -1;
my $para; my $pnum;
my $para = '';
for my $l (@desc) { for my $l (@desc) {
my $lvl; my $lvl = 0;
my $lvlnum;
if($l !~ /^[\n\r]+/) { if($l !~ /^[\n\r]+/) {
# get the indent level off the string # get the indent level off the string
$l =~ s/^\[([0-9q]*)\]//; $l =~ s/^\[([0-9q]*)\]//;
@ -186,15 +193,19 @@ sub printdesc {
# the previous was quoted, this is not # the previous was quoted, this is not
print "\n"; print "\n";
} }
if($lvl != $p) { if($lvl ne $p) {
outputpara($baselvl + $p, $para); $pnum = $p;
$pnum =~ s/q$//;
outputpara($baselvl + $pnum, $para);
$para = ""; $para = "";
} }
if($lvl =~ /q/) { if($lvl =~ /q/) {
# quoted, do not right-justify # quoted, do not right-justify
chomp $l; chomp $l;
lastline($baselvl + $lvl + 1, $l); $lvlnum = $lvl;
my $w = ($baselvl + $lvl + 1) * $indent + length($l); $lvlnum =~ s/q$//;
lastline($baselvl + $lvlnum + 1, $l);
my $w = ($baselvl + $lvlnum + 1) * $indent + length($l);
if($w > $colwidth) { if($w > $colwidth) {
print STDERR "ERROR: $w columns is too long\n"; print STDERR "ERROR: $w columns is too long\n";
print STDERR "$l\n"; print STDERR "$l\n";
@ -207,7 +218,9 @@ sub printdesc {
$p = $lvl; $p = $lvl;
} }
outputpara($baselvl + $p, $para); $pnum = $p;
$pnum =~ s/q$//;
outputpara($baselvl + $pnum, $para);
} }
} }
@ -281,10 +294,11 @@ sub render {
my $header = 0; my $header = 0;
# if $top is TRUE, it means a top-level page and not a command line option # if $top is TRUE, it means a top-level page and not a command line option
my $top = ($line == 1); my $top = ($line == 1);
my $quote; my $quote = 0;
my $level; my $level = 0;
my $finalblank; my $finalblank;
$start = 0; my $blankline = 0;
my $start = 0;
while(<$fh>) { while(<$fh>) {
my $d = $_; my $d = $_;
@ -575,7 +589,7 @@ sub single {
$protocols=$1; $protocols=$1;
} }
elsif(/^See-also: +(.+)/i) { elsif(/^See-also: +(.+)/i) {
if($seealso) { if(@seealso) {
print STDERR "ERROR: duplicated See-also in $f\n"; print STDERR "ERROR: duplicated See-also in $f\n";
return 1; return 1;
} }
@ -666,10 +680,6 @@ sub single {
my @desc = render($manpage, $fh, $f, $line); my @desc = render($manpage, $fh, $f, $line);
close($fh); close($fh);
if($tablemode) {
# end of table
push @desc, ".RE\n.IP\n";
}
my $opt; my $opt;
if(defined($short) && $long) { if(defined($short) && $long) {
@ -802,7 +812,7 @@ sub single {
my @m=split(/ /, $mutexed); my @m=split(/ /, $mutexed);
my $mstr; my $mstr;
my $num = scalar(@m); my $num = scalar(@m);
my $count; my $count = 0;
for my $k (@m) { for my $k (@m) {
if(!$helplong{$k}) { if(!$helplong{$k}) {
print STDERR "WARN: $f mutexes a non-existing option: $k\n"; print STDERR "WARN: $f mutexes a non-existing option: $k\n";
@ -876,13 +886,13 @@ sub single {
push @foot, seealso($standalone, $mstr); push @foot, seealso($standalone, $mstr);
print "\n"; print "\n";
my $f = join("", @foot); my $ft = join("", @foot);
if($manpage) { if($manpage) {
$f =~ s/ +\z//; # remove trailing space $ft =~ s/ +\z//; # remove trailing space
print "$f\n"; print "$ft\n";
} }
else { else {
printdesc($manpage, 2, "[1]$f"); printdesc($manpage, 2, "[1]$ft");
} }
return 0; return 0;
} }
@ -950,8 +960,8 @@ sub getshortlong {
sub indexoptions { sub indexoptions {
my ($dir, @files) = @_; my ($dir, @files) = @_;
foreach my $f (@files) { foreach my $file (@files) {
getshortlong($dir, $f); getshortlong($dir, $file);
} }
} }
@ -1122,7 +1132,6 @@ sub listglobals {
} }
close(F); close(F);
} }
return $ret if($ret);
for my $e (0 .. $#globalopts) { for my $e (0 .. $#globalopts) {
$globals .= sprintf "%s--%s", $e?($globalopts[$e+1] ? ", " : " and "):"", $globals .= sprintf "%s--%s", $e?($globalopts[$e+1] ? ", " : " and "):"",
$globalopts[$e],; $globalopts[$e],;
@ -1257,7 +1266,7 @@ sub getargs {
my $dir = "."; my $dir = ".";
my $include = "../../include"; my $include = "../../include";
my $cmd = shift @ARGV; my $cmd = shift @ARGV || '';
check: check:
if($cmd eq "-d") { if($cmd eq "-d") {

View file

@ -23,6 +23,9 @@
# #
########################################################################### ###########################################################################
use strict;
use warnings;
my %whitelist = ( my %whitelist = (
'https://curl.se/' => 1, 'https://curl.se/' => 1,
'https://curl.se/changes.html' => 1, 'https://curl.se/changes.html' => 1,
@ -70,6 +73,9 @@ my %whitelist = (
); );
my %url;
my %flink;
# list all .md files in the repo # list all .md files in the repo
my @files=`git ls-files '**.md'`; my @files=`git ls-files '**.md'`;
@ -127,6 +133,7 @@ sub checkurl {
print "check $url\n"; print "check $url\n";
my $curlcmd="curl -ILfsm10 --retry 2 --retry-delay 5 -A \"Mozilla/curl.se link-probe\""; my $curlcmd="curl -ILfsm10 --retry 2 --retry-delay 5 -A \"Mozilla/curl.se link-probe\"";
$url =~ s/\+/%2B/g;
my @content = `$curlcmd \"$url\"`; my @content = `$curlcmd \"$url\"`;
if(!$content[0]) { if(!$content[0]) {
print STDERR "FAIL\n"; print STDERR "FAIL\n";
@ -146,7 +153,7 @@ for my $u (sort keys %url) {
my $r = checkurl($u); my $r = checkurl($u);
if($r) { if($r) {
for my $f (split(/ /, $url{$l})) { for my $f (split(/ /, $url{$u})) {
printf "%s ERROR links to missing URL %s\n", $f, $u; printf "%s ERROR links to missing URL %s\n", $f, $u;
$error++; $error++;
} }

View file

@ -36,6 +36,9 @@ for code.
=end comment =end comment
=cut =cut
use strict;
use warnings;
my $nroff2cd = "0.1"; # to keep check my $nroff2cd = "0.1"; # to keep check
sub single { sub single {
@ -189,4 +192,6 @@ HEAD
return !$header; return !$header;
} }
exit single($ARGV[0]); if(@ARGV) {
exit single($ARGV[0]);
}

View file

@ -20,8 +20,13 @@
# - edit the @tls array to include all TLS backends you can build with # - edit the @tls array to include all TLS backends you can build with
# - do a checkout in a ram-based filesystem # - do a checkout in a ram-based filesystem
# #
use strict;
use warnings;
use List::Util qw/shuffle/; use List::Util qw/shuffle/;
my @disable;
sub getoptions { sub getoptions {
my @all = `./configure --help`; my @all = `./configure --help`;
for my $o (@all) { for my $o (@all) {

View file

@ -54,7 +54,10 @@
# #
################################################ ################################################
my $cleanup = ($ARGV[0] eq "cleanup"); use strict;
use warnings;
my $cleanup = (@ARGV && $ARGV[0] eq "cleanup");
my @gitlog=`git log @^{/RELEASE-NOTES:.synced}..` if(!$cleanup); my @gitlog=`git log @^{/RELEASE-NOTES:.synced}..` if(!$cleanup);
my @releasenotes=`cat RELEASE-NOTES`; my @releasenotes=`cat RELEASE-NOTES`;
@ -120,6 +123,12 @@ sub extract {
# false alarm, not a valid line # false alarm, not a valid line
} }
my @fixes;
my @closes;
my @bug;
my @line;
my %moreinfo;
my $short; my $short;
my $first; my $first;
for my $l (@gitlog) { for my $l (@gitlog) {
@ -167,7 +176,7 @@ if($first) {
# call at the end of a parsed commit # call at the end of a parsed commit
sub onecommit { sub onecommit {
my ($short)=@_; my ($short)=@_;
my $ref; my $ref = '';
if($dupe{$short}) { if($dupe{$short}) {
# this git commit message was found in the file # this git commit message was found in the file

View file

@ -33,13 +33,16 @@
# --unit : built to support unit tests # --unit : built to support unit tests
# #
use strict;
use warnings;
my $unittests; my $unittests;
if($ARGV[0] eq "--unit") { if(@ARGV && $ARGV[0] eq "--unit") {
$unittests = "tests/unit "; $unittests = "tests/unit ";
shift @ARGV; shift @ARGV;
} }
my $file = $ARGV[0]; my $file = $ARGV[0] || '';
my %wl = ( my %wl = (
'Curl_xfer_write_resp' => 'internal api', 'Curl_xfer_write_resp' => 'internal api',
@ -178,7 +181,6 @@ open(N, "nm $file|") ||
my %exist; my %exist;
my %uses; my %uses;
my $file;
while(<N>) { while(<N>) {
my $l = $_; my $l = $_;
chomp $l; chomp $l;
@ -204,7 +206,7 @@ while(<N>) {
} }
close(N); close(N);
my $err; my $err = 0;
for(sort keys %exist) { for(sort keys %exist) {
#printf "%s is defined in %s, used by: %s\n", $_, $exist{$_}, $uses{$_}; #printf "%s is defined in %s, used by: %s\n", $_, $exist{$_}, $uses{$_};
if(!$uses{$_}) { if(!$uses{$_}) {

View file

@ -23,8 +23,11 @@
# #
########################################################################### ###########################################################################
use strict;
use warnings;
my $varname = "var"; my $varname = "var";
if($ARGV[0] eq "--var") { if(@ARGV && $ARGV[0] eq "--var") {
shift; shift;
$varname = shift @ARGV; $varname = shift @ARGV;
} }

View file

@ -23,11 +23,17 @@
# #
########################################################################### ###########################################################################
if($ARGV[0] eq "-c") { use strict;
$c=1; use warnings;
my $c = 0;
if(@ARGV && $ARGV[0] eq "-c") {
$c = 1;
shift @ARGV; shift @ARGV;
} }
my @out;
push @out, " _ _ ____ _\n"; push @out, " _ _ ____ _\n";
push @out, " ___| | | | _ \\| |\n"; push @out, " ___| | | | _ \\| |\n";
push @out, " / __| | | | |_) | |\n"; push @out, " / __| | | | |_) | |\n";
@ -67,8 +73,8 @@ if($c)
my $gzippedContent; my $gzippedContent;
IO::Compress::Gzip::gzip( IO::Compress::Gzip::gzip(
\$content, \$gzippedContent, Level => 9, TextFlag => 1, Time=>0) or die "gzip failed:"; \$content, \$gzippedContent, Level => 9, TextFlag => 1, Time=>0) or die "gzip failed:";
$gzip = length($content); my $gzip = length($content);
$gzipped = length($gzippedContent); my $gzipped = length($gzippedContent);
print <<HEAD print <<HEAD
#include <zlib.h> #include <zlib.h>

View file

@ -22,9 +22,14 @@
# #
########################################################################### ###########################################################################
# populate the has %pastversion hash table with the version number as key and # populate the %pastversion hash table with the version number as key and
# release date as value # release date as value
use strict;
use warnings;
our %pastversion;
sub allversions { sub allversions {
my ($file) = @_; my ($file) = @_;
open(A, "<$file") || open(A, "<$file") ||

View file

@ -23,6 +23,9 @@
# #
#*************************************************************************** #***************************************************************************
use strict;
use warnings;
# This script invokes nghttpx properly to have it serve HTTP/2 for us. # This script invokes nghttpx properly to have it serve HTTP/2 for us.
# nghttpx runs as a proxy in front of our "actual" HTTP/1 server. # nghttpx runs as a proxy in front of our "actual" HTTP/1 server.
use Cwd; use Cwd;

View file

@ -23,6 +23,9 @@
# #
#*************************************************************************** #***************************************************************************
use strict;
use warnings;
# This script invokes nghttpx properly to have it serve HTTP/3 for us. # This script invokes nghttpx properly to have it serve HTTP/3 for us.
# nghttpx runs as a proxy in front of our "actual" HTTP/1 server. # nghttpx runs as a proxy in front of our "actual" HTTP/1 server.

View file

@ -22,6 +22,8 @@
# SPDX-License-Identifier: curl # SPDX-License-Identifier: curl
# #
########################################################################### ###########################################################################
use strict;
use warnings;
# Usage: # Usage:
# perl mk-lib1521.pl < ../../include/curl/curl.h lib1521.c # perl mk-lib1521.pl < ../../include/curl/curl.h lib1521.c
@ -363,6 +365,8 @@ static CURLcode test_lib1521(char *URL)
HEADER HEADER
; ;
my $infomode = 0;
while(<STDIN>) { while(<STDIN>) {
s/^\s*(.*?)\s*$/$1/; # Trim. s/^\s*(.*?)\s*$/$1/; # Trim.
# Remove multi-line comment trail. # Remove multi-line comment trail.

View file

@ -22,6 +22,9 @@
# SPDX-License-Identifier: curl # SPDX-License-Identifier: curl
# #
########################################################################### ###########################################################################
use strict;
use warnings;
# Determine if curl-config --protocols/--features matches the # Determine if curl-config --protocols/--features matches the
# curl --version protocols/features # curl --version protocols/features
if($#ARGV != 2) { if($#ARGV != 2) {
@ -41,7 +44,7 @@ close CURL;
$curl_protocols =~ s/\r//; $curl_protocols =~ s/\r//;
$curl_protocols =~ /\w+: (.*)$/; $curl_protocols =~ /\w+: (.*)$/;
@curl = split / /,$1; my @curl = split / /,$1;
# Read the output of curl-config # Read the output of curl-config
my @curl_config; my @curl_config;

View file

@ -22,6 +22,9 @@
# SPDX-License-Identifier: curl # SPDX-License-Identifier: curl
# #
########################################################################### ###########################################################################
use strict;
use warnings;
# Determine if curl-config --version matches the curl --version # Determine if curl-config --version matches the curl --version
if($#ARGV != 2) { if($#ARGV != 2) {
print "Usage: $0 curl-config-script curl-version-output-file version|vernum\n"; print "Usage: $0 curl-config-script curl-version-output-file version|vernum\n";

View file

@ -22,12 +22,15 @@
# SPDX-License-Identifier: curl # SPDX-License-Identifier: curl
# #
########################################################################### ###########################################################################
use strict;
use warnings;
# Determine if the given curl executable supports the 'openssl' SSL engine # Determine if the given curl executable supports the 'openssl' SSL engine
if($#ARGV != 0) { if($#ARGV != 0) {
print "Usage: $0 curl-executable\n"; print "Usage: $0 curl-executable\n";
exit 3; exit 3;
} }
if(!open(CURL, "@ARGV[0] -s --engine list|")) { if(!open(CURL, "$ARGV[0] -s --engine list|")) {
print "Can't get SSL engine list\n"; print "Can't get SSL engine list\n";
exit 2; exit 2;
} }

View file

@ -22,6 +22,9 @@
# SPDX-License-Identifier: curl # SPDX-License-Identifier: curl
# #
########################################################################### ###########################################################################
use strict;
use warnings;
# Perform simple file and directory manipulation in a portable way # Perform simple file and directory manipulation in a portable way
if($#ARGV <= 0) { if($#ARGV <= 0) {
print "Usage: $0 mkdir|rmdir|rm|move|gone path1 [path2] [more commands...]\n"; print "Usage: $0 mkdir|rmdir|rm|move|gone path1 [path2] [more commands...]\n";

View file

@ -22,6 +22,9 @@
# SPDX-License-Identifier: curl # SPDX-License-Identifier: curl
# #
########################################################################### ###########################################################################
use strict;
use warnings;
# Prepare a directory with known files and clean up afterwards # Prepare a directory with known files and clean up afterwards
use Time::Local; use Time::Local;

View file

@ -29,17 +29,22 @@
# MEM mprintf.c:1103 realloc(e5718, 64) = e6118 # MEM mprintf.c:1103 realloc(e5718, 64) = e6118
# MEM sendf.c:232 free(f6520) # MEM sendf.c:232 free(f6520)
use strict;
use warnings;
my $mallocs=0; my $mallocs=0;
my $callocs=0; my $callocs=0;
my $reallocs=0; my $reallocs=0;
my $strdups=0; my $strdups=0;
my $wcsdups=0; my $wcsdups=0;
my $showlimit; my $showlimit=0;
my $sends=0; my $sends=0;
my $recvs=0; my $recvs=0;
my $sockets=0; my $sockets=0;
my $verbose=0;
my $trace=0;
while(1) { while(@ARGV) {
if($ARGV[0] eq "-v") { if($ARGV[0] eq "-v") {
$verbose=1; $verbose=1;
shift @ARGV; shift @ARGV;
@ -70,7 +75,7 @@ sub newtotal {
} }
} }
my $file = $ARGV[0]; my $file = $ARGV[0] || '';
if(! -f $file) { if(! -f $file) {
print "Usage: memanalyze.pl [options] <dump file>\n", print "Usage: memanalyze.pl [options] <dump file>\n",
@ -94,11 +99,36 @@ if($showlimit) {
exit; exit;
} }
my %sizeataddr;
my %getmem;
my $lnum=0; my $totalmem = 0;
my $frees = 0;
my $dup;
my $size;
my $addr;
my %filedes;
my %getfile;
my %fopen;
my %fopenfile;
my $openfile = 0;
my $fopens = 0;
my %addrinfo;
my %addrinfofile;
my $addrinfos = 0;
my $source;
my $linenum;
my $function;
my $lnum = 0;
while(<$fileh>) { while(<$fileh>) {
chomp $_; chomp $_;
$line = $_; my $line = $_;
$lnum++; $lnum++;
if($line =~ /^LIMIT ([^ ]*):(\d*) (.*)/) { if($line =~ /^LIMIT ([^ ]*):(\d*) (.*)/) {
# new memory limit test prefix # new memory limit test prefix
@ -145,13 +175,13 @@ while(<$fileh>) {
$size = $1; $size = $1;
$addr = $2; $addr = $2;
if($sizeataddr{$addr}>0) { if($sizeataddr{$addr} && $sizeataddr{$addr}>0) {
# this means weeeeeirdo # this means weeeeeirdo
print "Mixed debug compile ($source:$linenum at line $lnum), rebuild curl now\n"; print "Mixed debug compile ($source:$linenum at line $lnum), rebuild curl now\n";
print "We think $sizeataddr{$addr} bytes are already allocated at that memory address: $addr!\n"; print "We think $sizeataddr{$addr} bytes are already allocated at that memory address: $addr!\n";
} }
$sizeataddr{$addr}=$size; $sizeataddr{$addr} = $size;
$totalmem += $size; $totalmem += $size;
$memsum += $size; $memsum += $size;
@ -169,8 +199,8 @@ while(<$fileh>) {
$size = $1*$2; $size = $1*$2;
$addr = $3; $addr = $3;
$arg1 = $1; my $arg1 = $1;
$arg2 = $2; my $arg2 = $2;
if($sizeataddr{$addr}>0) { if($sizeataddr{$addr}>0) {
# this means weeeeeirdo # this means weeeeeirdo

View file

@ -1722,7 +1722,7 @@ sub singletest_check {
$ok .= "m"; $ok .= "m";
} }
my @more=`$memanalyze -v "$logdir/$MEMDUMP"`; my @more=`$memanalyze -v "$logdir/$MEMDUMP"`;
my $allocs; my $allocs = 0;
my $max = 0; my $max = 0;
for(@more) { for(@more) {
if(/^Allocations: (\d+)/) { if(/^Allocations: (\d+)/) {

View file

@ -26,7 +26,10 @@
# scan manpages to find basic syntactic problems such as unbalanced \f # scan manpages to find basic syntactic problems such as unbalanced \f
# codes or references to non-existing curl manpages. # codes or references to non-existing curl manpages.
my $docsroot = $ARGV[0]; use strict;
use warnings;
my $docsroot = $ARGV[0] || '.';
if(!$docsroot || ($docsroot eq "-g")) { if(!$docsroot || ($docsroot eq "-g")) {
print "Usage: test1140.pl <docs root dir> [manpages]\n"; print "Usage: test1140.pl <docs root dir> [manpages]\n";
@ -40,6 +43,8 @@ my @f = @ARGV;
my %manp; my %manp;
my $errors = 0;
sub manpresent { sub manpresent {
my ($man) = @_; my ($man) = @_;
if($manp{$man}) { if($manp{$man}) {
@ -111,4 +116,4 @@ foreach my $f (@f) {
print "OK\n" if(!$errors); print "OK\n" if(!$errors);
exit $errors?1:0; exit ($errors ? 1 : 0);

View file

@ -27,7 +27,7 @@ use strict;
use warnings; use warnings;
# we may get the dir root pointed out # we may get the dir root pointed out
my $root=$ARGV[0] || "."; my $root = $ARGV[0] || ".";
my %error; # from the include file my %error; # from the include file
my %docs; # from libcurl-errors.3 my %docs; # from libcurl-errors.3

View file

@ -23,11 +23,14 @@
# #
########################################################################### ###########################################################################
use strict;
use warnings;
my $root=$ARGV[0] || ".."; my $root=$ARGV[0] || "..";
my @m = `git ls-files -- $root`; my @m = `git ls-files -- $root`;
my $errors; my $errors = 0;
my %accepted=('curl' => 1, my %accepted=('curl' => 1,
'libcurl' => 1, 'libcurl' => 1,
@ -45,7 +48,7 @@ sub checkfile {
} }
open(my $fh, "<", "$f"); open(my $fh, "<", "$f");
my $l; my $l;
my $prevl; my $prevl = '';
my $ignore = 0; my $ignore = 0;
my $metadata = 0; my $metadata = 0;
while(<$fh>) { while(<$fh>) {

View file

@ -23,13 +23,16 @@
# #
########################################################################### ###########################################################################
use strict;
use warnings;
sub showline { sub showline {
my ($l) = @_; my ($l) = @_;
$l =~ s/([^\x20-\x7f])/sprintf "%%%02x", ord $1/eg; $l =~ s/([^\x20-\x7f])/sprintf "%%%02x", ord $1/eg;
return $l; return $l;
} }
my $root = $ARGV[0]; my $root = $ARGV[0] || '..';
open(my $fh, "-|", "perl $root/lib/optiontable.pl < $root/include/curl/curl.h"); open(my $fh, "-|", "perl $root/lib/optiontable.pl < $root/include/curl/curl.h");
binmode $fh; binmode $fh;

View file

@ -27,6 +27,7 @@
# a late evening in the #curl IRC channel. # a late evening in the #curl IRC channel.
# #
use strict;
use warnings; use warnings;
use vars qw($Cpreprocessor); use vars qw($Cpreprocessor);
use allversions; use allversions;
@ -52,7 +53,7 @@ my $root=$ARGV[0] || ".";
# need an include directory when building out-of-tree # need an include directory when building out-of-tree
my $i = ($ARGV[1]) ? "-I$ARGV[1] " : ''; my $i = ($ARGV[1]) ? "-I$ARGV[1] " : '';
my $error; my $error = 0;
my $versions = $ARGV[2]; my $versions = $ARGV[2];
@ -60,6 +61,8 @@ my @syms;
my %manpage; my %manpage;
my %symadded; my %symadded;
our %pastversion;
sub checkmanpage { sub checkmanpage {
my ($m) = @_; my ($m) = @_;

View file

@ -98,7 +98,7 @@ while(<R>) {
} }
close(R); close(R);
my $error; my $error = 0;
if(scalar(@curlout) != scalar(@txtout)) { if(scalar(@curlout) != scalar(@txtout)) {
printf "curl -h $opt is %d lines, $txt says %d lines\n", printf "curl -h $opt is %d lines, $txt says %d lines\n",
scalar(@curlout), scalar(@txtout); scalar(@curlout), scalar(@txtout);

View file

@ -29,12 +29,19 @@
# $cmddir # $cmddir
# #
use strict;
use warnings;
use allversions; use allversions;
my $opts = $ARGV[0]; my $opts = $ARGV[0];
my $cmddir = $ARGV[1]; my $cmddir = $ARGV[1];
my $versions = $ARGV[2]; my $versions = $ARGV[2];
my %file;
my %oiv;
my $error = 0;
sub cmdfiles { sub cmdfiles {
my ($dir)=@_; my ($dir)=@_;
@ -93,6 +100,8 @@ sub versioncheck {
close($fh); close($fh);
} }
our %pastversion;
# get all the past versions # get all the past versions
allversions($versions); allversions($versions);

View file

@ -61,6 +61,7 @@
# #
use strict; use strict;
use warnings;
use Cwd; use Cwd;
use File::Spec; use File::Spec;
@ -76,6 +77,9 @@ use vars qw($name $email $desc $confopts $runtestopts $setupfile $mktarball
$extvercmd $nogitpull $nobuildconf $crosscompile $extvercmd $nogitpull $nobuildconf $crosscompile
$timestamp $notes); $timestamp $notes);
$notes='';
$runtestopts='';
# version of this script # version of this script
$version='2024-11-28'; $version='2024-11-28';
$fixed=0; $fixed=0;
@ -338,20 +342,20 @@ logit "DESC = $desc";
logit "NOTES = $notes"; logit "NOTES = $notes";
logit "CONFOPTS = $confopts"; logit "CONFOPTS = $confopts";
logit "RUNTESTOPTS = ".$runtestopts; logit "RUNTESTOPTS = ".$runtestopts;
logit "CPPFLAGS = ".$ENV{CPPFLAGS}; logit "CPPFLAGS = ".($ENV{CPPFLAGS} || '');
logit "CFLAGS = ".$ENV{CFLAGS}; logit "CFLAGS = ".($ENV{CFLAGS} || '');
logit "LDFLAGS = ".$ENV{LDFLAGS}; logit "LDFLAGS = ".($ENV{LDFLAGS} || '');
logit "LIBS = ".$ENV{LIBS}; logit "LIBS = ".($ENV{LIBS} || '');
logit "CC = ".$ENV{CC}; logit "CC = ".($ENV{CC} || '');
logit "TMPDIR = ".$ENV{TMPDIR}; logit "TMPDIR = ".($ENV{TMPDIR} || '');
logit "MAKEFLAGS = ".$ENV{MAKEFLAGS}; logit "MAKEFLAGS = ".($ENV{MAKEFLAGS} || '');
logit "ACLOCAL_FLAGS = ".$ENV{ACLOCAL_FLAGS}; logit "ACLOCAL_FLAGS = ".($ENV{ACLOCAL_FLAGS} || '');
logit "PKG_CONFIG_PATH = ".$ENV{PKG_CONFIG_PATH}; logit "PKG_CONFIG_PATH = ".($ENV{PKG_CONFIG_PATH} || '');
logit "DYLD_LIBRARY_PATH = ".$ENV{DYLD_LIBRARY_PATH}; logit "DYLD_LIBRARY_PATH = ".($ENV{DYLD_LIBRARY_PATH} || '');
logit "LD_LIBRARY_PATH = ".$ENV{LD_LIBRARY_PATH}; logit "LD_LIBRARY_PATH = ".($ENV{LD_LIBRARY_PATH} || '');
logit "LIBRARY_PATH = ".$ENV{LIBRARY_PATH}; logit "LIBRARY_PATH = ".($ENV{LIBRARY_PATH} || '');
logit "SHLIB_PATH = ".$ENV{SHLIB_PATH}; logit "SHLIB_PATH = ".($ENV{SHLIB_PATH} || '');
logit "LIBPATH = ".$ENV{LIBPATH}; logit "LIBPATH = ".($ENV{LIBPATH} || '');
logit "target = ".$targetos; logit "target = ".$targetos;
logit "version = $version"; # script version logit "version = $version"; # script version
logit "date = $timestamp"; # When the test build starts logit "date = $timestamp"; # When the test build starts