From: Andrew Dunstan <andrew.dunstan@2ndquadrant.com>
To: Alvaro Herrera <alvherre@2ndquadrant.com>
Cc: Noah Misch <noah@leadboat.com>
Cc: PostgreSQL-development <pgsql-hackers@postgresql.org>
Subject: Re: cleaning perl code
Date: Wed, 15 Apr 2020 15:43:36 -0400
Message-ID: <86b0e20d-efc1-4169-aeb1-be49b3a375ab@2ndQuadrant.com> (raw)
In-Reply-To: <20200414204432.GA22922@alvherre.pgsql>
References: <20200414204432.GA22922@alvherre.pgsql>
On 4/14/20 4:44 PM, Alvaro Herrera wrote:
> On 2020-Apr-14, Andrew Dunstan wrote:
>
>> One of the things that's a bit sad is that perlcritic doesn't generally
>> let you apply policies to a given set of files or files matching some
>> pattern. It would be nice, for instance, to be able to apply some
>> additional standards to strategic library files like PostgresNode.pm,
>> TestLib.pm and Catalog.pm. There are good reasons as suggested upthread
>> to apply higher standards to library files than to, say, a TAP test
>> script. The only easy way I can see to do that would be to have two
>> different perlcriticrc files and adjust pgperlcritic to make two runs.
>> If people think that's worth it I'll put a little work into it. If not,
>> I'll just leave things here.
> I think being more strict about it in strategic files (I'd say that's
> Catalog.pm plus src/test/perl/*.pm) might be a good idea. Maybe give it
> a try and see what comes up.
>
OK, in fact those files are in reasonably good shape. I also took a pass
through the library files in src/tools/msvc, which had a few more issues.
Here's a patch that does the stricter testing for those library files,
and fixes them so we get a clean pass
This brings to an end my perl gardening project.
cheers
andrew
--
Andrew Dunstan https://www.2ndQuadrant.com
PostgreSQL Development, 24x7 Support, Remote DBA, Training & Services
Attachments:pgperlcritic-libraries.patch (text/x-patch, 14.0K) downloaddiff --git a/src/backend/catalog/Catalog.pm b/src/backend/catalog/Catalog.pmindex dd39a086ce..bd9eac0c80 100644--- a/src/backend/catalog/Catalog.pm+++ b/src/backend/catalog/Catalog.pm@@ -67,7 +67,7 @@ sub ParseHeader
if (!$is_client_code)
{
# Strip C-style comments.
- s;/\*(.|\n)*\*/;;g;+ s;/\*(?:.|\n)*\*/;;g;
if (m;/\*;)
{
@@ -260,7 +260,9 @@ sub ParseData
# We're treating the input line as a piece of Perl, so we
# need to use string eval here. Tell perlcritic we know what
# we're doing.
- eval '$hash_ref = ' . $_; ## no critic (ProhibitStringyEval)+ ## no critic (ProhibitStringyEval)+ ## no critic (RequireCheckingReturnValueOfEval)+ eval '$hash_ref = ' . $_;
if (!ref $hash_ref)
{
die "$input_file: error parsing line $.:\n$_\n";
diff --git a/src/test/perl/PostgresNode.pm b/src/test/perl/PostgresNode.pmindex 1d5450758e..5249053ee2 100644--- a/src/test/perl/PostgresNode.pm+++ b/src/test/perl/PostgresNode.pm@@ -385,7 +385,7 @@ sub set_replication_conf
$self->host eq $test_pghost
or croak "set_replication_conf only works with the default host";
- open my $hba, '>>', "$pgdata/pg_hba.conf";+ open my $hba, '>>', "$pgdata/pg_hba.conf" || die;
print $hba "\n# Allow replication (set up by PostgresNode.pm)\n";
if ($TestLib::windows_os && !$TestLib::use_unix_sockets)
{
@@ -439,7 +439,7 @@ sub init
TestLib::system_or_bail($ENV{PG_REGRESS}, '--config-auth', $pgdata,
@{ $params{auth_extra} });
- open my $conf, '>>', "$pgdata/postgresql.conf";+ open my $conf, '>>', "$pgdata/postgresql.conf" || die;
print $conf "\n# Added by PostgresNode.pm\n";
print $conf "fsync = off\n";
print $conf "restart_after_crash = off\n";
@@ -1254,7 +1254,7 @@ END
$node->clean_node if $exit_code == 0 && TestLib::all_tests_passing();
}
- $? = $exit_code;+ $? = $exit_code; ## no critic (RequireLocalizedPunctuationVars)
}
=pod
@@ -1462,8 +1462,8 @@ sub psql
# https://metacpan.org/pod/release/ETHER/Try-Tiny-0.24/lib/Try/Tiny.pm
do
{
- local $@;- eval {+ local $@ = "";+ eval { ## no critic (RequireCheckingReturnValueOfEval)
my @ipcrun_opts = (\@psql_params, '<', \$sql);
push @ipcrun_opts, '>', $stdout if defined $stdout;
push @ipcrun_opts, '2>', $stderr if defined $stderr;
@@ -2074,8 +2074,8 @@ sub pg_recvlogical_upto
do
{
- local $@;- eval {+ local $@ = "";+ eval { ## no critic (RequireCheckingReturnValueOfEval)
IPC::Run::run(\@cmd, ">", \$stdout, "2>", \$stderr, $timeout);
$ret = $?;
};
diff --git a/src/test/perl/TestLib.pm b/src/test/perl/TestLib.pmindex 0e6c4819e4..fd3bbc1979 100644--- a/src/test/perl/TestLib.pm+++ b/src/test/perl/TestLib.pm@@ -162,6 +162,8 @@ INIT
open my $testlog, '>', $test_logfile
or die "could not open STDOUT to logfile \"$test_logfile\": $!";
+ # don't need to check the result of these dup operations+ ## no critic (RequireCheckedOpen)
# Hijack STDOUT and STDERR to the log file
open(my $orig_stdout, '>&', \*STDOUT);
open(my $orig_stderr, '>&', \*STDERR);
@@ -409,7 +411,7 @@ Return the full contents of the specified file.
sub slurp_file
{
my ($filename) = @_;
- local $/;+ local $/ = undef;
my $contents;
if ($Config{osname} ne 'MSWin32')
{
diff --git a/src/tools/msvc/Install.pm b/src/tools/msvc/Install.pmindex e65ac6fc66..34797d97c3 100644--- a/src/tools/msvc/Install.pm+++ b/src/tools/msvc/Install.pm@@ -12,9 +12,8 @@ use File::Basename;
use File::Copy;
use File::Find ();
-use Exporter;-our (@ISA, @EXPORT_OK);-@ISA = qw(Exporter);+use Exporter qw(import);+our (@EXPORT_OK);
@EXPORT_OK = qw(Install);
my $insttype;
@@ -45,7 +44,7 @@ sub lcopy
sub Install
{
- $| = 1;+ STDOUT->autoflush(1);
my $target = shift;
$insttype = shift;
@@ -56,9 +55,8 @@ sub Install
our $config = shift;
unless ($config)
{
-
# suppress warning about harmless redeclaration of $config
- no warnings 'misc';+ no warnings 'misc'; ## no critic (ProhibitNoWarnings)
do "./config_default.pl";
do "./config.pl" if (-f "config.pl");
}
@@ -158,7 +156,7 @@ sub Install
File::Find::find(
{
wanted => sub {
- /^(.*--.*\.sql|.*\.control)\z/s+ /^(?:.*--.*\.sql|.*\.control)\z/s
&& push(@$pl_extension_files, $File::Find::name);
# Don't find files of in-tree temporary installations.
diff --git a/src/tools/msvc/MSBuildProject.pm b/src/tools/msvc/MSBuildProject.pmindex ebb169e201..aaa3d573ab 100644--- a/src/tools/msvc/MSBuildProject.pm+++ b/src/tools/msvc/MSBuildProject.pm@@ -1,3 +1,6 @@++## no critic (ProhibitMultiplePackages,ProhibitUnusedPrivateSubroutines)+
package MSBuildProject;
#
@@ -11,7 +14,7 @@ use strict;
use warnings;
use base qw(Project);
-no warnings qw(redefine); ## no critic+no warnings qw(redefine); ## no critic (ProhibitNoWarnings)
sub _new
{
@@ -145,8 +148,11 @@ EOF
{
confess "Bad format filename '$fileNameWithPath'\n"
unless ($fileNameWithPath =~ m!^(.*)/([^/]+)\.(c|cpp|y|l|rc)$!);
+ # perlcritic is a bit stupid here+ ## no critic (ProhibitCaptureWithoutTest)
my $dir = $1;
my $fileName = $2;
+ ## use critic
if ($fileNameWithPath =~ /\.y$/ or $fileNameWithPath =~ /\.l$/)
{
push @grammarFiles, $fileNameWithPath;
@@ -415,7 +421,7 @@ use strict;
use warnings;
use base qw(MSBuildProject);
-no warnings qw(redefine); ## no critic+no warnings qw(redefine); ## no critic (ProhibitNoWarnings)
sub new
{
@@ -440,7 +446,7 @@ use strict;
use warnings;
use base qw(MSBuildProject);
-no warnings qw(redefine); ## no critic+no warnings qw(redefine); ## no critic (ProhibitNoWarnings)
sub new
{
@@ -465,7 +471,7 @@ use strict;
use warnings;
use base qw(MSBuildProject);
-no warnings qw(redefine); ## no critic+no warnings qw(redefine); ## no critic (ProhibitNoWarnings)
sub new
{
@@ -490,7 +496,7 @@ use strict;
use warnings;
use base qw(MSBuildProject);
-no warnings qw(redefine); ## no critic+no warnings qw(redefine); ## no critic (ProhibitNoWarnings)
sub new
{
diff --git a/src/tools/msvc/Mkvcbuild.pm b/src/tools/msvc/Mkvcbuild.pmindex 72a21dbd41..7f67c3582f 100644--- a/src/tools/msvc/Mkvcbuild.pm+++ b/src/tools/msvc/Mkvcbuild.pm@@ -18,9 +18,8 @@ use Config;
use VSObjectFactory;
use List::Util qw(first);
-use Exporter;-our (@ISA, @EXPORT_OK);-@ISA = qw(Exporter);+use Exporter qw(import);+our (@EXPORT_OK);
@EXPORT_OK = qw(Mkvcbuild);
my $solution;
@@ -106,9 +105,9 @@ sub mkvcbuild
sprompt.c strerror.c tar.c thread.c
win32env.c win32error.c win32security.c win32setlocale.c);
- push(@pgportfiles, 'strtof.c') if ($vsVersion < '14.00');+ push(@pgportfiles, 'strtof.c') if ($vsVersion < 14.00);- if ($vsVersion >= '9.00')+ if ($vsVersion >= 9.00)
{
push(@pgportfiles, 'pg_crc32c_sse42_choose.c');
push(@pgportfiles, 'pg_crc32c_sse42.c');
@@ -212,7 +211,7 @@ sub mkvcbuild
$snowball->RelocateFiles(
'src/backend/snowball/libstemmer',
sub {
- return shift !~ /(dict_snowball.c|win32ver.rc)$/;+ return shift !~ /(?:dict_snowball.c|win32ver.rc)$/;
});
$snowball->AddIncludeDir('src/include/snowball');
$snowball->AddReference($postgres);
@@ -598,6 +597,7 @@ sub mkvcbuild
unlink $source_file;
open my $o, '>', $source_file
|| croak "Could not write to $source_file";
+ ## no critic (ProhibitHardTabs)
print $o '
/* compare to plperl.h */
#define __inline__ __inline
@@ -627,6 +627,7 @@ sub mkvcbuild
}
}
';
+ ## use critic
close $o;
# Build $source_file with a given #define, and return a true value
@@ -649,8 +650,7 @@ sub mkvcbuild
# Some builds exhibit runtime failure through Perl warning
# 'Can't spawn "conftest.exe"'; suppress that.
- no warnings;-+ no warnings; ## no critic (ProhibitNoWarnings)
no strict 'subs'; ## no critic (ProhibitNoStrict)
# Disable error dialog boxes like we do in the postmaster.
diff --git a/src/tools/msvc/Project.pm b/src/tools/msvc/Project.pmindex 20f79b382b..c2e82960aa 100644--- a/src/tools/msvc/Project.pm+++ b/src/tools/msvc/Project.pm@@ -10,7 +10,7 @@ use strict;
use warnings;
use File::Basename;
-sub _new+sub _new ## no critic (ProhibitUnusedPrivateSubroutines)
{
my ($classname, $name, $type, $solution) = @_;
my $good_types = {
@@ -278,6 +278,8 @@ sub AddDir
my @pieces = split /\s+/, $match;
foreach my $fn (@pieces)
{
+ # Deliberately ignore errors from ReplaceFile about files not found+ ## no critic (RequireCheckingReturnValueOfEval)
if ($top eq "(top_srcdir)")
{
eval { $self->ReplaceFile($fn, $target) };
diff --git a/src/tools/msvc/Solution.pm b/src/tools/msvc/Solution.pmindex 545bdcef7b..d9550c3e9e 100644--- a/src/tools/msvc/Solution.pm+++ b/src/tools/msvc/Solution.pm@@ -1,3 +1,6 @@++## no critic (ProhibitMultiplePackages,ProhibitUnusedPrivateSubroutines)+
package Solution;
#
@@ -10,7 +13,7 @@ use strict;
use warnings;
use VSObjectFactory;
-no warnings qw(redefine); ## no critic+no warnings qw(redefine); ## no critic (ProhibitNoWarnings)
sub _new
{
@@ -157,20 +160,22 @@ sub GenerateFiles
|| confess("Could not open configure.in for reading\n");
while (<$c>)
{
- if (/^AC_INIT\(\[([^\]]+)\], \[([^\]]+)\], \[([^\]]+)\], \[([^\]]*)\], \[([^\]]+)\]/)+ if (/^AC_INIT\(\[([^\]]+)\], \[([^\]]+)\], \[([^\]]+)\], \[(?:[^\]]*)\], \[([^\]]+)\]/)
{
$ac_init_found = 1;
$package_name = $1;
$package_version = $2;
$package_bugreport = $3;
- #$package_tarname = $4;- $package_url = $5;+ #$package_tarname = non-capturing-group;+ $package_url = $4;
if ($package_version !~ /^(\d+)(?:\.(\d+))?/)
{
confess "Bad format of version: $self->{strver}\n";
}
+ # perlcritic is a bit stupid here+ ## no critic (ProhibitCaptureWithoutTest)
$majorver = sprintf("%d", $1);
$minorver = sprintf("%d", $2 ? $2 : 0);
}
@@ -519,7 +524,7 @@ sub GenerateFiles
my ($digit1, $digit2, $digit3) = $self->GetOpenSSLVersion();
# More symbols are needed with OpenSSL 1.1.0 and above.
- if ($digit1 >= '1' && $digit2 >= '1' && $digit3 >= '0')+ if ($digit1 >= 1 && $digit2 >= 1 && $digit3 >= 0)
{
$define{HAVE_ASN1_STRING_GET0_DATA} = 1;
$define{HAVE_BIO_GET_DATA} = 1;
@@ -931,7 +936,7 @@ sub AddProject
# changed their library names from:
# - libeay to libcrypto
# - ssleay to libssl
- if ($digit1 >= '1' && $digit2 >= '1' && $digit3 >= '0')+ if ($digit1 >= 1 && $digit2 >= 1 && $digit3 >= 0)
{
my $dbgsuffix;
my $libsslpath;
@@ -1166,7 +1171,7 @@ use strict;
use warnings;
use base qw(Solution);
-no warnings qw(redefine); ## no critic+no warnings qw(redefine); ## no critic (ProhibitNoWarnings)
sub new
{
@@ -1194,7 +1199,7 @@ use strict;
use warnings;
use base qw(Solution);
-no warnings qw(redefine); ## no critic+no warnings qw(redefine); ## no critic (ProhibitNoWarnings)
sub new
{
@@ -1222,7 +1227,7 @@ use strict;
use warnings;
use base qw(Solution);
-no warnings qw(redefine); ## no critic+no warnings qw(redefine); ## no critic (ProhibitNoWarnings)
sub new
{
@@ -1250,7 +1255,7 @@ use strict;
use warnings;
use base qw(Solution);
-no warnings qw(redefine); ## no critic+no warnings qw(redefine); ## no critic (ProhibitNoWarnings)
sub new
{
diff --git a/src/tools/msvc/VSObjectFactory.pm b/src/tools/msvc/VSObjectFactory.pmindex e6983b241f..dd8cc4952e 100644--- a/src/tools/msvc/VSObjectFactory.pm+++ b/src/tools/msvc/VSObjectFactory.pm@@ -1,3 +1,6 @@++## no critic (ProhibitMultiplePackages)+
package VSObjectFactory;
#
@@ -10,16 +13,15 @@ use Carp;
use strict;
use warnings;
-use Exporter;+use Exporter qw(import);
use Project;
use Solution;
use MSBuildProject;
-our (@ISA, @EXPORT);-@ISA = qw(Exporter);+our (@EXPORT);
@EXPORT = qw(CreateSolution CreateProject DetermineVisualStudioVersion);
-no warnings qw(redefine); ## no critic+no warnings qw(redefine); ## no critic (ProhibitNoWarnings)
sub CreateSolution
{
diff --git a/src/tools/perlcheck/perlcriticrc b/src/tools/perlcheck/perlcriticrcindex e230111b23..27b4af1892 100644--- a/src/tools/perlcheck/perlcriticrc+++ b/src/tools/perlcheck/perlcriticrc@@ -22,3 +22,30 @@ verbose = %f: %m at line %l, column %c. %e. ([%p] Severity: %s)\n
# insist on use of the warnings pragma
[TestingAndDebugging::RequireUseWarnings]
severity = 5
+++# sev 4+[-Modules::ProhibitAutomaticExportation]+[-InputOutput::RequireBriefOpen]+[-Subroutines::RequireArgUnpacking]+[Variables::RequireLocalizedPunctuationVars]+allow = %ENV %SIG+[-Objects::ProhibitIndirectSyntax]+[TestingAndDebugging::ProhibitProlongedStrictureOverride]+statements = 10+[-BuiltinFunctions::RequireBlockGrep]+[TestingAndDebugging::ProhibitNoWarnings]+allow = once++# sev 3+[-ErrorHandling::RequireCarping]+[-RegularExpressions::RequireExtendedFormatting]+[-Variables::ProhibitPackageVars]+[-ControlStructures::ProhibitCascadingIfElse]+[-Subroutines::ProhibitExcessComplexity]+[-ValuesAndExpressions::ProhibitImplicitNewlines]+[-Subroutines::ProhibitManyArgs]+[-InputOutput::ProhibitBacktickOperators]+[-BuiltinFunctions::ProhibitLvalueSubstr]+[-ValuesAndExpressions::RequireQuotedHeredocTerminator]+[-RegularExpressions::ProhibitComplexRegexes]diff --git a/src/tools/perlcheck/pgperlcritic b/src/tools/perlcheck/pgperlcriticindex 1c2f787580..08edd86427 100755--- a/src/tools/perlcheck/pgperlcritic+++ b/src/tools/perlcheck/pgperlcritic@@ -14,7 +14,21 @@ PERLCRITIC=${PERLCRITIC:-perlcritic}
. src/tools/perlcheck/find_perl_files
-find_perl_files | xargs $PERLCRITIC \+flist=`mktemp`+find_perl_files > $flist++pattern='src/test/perl/|src/backend/catalog/Catalog.pm|src/tools/msvc/[^/]*.pm'++# normal sev 5 critic+egrep -v "$pattern" < $flist | xargs $PERLCRITIC \
--quiet \
--program-extensions .pl \
--profile=src/tools/perlcheck/perlcriticrc
++# more strict sev 3 critic for some library files+egrep "$pattern" < $flist | xargs $PERLCRITIC --severity 3 \+ --quiet \+ --program-extensions .pl \+ --profile=src/tools/perlcheck/perlcriticrc++rm -f $flist
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Reply to all the recipients using the --to and --cc options:
reply via email
To: pgsql-hackers@postgresql.org
Cc: andrew.dunstan@2ndquadrant.com, alvherre@2ndquadrant.com, noah@leadboat.com
Subject: Re: cleaning perl code
In-Reply-To: <86b0e20d-efc1-4169-aeb1-be49b3a375ab@2ndQuadrant.com>
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
This inbox is served by DDX for PostgreSQL; see mirroring instructions
for how to clone and mirror all data and code used for this inbox