From: Viktor Szakats Date: Wed, 24 Sep 2025 23:54:28 +0000 (+0200) Subject: perlcheck: add script, run in CI, fix fallouts X-Git-Tag: rc-8_17_0-1~216 X-Git-Url: http://git.ipfire.org/gitweb.cgi?a=commitdiff_plain;h=34b1e146e42f2dbac5c89414a2a0458a8729a255;p=thirdparty%2Fcurl.git perlcheck: add script, run in CI, fix fallouts Add script to run all Perl sources through `perl -c` to ensure no issues, and run this script via GHA/checksrc in CI. Fallouts: - fix two repeated declarations. - move `shell_quote()` from `testutil.pm` to `pathhelp.pm`, to avoid circular dependency in `globalconfig.pm`. Closes #18745 --- diff --git a/.github/workflows/checksrc.yml b/.github/workflows/checksrc.yml index b101a822c5..71ee031d68 100644 --- a/.github/workflows/checksrc.yml +++ b/.github/workflows/checksrc.yml @@ -82,6 +82,10 @@ jobs: source ~/venv/bin/activate scripts/cmakelint.sh + - name: 'perlcheck' + run: | + scripts/perlcheck.sh + - name: 'pytype' run: | source ~/venv/bin/activate diff --git a/scripts/Makefile.am b/scripts/Makefile.am index cfa3d3e740..a52581155d 100644 --- a/scripts/Makefile.am +++ b/scripts/Makefile.am @@ -25,7 +25,8 @@ EXTRA_DIST = coverage.sh completion.pl firefox-db2pem.sh checksrc.pl checksrc-all.pl \ mk-ca-bundle.pl mk-unity.pl schemetable.c cd2nroff nroff2cd cdall cd2cd managen \ dmaketgz maketgz release-tools.sh verify-release cmakelint.sh mdlinkcheck \ - CMakeLists.txt pythonlint.sh randdisable wcurl top-complexity extract-unit-protos + CMakeLists.txt perlcheck.sh pythonlint.sh randdisable wcurl top-complexity \ + extract-unit-protos dist_bin_SCRIPTS = wcurl diff --git a/scripts/perlcheck.sh b/scripts/perlcheck.sh new file mode 100755 index 0000000000..be0c0e1c87 --- /dev/null +++ b/scripts/perlcheck.sh @@ -0,0 +1,47 @@ +#!/bin/sh +#*************************************************************************** +# _ _ ____ _ +# Project ___| | | | _ \| | +# / __| | | | |_) | | +# | (__| |_| | _ <| |___ +# \___|\___/|_| \_\_____| +# +# Copyright (C) Dan Fandrich, , Viktor Szakats, 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 +# +########################################################################### + +# The xargs invocation is portable, but does not preserve spaces in file names. +# If such a file is ever added, then this can be portably fixed by switching to +# "xargs -I{}" and appending {} to the end of the xargs arguments (which will +# call cmakelint once per file) or by using the GNU extension "xargs -d'\n'". + +set -eu + +cd "$(dirname "$0")"/.. + +{ + if [ -n "${1:-}" ]; then + for A in "$@"; do printf "%s\n" "$A"; done + elif git rev-parse --is-inside-work-tree >/dev/null 2>&1; then + { + git ls-files | grep -E '\.(pl|pm)$' + git grep -l -E '^#!/usr/bin/env perl' + } | sort -u + else + # strip off the leading ./ to make the grep regexes work properly + find . -type f \( -name '*.pl' -o -name '*.pm' \) | sed 's@^\./@@' + fi +} | xargs -n 1 perl -c -Itests diff --git a/tests/globalconfig.pm b/tests/globalconfig.pm index de9abab34c..8635dea55b 100644 --- a/tests/globalconfig.pm +++ b/tests/globalconfig.pm @@ -78,11 +78,9 @@ BEGIN { use pathhelp qw( exe_ext dirsepadd - ); -use Cwd qw(getcwd); -use testutil qw( shell_quote ); +use Cwd qw(getcwd); use File::Spec; diff --git a/tests/pathhelp.pm b/tests/pathhelp.pm index 1695825188..49987f7453 100644 --- a/tests/pathhelp.pm +++ b/tests/pathhelp.pm @@ -60,6 +60,7 @@ BEGIN { os_is_win exe_ext dirsepadd + shell_quote sys_native_abs_path sys_native_current_path build_sys_abs_path @@ -192,4 +193,23 @@ sub dirsepadd { return $dir . '/'; } +####################################################################### +# Quote an argument for passing safely to a Bourne shell +# This does the same thing as String::ShellQuote but doesn't need a package. +# +sub shell_quote { + my ($s)=@_; + if($^O eq 'MSWin32') { + $s = '"' . $s . '"'; + } + else { + if($s !~ m/^[-+=.,_\/:a-zA-Z0-9]+$/) { + # string contains a "dangerous" character--quote it + $s =~ s/'/'"'"'/g; + $s = "'" . $s . "'"; + } + } + return $s; +} + 1; # End of module diff --git a/tests/runner.pm b/tests/runner.pm index 62f722f319..1eef1f5b9d 100644 --- a/tests/runner.pm +++ b/tests/runner.pm @@ -84,6 +84,7 @@ use Storable qw( use pathhelp qw( exe_ext + shell_quote ); use servers qw( checkcmd @@ -100,7 +101,6 @@ use testutil qw( logmsg runclient exerunner - shell_quote subbase64 subsha256base64file substrippemfile diff --git a/tests/runtests.pl b/tests/runtests.pl index 6b6e5b0761..d836841a29 100755 --- a/tests/runtests.pl +++ b/tests/runtests.pl @@ -91,6 +91,7 @@ use serverhelp qw( use pathhelp qw( exe_ext sys_native_current_path + shell_quote ); use appveyor; diff --git a/tests/servers.pm b/tests/servers.pm index e625058870..e5505886f6 100644 --- a/tests/servers.pm +++ b/tests/servers.pm @@ -105,6 +105,7 @@ use pathhelp qw( os_is_win build_sys_abs_path sys_native_abs_path + shell_quote ); use processhelp; @@ -114,7 +115,6 @@ use testutil qw( runclient runclientoutput exerunner - shell_quote ); diff --git a/tests/test745.pl b/tests/test745.pl index faddda429f..4395eb9681 100755 --- a/tests/test745.pl +++ b/tests/test745.pl @@ -45,7 +45,8 @@ sub gettypecheck { } sub getinclude { - open(my $f, "<", "$root/include/curl/curl.h") + my $f; + open($f, "<", "$root/include/curl/curl.h") || die "no curl.h"; while(<$f>) { if($_ =~ /\((CURLOPT[^,]*), (CURLOPTTYPE_[^,]*)/) { @@ -61,7 +62,7 @@ sub getinclude { $enum{"CURLOPT_CONV_TO_NETWORK_FUNCTION"}++; close($f); - open(my $f, "<", "$root/include/curl/multi.h") + open($f, "<", "$root/include/curl/multi.h") || die "no curl.h"; while(<$f>) { if($_ =~ /\((CURLMOPT[^,]*), (CURLOPTTYPE_[^,]*)/) { diff --git a/tests/testcurl.pl b/tests/testcurl.pl index 8d6183102b..4f3eade703 100755 --- a/tests/testcurl.pl +++ b/tests/testcurl.pl @@ -584,8 +584,10 @@ if(-f "./libcurl.pc") { } } +my $f; + logit_spaced "display lib/$confheader"; -open(my $f, "<", "lib/$confheader") or die "lib/$confheader: $!"; +open($f, "<", "lib/$confheader") or die "lib/$confheader: $!"; while(<$f>) { print if /^ *#/; } @@ -660,7 +662,7 @@ if(($have_embedded_ares) && my $mkcmd = "$make -i" . ($targetos && !$configurebuild ? " $targetos" : ""); logit "$mkcmd"; -open(my $f, "-|", "$mkcmd 2>&1") or die; +open($f, "-|", "$mkcmd 2>&1") or die; while(<$f>) { s/$pwd//g; print; diff --git a/tests/testutil.pm b/tests/testutil.pm index e84cc45fde..3477d5bb57 100644 --- a/tests/testutil.pm +++ b/tests/testutil.pm @@ -38,7 +38,6 @@ BEGIN { runclientoutput setlogfunc exerunner - shell_quote subbase64 subnewlines subsha256base64file @@ -219,25 +218,6 @@ sub exerunner { return ''; } -####################################################################### -# Quote an argument for passing safely to a Bourne shell -# This does the same thing as String::ShellQuote but doesn't need a package. -# -sub shell_quote { - my ($s)=@_; - if($^O eq 'MSWin32') { - $s = '"' . $s . '"'; - } - else { - if($s !~ m/^[-+=.,_\/:a-zA-Z0-9]+$/) { - # string contains a "dangerous" character--quote it - $s =~ s/'/'"'"'/g; - $s = "'" . $s . "'"; - } - } - return $s; -} - sub get_sha256_base64 { my ($file_path) = @_; return encode_base64(sha256(do { local $/; open my $fh, '<:raw', $file_path or die $!; <$fh> }), "");