mirror of
https://github.com/curl/curl.git
synced 2026-07-23 20:17:15 +03:00
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
parent
89771d19d5
commit
2ec54556d4
45 changed files with 323 additions and 97 deletions
|
|
@ -36,13 +36,16 @@ Example: cd2cd [--in-place] <file.md> > <file.md>
|
|||
=end comment
|
||||
=cut
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
my $cd2cd = "0.1"; # to keep check
|
||||
my $dir;
|
||||
my $extension;
|
||||
my $inplace = 0;
|
||||
|
||||
while(1) {
|
||||
if($ARGV[0] eq "--in-place") {
|
||||
if(@ARGV && $ARGV[0] eq "--in-place") {
|
||||
shift @ARGV;
|
||||
$inplace = 1;
|
||||
}
|
||||
|
|
@ -84,6 +87,9 @@ sub single {
|
|||
my $start = 0;
|
||||
my $d;
|
||||
my $line = 0;
|
||||
my $salist = 0;
|
||||
my $copyright;
|
||||
my $spdx;
|
||||
open(F, "<:crlf", "$f") ||
|
||||
return 1;
|
||||
while(<F>) {
|
||||
|
|
@ -221,6 +227,6 @@ if($inplace) {
|
|||
single($a);
|
||||
}
|
||||
}
|
||||
else {
|
||||
elsif(@ARGV) {
|
||||
exit single($ARGV[0]);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -25,6 +25,9 @@
|
|||
|
||||
# provide all dir names to scan on the cmdline
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
sub convert {
|
||||
my ($dir)=@_;
|
||||
opendir(my $dh, $dir) || die "could not open $dir";
|
||||
|
|
|
|||
|
|
@ -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
|
||||
# check for and use this feature without the configure flag
|
||||
my %defaulton = (
|
||||
|
|
|
|||
|
|
@ -23,6 +23,9 @@
|
|||
#
|
||||
###########################################################################
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
my %filelevel= ('file' => 1,
|
||||
'service' => 1);
|
||||
|
||||
|
|
@ -39,6 +42,8 @@ sub submit {
|
|||
}
|
||||
}
|
||||
|
||||
my %job;
|
||||
|
||||
sub githubactions {
|
||||
my ($tag)=@_;
|
||||
my @files= `git ls-tree -r --name-only $tag .github/workflows 2>/dev/null`;
|
||||
|
|
@ -341,6 +346,8 @@ sub circle {
|
|||
my $cmds;
|
||||
my $jobs;
|
||||
my $workflow;
|
||||
my $cmdname;
|
||||
my $jobname;
|
||||
$job{'file'} = ".circleci/config.yml";
|
||||
$job{'service'} = "circleci";
|
||||
while(<G>) {
|
||||
|
|
@ -408,6 +415,10 @@ sub zuul {
|
|||
my %job;
|
||||
my $line=0;
|
||||
my $type;
|
||||
my $jobmode;
|
||||
my $apt = 0;
|
||||
my $env = 0;
|
||||
my $envcont;
|
||||
$job{'file'} = "zuul.d/jobs.yaml";
|
||||
$job{'service'} = "zuul";
|
||||
while(<G>) {
|
||||
|
|
|
|||
|
|
@ -30,6 +30,9 @@
|
|||
#
|
||||
# In the git clone root, invoke 'scripts/delta [release tag]'
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
$start = $ARGV[0];
|
||||
|
||||
if($start eq "-h") {
|
||||
|
|
|
|||
|
|
@ -23,6 +23,12 @@
|
|||
#
|
||||
###########################################################################
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
my @proto;
|
||||
my %inc;
|
||||
|
||||
sub scanfile {
|
||||
my ($file) = @_;
|
||||
open(F, "<$file") || die "$file failed";
|
||||
|
|
|
|||
|
|
@ -39,6 +39,9 @@ Unfortunately it seems some perls like msysgit cannot handle a global input-only
|
|||
=end comment
|
||||
=cut
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
my %optshort;
|
||||
my %optlong;
|
||||
my %helplong;
|
||||
|
|
@ -65,7 +68,7 @@ my $indent = 4;
|
|||
sub manpageify {
|
||||
my ($k)=@_;
|
||||
my $l;
|
||||
my $trail;
|
||||
my $trail = '';
|
||||
# the matching pattern might include a trailing dot that cannot be part of
|
||||
# the option name
|
||||
if($k =~ s/\.$//) {
|
||||
|
|
@ -127,8 +130,10 @@ sub justline {
|
|||
|
||||
sub lastline {
|
||||
my ($lvl, @line) = @_;
|
||||
my $l = 0;
|
||||
$line[0] =~ s/^( +)//;
|
||||
prefixline($lvl * $indent + length($1));
|
||||
$l = length($1) if($1);
|
||||
prefixline($lvl * $indent + $l);
|
||||
my $prev = 0;
|
||||
for(@line) {
|
||||
printf "%s%s", $prev?" ":"", $_;
|
||||
|
|
@ -174,9 +179,11 @@ sub printdesc {
|
|||
}
|
||||
else {
|
||||
my $p = -1;
|
||||
my $para;
|
||||
my $pnum;
|
||||
my $para = '';
|
||||
for my $l (@desc) {
|
||||
my $lvl;
|
||||
my $lvl = 0;
|
||||
my $lvlnum;
|
||||
if($l !~ /^[\n\r]+/) {
|
||||
# get the indent level off the string
|
||||
$l =~ s/^\[([0-9q]*)\]//;
|
||||
|
|
@ -186,15 +193,19 @@ sub printdesc {
|
|||
# the previous was quoted, this is not
|
||||
print "\n";
|
||||
}
|
||||
if($lvl != $p) {
|
||||
outputpara($baselvl + $p, $para);
|
||||
if($lvl ne $p) {
|
||||
$pnum = $p;
|
||||
$pnum =~ s/q$//;
|
||||
outputpara($baselvl + $pnum, $para);
|
||||
$para = "";
|
||||
}
|
||||
if($lvl =~ /q/) {
|
||||
# quoted, do not right-justify
|
||||
chomp $l;
|
||||
lastline($baselvl + $lvl + 1, $l);
|
||||
my $w = ($baselvl + $lvl + 1) * $indent + length($l);
|
||||
$lvlnum = $lvl;
|
||||
$lvlnum =~ s/q$//;
|
||||
lastline($baselvl + $lvlnum + 1, $l);
|
||||
my $w = ($baselvl + $lvlnum + 1) * $indent + length($l);
|
||||
if($w > $colwidth) {
|
||||
print STDERR "ERROR: $w columns is too long\n";
|
||||
print STDERR "$l\n";
|
||||
|
|
@ -207,7 +218,9 @@ sub printdesc {
|
|||
|
||||
$p = $lvl;
|
||||
}
|
||||
outputpara($baselvl + $p, $para);
|
||||
$pnum = $p;
|
||||
$pnum =~ s/q$//;
|
||||
outputpara($baselvl + $pnum, $para);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -281,10 +294,11 @@ sub render {
|
|||
my $header = 0;
|
||||
# if $top is TRUE, it means a top-level page and not a command line option
|
||||
my $top = ($line == 1);
|
||||
my $quote;
|
||||
my $level;
|
||||
my $quote = 0;
|
||||
my $level = 0;
|
||||
my $finalblank;
|
||||
$start = 0;
|
||||
my $blankline = 0;
|
||||
my $start = 0;
|
||||
|
||||
while(<$fh>) {
|
||||
my $d = $_;
|
||||
|
|
@ -575,7 +589,7 @@ sub single {
|
|||
$protocols=$1;
|
||||
}
|
||||
elsif(/^See-also: +(.+)/i) {
|
||||
if($seealso) {
|
||||
if(@seealso) {
|
||||
print STDERR "ERROR: duplicated See-also in $f\n";
|
||||
return 1;
|
||||
}
|
||||
|
|
@ -666,10 +680,6 @@ sub single {
|
|||
|
||||
my @desc = render($manpage, $fh, $f, $line);
|
||||
close($fh);
|
||||
if($tablemode) {
|
||||
# end of table
|
||||
push @desc, ".RE\n.IP\n";
|
||||
}
|
||||
my $opt;
|
||||
|
||||
if(defined($short) && $long) {
|
||||
|
|
@ -802,7 +812,7 @@ sub single {
|
|||
my @m=split(/ /, $mutexed);
|
||||
my $mstr;
|
||||
my $num = scalar(@m);
|
||||
my $count;
|
||||
my $count = 0;
|
||||
for my $k (@m) {
|
||||
if(!$helplong{$k}) {
|
||||
print STDERR "WARN: $f mutexes a non-existing option: $k\n";
|
||||
|
|
@ -876,13 +886,13 @@ sub single {
|
|||
push @foot, seealso($standalone, $mstr);
|
||||
|
||||
print "\n";
|
||||
my $f = join("", @foot);
|
||||
my $ft = join("", @foot);
|
||||
if($manpage) {
|
||||
$f =~ s/ +\z//; # remove trailing space
|
||||
print "$f\n";
|
||||
$ft =~ s/ +\z//; # remove trailing space
|
||||
print "$ft\n";
|
||||
}
|
||||
else {
|
||||
printdesc($manpage, 2, "[1]$f");
|
||||
printdesc($manpage, 2, "[1]$ft");
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
|
@ -950,8 +960,8 @@ sub getshortlong {
|
|||
|
||||
sub indexoptions {
|
||||
my ($dir, @files) = @_;
|
||||
foreach my $f (@files) {
|
||||
getshortlong($dir, $f);
|
||||
foreach my $file (@files) {
|
||||
getshortlong($dir, $file);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -1122,7 +1132,6 @@ sub listglobals {
|
|||
}
|
||||
close(F);
|
||||
}
|
||||
return $ret if($ret);
|
||||
for my $e (0 .. $#globalopts) {
|
||||
$globals .= sprintf "%s--%s", $e?($globalopts[$e+1] ? ", " : " and "):"",
|
||||
$globalopts[$e],;
|
||||
|
|
@ -1257,7 +1266,7 @@ sub getargs {
|
|||
|
||||
my $dir = ".";
|
||||
my $include = "../../include";
|
||||
my $cmd = shift @ARGV;
|
||||
my $cmd = shift @ARGV || '';
|
||||
|
||||
check:
|
||||
if($cmd eq "-d") {
|
||||
|
|
|
|||
|
|
@ -23,6 +23,9 @@
|
|||
#
|
||||
###########################################################################
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
my %whitelist = (
|
||||
'https://curl.se/' => 1,
|
||||
'https://curl.se/changes.html' => 1,
|
||||
|
|
@ -70,6 +73,9 @@ my %whitelist = (
|
|||
|
||||
);
|
||||
|
||||
my %url;
|
||||
my %flink;
|
||||
|
||||
# list all .md files in the repo
|
||||
my @files=`git ls-files '**.md'`;
|
||||
|
||||
|
|
@ -127,6 +133,7 @@ sub checkurl {
|
|||
|
||||
print "check $url\n";
|
||||
my $curlcmd="curl -ILfsm10 --retry 2 --retry-delay 5 -A \"Mozilla/curl.se link-probe\"";
|
||||
$url =~ s/\+/%2B/g;
|
||||
my @content = `$curlcmd \"$url\"`;
|
||||
if(!$content[0]) {
|
||||
print STDERR "FAIL\n";
|
||||
|
|
@ -146,7 +153,7 @@ for my $u (sort keys %url) {
|
|||
my $r = checkurl($u);
|
||||
|
||||
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;
|
||||
$error++;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -36,6 +36,9 @@ for code.
|
|||
=end comment
|
||||
=cut
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
my $nroff2cd = "0.1"; # to keep check
|
||||
|
||||
sub single {
|
||||
|
|
@ -189,4 +192,6 @@ HEAD
|
|||
return !$header;
|
||||
}
|
||||
|
||||
exit single($ARGV[0]);
|
||||
if(@ARGV) {
|
||||
exit single($ARGV[0]);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -20,8 +20,13 @@
|
|||
# - edit the @tls array to include all TLS backends you can build with
|
||||
# - do a checkout in a ram-based filesystem
|
||||
#
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use List::Util qw/shuffle/;
|
||||
|
||||
my @disable;
|
||||
|
||||
sub getoptions {
|
||||
my @all = `./configure --help`;
|
||||
for my $o (@all) {
|
||||
|
|
|
|||
|
|
@ -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 @releasenotes=`cat RELEASE-NOTES`;
|
||||
|
||||
|
|
@ -120,6 +123,12 @@ sub extract {
|
|||
# false alarm, not a valid line
|
||||
}
|
||||
|
||||
my @fixes;
|
||||
my @closes;
|
||||
my @bug;
|
||||
my @line;
|
||||
my %moreinfo;
|
||||
|
||||
my $short;
|
||||
my $first;
|
||||
for my $l (@gitlog) {
|
||||
|
|
@ -167,7 +176,7 @@ if($first) {
|
|||
# call at the end of a parsed commit
|
||||
sub onecommit {
|
||||
my ($short)=@_;
|
||||
my $ref;
|
||||
my $ref = '';
|
||||
|
||||
if($dupe{$short}) {
|
||||
# this git commit message was found in the file
|
||||
|
|
|
|||
|
|
@ -33,13 +33,16 @@
|
|||
# --unit : built to support unit tests
|
||||
#
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
my $unittests;
|
||||
if($ARGV[0] eq "--unit") {
|
||||
if(@ARGV && $ARGV[0] eq "--unit") {
|
||||
$unittests = "tests/unit ";
|
||||
shift @ARGV;
|
||||
}
|
||||
|
||||
my $file = $ARGV[0];
|
||||
my $file = $ARGV[0] || '';
|
||||
|
||||
my %wl = (
|
||||
'Curl_xfer_write_resp' => 'internal api',
|
||||
|
|
@ -178,7 +181,6 @@ open(N, "nm $file|") ||
|
|||
|
||||
my %exist;
|
||||
my %uses;
|
||||
my $file;
|
||||
while(<N>) {
|
||||
my $l = $_;
|
||||
chomp $l;
|
||||
|
|
@ -204,7 +206,7 @@ while(<N>) {
|
|||
}
|
||||
close(N);
|
||||
|
||||
my $err;
|
||||
my $err = 0;
|
||||
for(sort keys %exist) {
|
||||
#printf "%s is defined in %s, used by: %s\n", $_, $exist{$_}, $uses{$_};
|
||||
if(!$uses{$_}) {
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue