cleaning perl code
We currently only run perlcritic at severity level 5, which is fairly
permissive. I'd like to reduce that, ideally to, say, level 3, which is
what I use for the buildfarm code.
But let's start by going to severity level 4. Give this perlcriticrc,
derived from the buildfarm's:
# for policy descriptions see
# https://metacpan.org/release/Perl-Critic
severity = 4
theme = core
# allow octal constants with leading zeros
[-ValuesAndExpressions::ProhibitLeadingZeros]
# allow assignments to %ENV and %SIG without 'local'
[Variables::RequireLocalizedPunctuationVars]
allow = %ENV %SIG
# allow 'no warnings qw(once)
[TestingAndDebugging::ProhibitNoWarnings]
allow = once
# allow opened files to stay open for more than 9 lines of code
[-InputOutput::RequireBriefOpen]
Here's a summary of the perlcritic warnings:
39 Always unpack @_ first
30 Code before warnings are enabled
12 Subroutine "new" called using indirect syntax
9 Multiple "package" declarations
9 Expression form of "grep"
7 Symbols are exported by default
5 Warnings disabled
4 Magic variable "$/" should be assigned as "local"
4 Comma used to separate statements
2 Readline inside "for" loop
2 Pragma "constant" used
2 Mixed high and low-precedence booleans
2 Don't turn off strict for large blocks of code
1 Magic variable "@a" should be assigned as "local"
1 Magic variable "$|" should be assigned as "local"
1 Magic variable "$\" should be assigned as "local"
1 Magic variable "$?" should be assigned as "local"
1 Magic variable "$," should be assigned as "local"
1 Magic variable "$"" should be assigned as "local"
1 Expression form of "map"
which isn't a huge number.
I'm going to start posting patches to address these issues, and when
we're done we can lower the severity level and start again on the level
3s :-)
cheers
andrew
--
Andrew Dunstan https://www.2ndQuadrant.com
PostgreSQL Development, 24x7 Support, Remote DBA, Training & Services
On Thu, Apr 9, 2020 at 11:44 AM Andrew Dunstan
<andrew.dunstan@2ndquadrant.com> wrote:
We currently only run perlcritic at severity level 5, which is fairly
permissive. I'd like to reduce that, ideally to, say, level 3, which is
what I use for the buildfarm code.But let's start by going to severity level 4.
I continue to be skeptical of perlcritic. I think it complains about a
lot of things which don't matter very much. We should consider whether
the effort it takes to keep it warning-clean has proportionate
benefits.
--
Robert Haas
EnterpriseDB: http://www.enterprisedb.com
The Enterprise PostgreSQL Company
On 2020-04-09 19:47, Robert Haas wrote:
On Thu, Apr 9, 2020 at 11:44 AM Andrew Dunstan
<andrew.dunstan@2ndquadrant.com> wrote:We currently only run perlcritic at severity level 5, which is fairly
permissive. I'd like to reduce that, ideally to, say, level 3, which is
what I use for the buildfarm code.But let's start by going to severity level 4.
I continue to be skeptical of perlcritic. I think it complains about a
lot of things which don't matter very much. We should consider whether
the effort it takes to keep it warning-clean has proportionate
benefits.
Let's see what the patches look like. At least some of the warnings
look reasonable, especially in the sense that they are things casual
Perl programmers might accidentally do wrong.
--
Peter Eisentraut http://www.2ndQuadrant.com/
PostgreSQL Development, 24x7 Support, Remote DBA, Training & Services
On 4/9/20 2:26 PM, Peter Eisentraut wrote:
On 2020-04-09 19:47, Robert Haas wrote:
On Thu, Apr 9, 2020 at 11:44 AM Andrew Dunstan
<andrew.dunstan@2ndquadrant.com> wrote:We currently only run perlcritic at severity level 5, which is fairly
permissive. I'd like to reduce that, ideally to, say, level 3, which is
what I use for the buildfarm code.But let's start by going to severity level 4.
I continue to be skeptical of perlcritic. I think it complains about a
lot of things which don't matter very much. We should consider whether
the effort it takes to keep it warning-clean has proportionate
benefits.Let's see what the patches look like. At least some of the warnings
look reasonable, especially in the sense that they are things casual
Perl programmers might accidentally do wrong.
OK, I'll prep one or two. I used to be of Robert's opinion, but I've
come around some on it.
cheers
andrew
--
Andrew Dunstan https://www.2ndQuadrant.com
PostgreSQL Development, 24x7 Support, Remote DBA, Training & Services
On Thu, Apr 09, 2020 at 11:44:11AM -0400, Andrew Dunstan wrote:
���� 39 Always unpack @_ first
Requiring a "my @args = @_" does not improve this code:
sub CreateSolution
{
...
if ($visualStudioVersion eq '12.00')
{
return new VS2013Solution(@_);
}
���� 30 Code before warnings are enabled
Sounds good. We already require "use strict" before code. Requiring "use
warnings" in the exact same place does not impose much burden.
���� 12 Subroutine "new" called using indirect syntax
No, thanks. "new VS2013Solution(@_)" and "VS2013Solution->new(@_)" are both
fine; enforcing the latter is an ongoing waste of effort.
����� 9 Multiple "package" declarations
This is good advice if you're writing for CPAN, but it would make PostgreSQL
code worse by having us split affiliated code across multiple files.
����� 9 Expression form of "grep"
No, thanks. I'd be happier with the opposite, requiring grep(/x/, $arg)
instead of grep { /x/ } $arg. Neither is worth enforcing.
����� 7 Symbols are exported by default
This is good advice if you're writing for CPAN. For us, it just adds typing.
����� 5 Warnings disabled
����� 4 Magic variable "$/" should be assigned as "local"
����� 4 Comma used to separate statements
����� 2 Readline inside "for" loop
����� 2 Pragma "constant" used
����� 2 Mixed high and low-precedence booleans
����� 2 Don't turn off strict for large blocks of code
����� 1 Magic variable "@a" should be assigned as "local"
����� 1 Magic variable "$|" should be assigned as "local"
����� 1 Magic variable "$\" should be assigned as "local"
����� 1 Magic variable "$?" should be assigned as "local"
����� 1 Magic variable "$," should be assigned as "local"
����� 1 Magic variable "$"" should be assigned as "local"
����� 1 Expression form of "map"
I looked less closely at the rest, but none give me a favorable impression.
In summary, among those warnings, I see non-negative value in "Code before
warnings are enabled" only. While we're changing this, I propose removing
Subroutines::RequireFinalReturn. Implicit return values were not a material
source of PostgreSQL bugs, yet we've allowed this to litter our code:
$ find src -name '*.p[lm]'| xargs grep -n '^.return;' | wc -l
194
On 2020-04-11 06:30, Noah Misch wrote:
In summary, among those warnings, I see non-negative value in "Code before
warnings are enabled" only.
Now that you put it like this, that was also my impression when I first
introduced the level 5 warnings and then decided to stop there.
--
Peter Eisentraut http://www.2ndQuadrant.com/
PostgreSQL Development, 24x7 Support, Remote DBA, Training & Services
Noah Misch <noah@leadboat.com> writes:
In summary, among those warnings, I see non-negative value in "Code before
warnings are enabled" only. While we're changing this, I propose removing
Subroutines::RequireFinalReturn.
If it's possible to turn off just that warning, then +several.
It's routinely caused buildfarm failures, yet I can detect exactly
no value in it. If there were sufficient cross-procedural analysis
backing it to detect whether any caller examines the subroutine's
result value, then it'd be worth having. But there isn't, so those
extra returns are just pedantic verbosity.
regards, tom lane
On 4/11/20 12:30 AM, Noah Misch wrote:
On Thu, Apr 09, 2020 at 11:44:11AM -0400, Andrew Dunstan wrote:
39 Always unpack @_ first
Requiring a "my @args = @_" does not improve this code:
sub CreateSolution
{
...
if ($visualStudioVersion eq '12.00')
{
return new VS2013Solution(@_);
}30 Code before warnings are enabled
Sounds good. We already require "use strict" before code. Requiring "use
warnings" in the exact same place does not impose much burden.12 Subroutine "new" called using indirect syntax
No, thanks. "new VS2013Solution(@_)" and "VS2013Solution->new(@_)" are both
fine; enforcing the latter is an ongoing waste of effort.9 Multiple "package" declarations
This is good advice if you're writing for CPAN, but it would make PostgreSQL
code worse by having us split affiliated code across multiple files.9 Expression form of "grep"
No, thanks. I'd be happier with the opposite, requiring grep(/x/, $arg)
instead of grep { /x/ } $arg. Neither is worth enforcing.7 Symbols are exported by default
This is good advice if you're writing for CPAN. For us, it just adds typing.
5 Warnings disabled
4 Magic variable "$/" should be assigned as "local"
4 Comma used to separate statements
2 Readline inside "for" loop
2 Pragma "constant" used
2 Mixed high and low-precedence booleans
2 Don't turn off strict for large blocks of code
1 Magic variable "@a" should be assigned as "local"
1 Magic variable "$|" should be assigned as "local"
1 Magic variable "$\" should be assigned as "local"
1 Magic variable "$?" should be assigned as "local"
1 Magic variable "$," should be assigned as "local"
1 Magic variable "$"" should be assigned as "local"
1 Expression form of "map"I looked less closely at the rest, but none give me a favorable impression.
I don't have a problem with some of this. OTOH, it's nice to know what
we're ignoring and what we're not.
What I have prepared is first a patch that lowers the severity level to
3 but implements policy exceptions so that nothing is broken. Then 3
patches. One fixes the missing warnings pragma and removes shebang -w
switches, so we are quite consistent about how we do this. I gather we
are agreed about that one. The next one fixes those magic variable
error. That includes using some more idiomatic perl, and in one case
just renaming a couple of variables that are fairly opaque anyway. The
last one fixes the mixture of high and low precedence boolean operators,
the inefficient <FOO> inside a foreach loop, and the use of commas to
separate statements, and relaxes the policy about large blocks with 'no
strict'.
Since I have written them they are attached, for posterity if nothing
else. :-)
In summary, among those warnings, I see non-negative value in "Code before
warnings are enabled" only. While we're changing this, I propose removing
Subroutines::RequireFinalReturn. Implicit return values were not a material
source of PostgreSQL bugs, yet we've allowed this to litter our code:
That doesn't mean it won't be a source of problems in future, I've
actually been bitten by this in the past.
cheers
andrew
--
Andrew Dunstan https://www.2ndQuadrant.com
PostgreSQL Development, 24x7 Support, Remote DBA, Training & Services
Attachments:
pg-perlcritic-fix-misc-errors.patchtext/x-patch; charset=UTF-8; name=pg-perlcritic-fix-misc-errors.patchDownload
diff --git a/src/backend/catalog/genbki.pl b/src/backend/catalog/genbki.pl
index da34124595..25b18e84c5 100644
--- a/src/backend/catalog/genbki.pl
+++ b/src/backend/catalog/genbki.pl
@@ -590,7 +590,7 @@ EOM
# Special hack to generate OID symbols for pg_type entries
# that lack one.
- if ($catname eq 'pg_type' and !exists $bki_values{oid_symbol})
+ if ($catname eq 'pg_type' && !exists $bki_values{oid_symbol})
{
my $symbol = form_pg_type_symbol($bki_values{typname});
$bki_values{oid_symbol} = $symbol
diff --git a/src/backend/parser/check_keywords.pl b/src/backend/parser/check_keywords.pl
index 68d1f517b7..6b27fbf1be 100644
--- a/src/backend/parser/check_keywords.pl
+++ b/src/backend/parser/check_keywords.pl
@@ -44,12 +44,12 @@ line: while (my $S = <$gram>)
my $s;
# Make sure any braces are split
- $s = '{', $S =~ s/$s/ { /g;
- $s = '}', $S =~ s/$s/ } /g;
+ $s = '{'; $S =~ s/$s/ { /g;
+ $s = '}'; $S =~ s/$s/ } /g;
# Any comments are split
- $s = '[/][*]', $S =~ s#$s# /* #g;
- $s = '[*][/]', $S =~ s#$s# */ #g;
+ $s = '[/][*]'; $S =~ s#$s# /* #g;
+ $s = '[*][/]'; $S =~ s#$s# */ #g;
if (!($kcat))
{
diff --git a/src/common/unicode/generate-unicode_combining_table.pl b/src/common/unicode/generate-unicode_combining_table.pl
index e468a5f8c9..c984a903ee 100644
--- a/src/common/unicode/generate-unicode_combining_table.pl
+++ b/src/common/unicode/generate-unicode_combining_table.pl
@@ -18,7 +18,7 @@ print "/* generated by src/common/unicode/generate-unicode_combining_table.pl, d
print "static const struct mbinterval combining[] = {\n";
-foreach my $line (<ARGV>)
+while (my $line = <ARGV>)
{
chomp $line;
my @fields = split ';', $line;
diff --git a/src/common/unicode/generate-unicode_normprops_table.pl b/src/common/unicode/generate-unicode_normprops_table.pl
index c07a04a58a..ec4e8ea72a 100644
--- a/src/common/unicode/generate-unicode_normprops_table.pl
+++ b/src/common/unicode/generate-unicode_normprops_table.pl
@@ -26,7 +26,7 @@ typedef struct
} pg_unicode_normprops;
EOS
-foreach my $line (<ARGV>)
+while (my $line = <ARGV>)
{
chomp $line;
$line =~ s/\s*#.*$//;
diff --git a/src/include/catalog/reformat_dat_file.pl b/src/include/catalog/reformat_dat_file.pl
index 1cadbfd9f4..8bb4d0ab63 100755
--- a/src/include/catalog/reformat_dat_file.pl
+++ b/src/include/catalog/reformat_dat_file.pl
@@ -187,7 +187,7 @@ sub strip_default_values
# It's okay if we have no oid value, since it will be assigned
# automatically before bootstrap.
die "strip_default_values: $catname.$attname undefined\n"
- if !defined $row->{$attname} and $attname ne 'oid';
+ if !defined $row->{$attname} && $attname ne 'oid';
if (defined $column->{default}
and ($row->{$attname} eq $column->{default}))
diff --git a/src/tools/perlcheck/perlcriticrc b/src/tools/perlcheck/perlcriticrc
index 4130da460a..286d6ef122 100644
--- a/src/tools/perlcheck/perlcriticrc
+++ b/src/tools/perlcheck/perlcriticrc
@@ -31,21 +31,21 @@ verbose = %f: %m at line %l, column %c. %e. ([%p] Severity: %s)\n
[Variables::RequireLocalizedPunctuationVars]
allow = %ENV %SIG
+# default is 3 statements for a block with 'no strict'. Allow some more.
+[TestingAndDebugging::ProhibitProlongedStrictureOverride]
+statements = 8
+
# severity 4 policies currently violated
[-BuiltinFunctions::RequireBlockGrep]
[-BuiltinFunctions::RequireBlockMap]
-[-InputOutput::ProhibitReadlineInForLoop]
[-InputOutput::RequireBriefOpen]
[-Modules::ProhibitAutomaticExportation]
[-Modules::ProhibitMultiplePackages]
[-Objects::ProhibitIndirectSyntax]
[-Subroutines::RequireArgUnpacking]
[-TestingAndDebugging::ProhibitNoWarnings]
-[-TestingAndDebugging::ProhibitProlongedStrictureOverride]
-[-ValuesAndExpressions::ProhibitCommaSeparatedStatements]
[-ValuesAndExpressions::ProhibitConstantPragma]
-[-ValuesAndExpressions::ProhibitMixedBooleanOperators]
# severity 3 policies currently violated
pg-perlcritic-fix-nonlocal-magic-vars.patchtext/x-patch; charset=UTF-8; name=pg-perlcritic-fix-nonlocal-magic-vars.patchDownload
diff --git a/contrib/intarray/bench/bench.pl b/contrib/intarray/bench/bench.pl
index daf3febc80..263cf6ca56 100755
--- a/contrib/intarray/bench/bench.pl
+++ b/contrib/intarray/bench/bench.pl
@@ -100,25 +100,25 @@ if ($opt{e})
my $t0 = [gettimeofday];
my $count = 0;
-my $b = $opt{b};
-$b ||= 1;
-my @a;
-foreach (1 .. $b)
+my $opt_b = $opt{b};
+$opt_b ||= 1;
+my @rows;
+foreach (1 .. $opt_b)
{
- @a = exec_sql($dbi, $sql);
- $count = $#a;
+ @rows = exec_sql($dbi, $sql);
+ $count = $#rows;
}
my $elapsed = tv_interval($t0, [gettimeofday]);
if ($opt{o})
{
- foreach (@a)
+ foreach (@rows)
{
print "$_->{mid}\t$_->{sections}\n";
}
}
print sprintf(
"total: %.02f sec; number: %d; for one: %.03f sec; found %d docs\n",
- $elapsed, $b, $elapsed / $b,
+ $elapsed, $opt_b, $elapsed / $opt_b,
$count + 1);
$dbi->disconnect;
diff --git a/src/backend/parser/check_keywords.pl b/src/backend/parser/check_keywords.pl
index 702c97bba2..68d1f517b7 100644
--- a/src/backend/parser/check_keywords.pl
+++ b/src/backend/parser/check_keywords.pl
@@ -21,8 +21,8 @@ sub error
return;
}
-$, = ' '; # set output field separator
-$\ = "\n"; # set output record separator
+local $, = ' '; # set output field separator
+local $\ = "\n"; # set output record separator
my %keyword_categories;
$keyword_categories{'unreserved_keyword'} = 'UNRESERVED_KEYWORD';
diff --git a/src/test/locale/sort-test.pl b/src/test/locale/sort-test.pl
index b61968b7e0..5efafd6e20 100755
--- a/src/test/locale/sort-test.pl
+++ b/src/test/locale/sort-test.pl
@@ -8,7 +8,7 @@ open(my $in_fh, '<', $ARGV[0]) || die;
chop(my (@words) = <$in_fh>);
close($in_fh);
-$" = "\n";
+local $" = "\n";
my (@result) = sort @words;
print "@result\n";
diff --git a/src/test/perl/PostgresNode.pm b/src/test/perl/PostgresNode.pm
index 1d5450758e..b55823f356 100644
--- a/src/test/perl/PostgresNode.pm
+++ b/src/test/perl/PostgresNode.pm
@@ -1254,7 +1254,7 @@ END
$node->clean_node if $exit_code == 0 && TestLib::all_tests_passing();
}
- $? = $exit_code;
+ $? = $exit_code; ## no critic (RequireLocalizedPunctuationVars)
}
=pod
diff --git a/src/tools/msvc/Install.pm b/src/tools/msvc/Install.pm
index 1a92ed233a..f5b90261f5 100644
--- a/src/tools/msvc/Install.pm
+++ b/src/tools/msvc/Install.pm
@@ -45,7 +45,7 @@ sub lcopy
sub Install
{
- $| = 1;
+ local $| = 1;
my $target = shift;
$insttype = shift;
@@ -762,13 +762,10 @@ sub read_file
{
my $filename = shift;
my $F;
- my $t = $/;
-
- undef $/;
+ local $/ = undef;
open($F, '<', $filename) || die "Could not open file $filename\n";
my $txt = <$F>;
close($F);
- $/ = $t;
return $txt;
}
diff --git a/src/tools/msvc/Project.pm b/src/tools/msvc/Project.pm
index d90a996d46..20f79b382b 100644
--- a/src/tools/msvc/Project.pm
+++ b/src/tools/msvc/Project.pm
@@ -420,13 +420,10 @@ sub read_file
{
my $filename = shift;
my $F;
- my $t = $/;
-
- undef $/;
+ local $/ = undef;
open($F, '<', $filename) || croak "Could not open file $filename\n";
my $txt = <$F>;
close($F);
- $/ = $t;
return $txt;
}
@@ -435,15 +432,12 @@ sub read_makefile
{
my $reldir = shift;
my $F;
- my $t = $/;
-
- undef $/;
+ local $/ = undef;
open($F, '<', "$reldir/GNUmakefile")
|| open($F, '<', "$reldir/Makefile")
|| confess "Could not open $reldir/Makefile\n";
my $txt = <$F>;
close($F);
- $/ = $t;
return $txt;
}
diff --git a/src/tools/perlcheck/perlcriticrc b/src/tools/perlcheck/perlcriticrc
index 4550928319..4130da460a 100644
--- a/src/tools/perlcheck/perlcriticrc
+++ b/src/tools/perlcheck/perlcriticrc
@@ -23,6 +23,14 @@ verbose = %f: %m at line %l, column %c. %e. ([%p] Severity: %s)\n
# allow octal constants with leading zeros
[-ValuesAndExpressions::ProhibitLeadingZeros]
+# Require 'local' declarations for assignments to perl magic variables,
+# but don't require local declarations for assignments to %ENV and %SIG, even
+# though many should be local, especially for %ENV.
+# Note: perlcritic doesn't like things like this, even though it's safe:
+# local %ENV = %ENV; $ENV{foo} = 'bar';
+[Variables::RequireLocalizedPunctuationVars]
+allow = %ENV %SIG
+
# severity 4 policies currently violated
[-BuiltinFunctions::RequireBlockGrep]
@@ -38,7 +46,6 @@ verbose = %f: %m at line %l, column %c. %e. ([%p] Severity: %s)\n
[-ValuesAndExpressions::ProhibitCommaSeparatedStatements]
[-ValuesAndExpressions::ProhibitConstantPragma]
[-ValuesAndExpressions::ProhibitMixedBooleanOperators]
-[-Variables::RequireLocalizedPunctuationVars]
# severity 3 policies currently violated
diff --git a/src/tools/win32tzlist.pl b/src/tools/win32tzlist.pl
index 25f7efbc58..97484016bb 100755
--- a/src/tools/win32tzlist.pl
+++ b/src/tools/win32tzlist.pl
@@ -60,12 +60,13 @@ $basekey->Close();
# Fetch all timezones currently in the file
#
my @file_zones;
+my $pgtz;
open(my $tzfh, '<', $tzfile) or die "Could not open $tzfile!\n";
-my $t = $/;
-undef $/;
-my $pgtz = <$tzfh>;
+{
+ local $/ = undef;
+ $pgtz = <$tzfh>;
+}
close($tzfh);
-$/ = $t;
# Attempt to locate and extract the complete win32_tzmap struct
$pgtz =~ /win32_tzmap\[\] =\s+{\s+\/\*[^\/]+\*\/\s+(.+?)};/gs
pg-perlcritic-use-warnings-pragma-consistently.patchtext/x-patch; charset=UTF-8; name=pg-perlcritic-use-warnings-pragma-consistently.patchDownload
diff --git a/contrib/intarray/bench/bench.pl b/contrib/intarray/bench/bench.pl
index 92035d6c06..daf3febc80 100755
--- a/contrib/intarray/bench/bench.pl
+++ b/contrib/intarray/bench/bench.pl
@@ -1,6 +1,7 @@
#!/usr/bin/perl
use strict;
+use warnings;
# make sure we are in a sane environment.
use DBI();
diff --git a/contrib/intarray/bench/create_test.pl b/contrib/intarray/bench/create_test.pl
index d2c678bb53..3f2a6e4da2 100755
--- a/contrib/intarray/bench/create_test.pl
+++ b/contrib/intarray/bench/create_test.pl
@@ -3,6 +3,8 @@
# contrib/intarray/bench/create_test.pl
use strict;
+use warnings;
+
print <<EOT;
create table message (
mid int not null,
diff --git a/contrib/seg/seg-validate.pl b/contrib/seg/seg-validate.pl
index b8957ed984..9fa0887e71 100755
--- a/contrib/seg/seg-validate.pl
+++ b/contrib/seg/seg-validate.pl
@@ -1,6 +1,7 @@
#!/usr/bin/perl
use strict;
+use warnings;
my $integer = '[+-]?[0-9]+';
my $real = '[+-]?[0-9]+\.[0-9]+';
diff --git a/contrib/seg/sort-segments.pl b/contrib/seg/sort-segments.pl
index 04eafd92f2..2e3c9734a9 100755
--- a/contrib/seg/sort-segments.pl
+++ b/contrib/seg/sort-segments.pl
@@ -3,6 +3,7 @@
# this script will sort any table with the segment data type in its last column
use strict;
+use warnings;
my @rows;
diff --git a/doc/src/sgml/mk_feature_tables.pl b/doc/src/sgml/mk_feature_tables.pl
index 476e50e66d..ee158cb196 100644
--- a/doc/src/sgml/mk_feature_tables.pl
+++ b/doc/src/sgml/mk_feature_tables.pl
@@ -1,8 +1,9 @@
-# /usr/bin/perl -w
+# /usr/bin/perl
# doc/src/sgml/mk_feature_tables.pl
use strict;
+use warnings;
my $yesno = $ARGV[0];
diff --git a/src/backend/catalog/genbki.pl b/src/backend/catalog/genbki.pl
index ad24f4dcb9..da34124595 100644
--- a/src/backend/catalog/genbki.pl
+++ b/src/backend/catalog/genbki.pl
@@ -1,4 +1,4 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
#----------------------------------------------------------------------
#
# genbki.pl
diff --git a/src/backend/utils/Gen_fmgrtab.pl b/src/backend/utils/Gen_fmgrtab.pl
index 7c68dbec22..b7c7b4c8fa 100644
--- a/src/backend/utils/Gen_fmgrtab.pl
+++ b/src/backend/utils/Gen_fmgrtab.pl
@@ -1,4 +1,4 @@
-#! /usr/bin/perl -w
+#! /usr/bin/perl
#-------------------------------------------------------------------------
#
# Gen_fmgrtab.pl
diff --git a/src/backend/utils/mb/Unicode/UCS_to_BIG5.pl b/src/backend/utils/mb/Unicode/UCS_to_BIG5.pl
index 4c8aaf751c..84c9c53541 100755
--- a/src/backend/utils/mb/Unicode/UCS_to_BIG5.pl
+++ b/src/backend/utils/mb/Unicode/UCS_to_BIG5.pl
@@ -25,6 +25,8 @@
# # and Unicode name (not used in this script)
use strict;
+use warnings;
+
use convutils;
my $this_script = 'src/backend/utils/mb/Unicode/UCS_to_BIG5.pl';
diff --git a/src/backend/utils/mb/Unicode/UCS_to_EUC_CN.pl b/src/backend/utils/mb/Unicode/UCS_to_EUC_CN.pl
index b493a13838..1596b64238 100755
--- a/src/backend/utils/mb/Unicode/UCS_to_EUC_CN.pl
+++ b/src/backend/utils/mb/Unicode/UCS_to_EUC_CN.pl
@@ -14,6 +14,8 @@
# and the "b" field is the hex byte sequence for GB18030
use strict;
+use warnings;
+
use convutils;
my $this_script = 'src/backend/utils/mb/Unicode/UCS_to_EUC_CN.pl';
diff --git a/src/backend/utils/mb/Unicode/UCS_to_EUC_JIS_2004.pl b/src/backend/utils/mb/Unicode/UCS_to_EUC_JIS_2004.pl
index 4faf597271..092a5b44f5 100755
--- a/src/backend/utils/mb/Unicode/UCS_to_EUC_JIS_2004.pl
+++ b/src/backend/utils/mb/Unicode/UCS_to_EUC_JIS_2004.pl
@@ -8,6 +8,8 @@
# "euc-jis-2004-std.txt" (http://x0213.org)
use strict;
+use warnings;
+
use convutils;
my $this_script = 'src/backend/utils/mb/Unicode/UCS_to_EUC_JIS_2004.pl';
diff --git a/src/backend/utils/mb/Unicode/UCS_to_EUC_JP.pl b/src/backend/utils/mb/Unicode/UCS_to_EUC_JP.pl
index 86743a4074..1d88c0296e 100755
--- a/src/backend/utils/mb/Unicode/UCS_to_EUC_JP.pl
+++ b/src/backend/utils/mb/Unicode/UCS_to_EUC_JP.pl
@@ -12,6 +12,8 @@
# organization's ftp site.
use strict;
+use warnings;
+
use convutils;
my $this_script = 'src/backend/utils/mb/Unicode/UCS_to_EUC_JP.pl';
diff --git a/src/backend/utils/mb/Unicode/UCS_to_EUC_KR.pl b/src/backend/utils/mb/Unicode/UCS_to_EUC_KR.pl
index a81a7d61ce..b560f9f37e 100755
--- a/src/backend/utils/mb/Unicode/UCS_to_EUC_KR.pl
+++ b/src/backend/utils/mb/Unicode/UCS_to_EUC_KR.pl
@@ -17,6 +17,8 @@
# # and Unicode name (not used in this script)
use strict;
+use warnings;
+
use convutils;
my $this_script = 'src/backend/utils/mb/Unicode/UCS_to_EUC_KR.pl';
diff --git a/src/backend/utils/mb/Unicode/UCS_to_EUC_TW.pl b/src/backend/utils/mb/Unicode/UCS_to_EUC_TW.pl
index b9ec01dd85..0f52183ff5 100755
--- a/src/backend/utils/mb/Unicode/UCS_to_EUC_TW.pl
+++ b/src/backend/utils/mb/Unicode/UCS_to_EUC_TW.pl
@@ -18,6 +18,8 @@
# # and Unicode name (not used in this script)
use strict;
+use warnings;
+
use convutils;
my $this_script = 'src/backend/utils/mb/Unicode/UCS_to_EUC_TW.pl';
diff --git a/src/backend/utils/mb/Unicode/UCS_to_GB18030.pl b/src/backend/utils/mb/Unicode/UCS_to_GB18030.pl
index 779e3f7f01..57e63b4004 100755
--- a/src/backend/utils/mb/Unicode/UCS_to_GB18030.pl
+++ b/src/backend/utils/mb/Unicode/UCS_to_GB18030.pl
@@ -14,6 +14,8 @@
# and the "b" field is the hex byte sequence for GB18030
use strict;
+use warnings;
+
use convutils;
my $this_script = 'src/backend/utils/mb/Unicode/UCS_to_GB18030.pl';
diff --git a/src/backend/utils/mb/Unicode/UCS_to_JOHAB.pl b/src/backend/utils/mb/Unicode/UCS_to_JOHAB.pl
index c1967e00da..0bcea9e0d4 100755
--- a/src/backend/utils/mb/Unicode/UCS_to_JOHAB.pl
+++ b/src/backend/utils/mb/Unicode/UCS_to_JOHAB.pl
@@ -16,6 +16,8 @@
# # and Unicode name (not used in this script)
use strict;
+use warnings;
+
use convutils;
my $this_script = 'src/backend/utils/mb/Unicode/UCS_to_JOHAB.pl';
diff --git a/src/backend/utils/mb/Unicode/UCS_to_SHIFT_JIS_2004.pl b/src/backend/utils/mb/Unicode/UCS_to_SHIFT_JIS_2004.pl
index cac9a9c87d..b516e91306 100755
--- a/src/backend/utils/mb/Unicode/UCS_to_SHIFT_JIS_2004.pl
+++ b/src/backend/utils/mb/Unicode/UCS_to_SHIFT_JIS_2004.pl
@@ -8,6 +8,8 @@
# "sjis-0213-2004-std.txt" (http://x0213.org)
use strict;
+use warnings;
+
use convutils;
# first generate UTF-8 --> SHIFT_JIS_2004 table
diff --git a/src/backend/utils/mb/Unicode/UCS_to_SJIS.pl b/src/backend/utils/mb/Unicode/UCS_to_SJIS.pl
index c65091159b..5f4512ec87 100755
--- a/src/backend/utils/mb/Unicode/UCS_to_SJIS.pl
+++ b/src/backend/utils/mb/Unicode/UCS_to_SJIS.pl
@@ -11,6 +11,8 @@
# ftp site.
use strict;
+use warnings;
+
use convutils;
my $this_script = 'src/backend/utils/mb/Unicode/UCS_to_SJIS.pl';
diff --git a/src/backend/utils/mb/Unicode/UCS_to_UHC.pl b/src/backend/utils/mb/Unicode/UCS_to_UHC.pl
index 78b982a22e..3282106d7f 100755
--- a/src/backend/utils/mb/Unicode/UCS_to_UHC.pl
+++ b/src/backend/utils/mb/Unicode/UCS_to_UHC.pl
@@ -14,6 +14,8 @@
# and the "b" field is the hex byte sequence for UHC
use strict;
+use warnings;
+
use convutils;
my $this_script = 'src/backend/utils/mb/Unicode/UCS_to_UHC.pl';
diff --git a/src/backend/utils/mb/Unicode/UCS_to_most.pl b/src/backend/utils/mb/Unicode/UCS_to_most.pl
index 7ff724558d..8a7b26a5c5 100755
--- a/src/backend/utils/mb/Unicode/UCS_to_most.pl
+++ b/src/backend/utils/mb/Unicode/UCS_to_most.pl
@@ -16,6 +16,8 @@
# # and Unicode name (not used in this script)
use strict;
+use warnings;
+
use convutils;
my $this_script = 'src/backend/utils/mb/Unicode/UCS_to_most.pl';
diff --git a/src/backend/utils/mb/Unicode/convutils.pm b/src/backend/utils/mb/Unicode/convutils.pm
index 1903b345cb..2f64a12ea1 100644
--- a/src/backend/utils/mb/Unicode/convutils.pm
+++ b/src/backend/utils/mb/Unicode/convutils.pm
@@ -6,6 +6,7 @@
package convutils;
use strict;
+use warnings;
use Carp;
use Exporter 'import';
diff --git a/src/backend/utils/sort/gen_qsort_tuple.pl b/src/backend/utils/sort/gen_qsort_tuple.pl
index b6b2ffa7d0..9ed6cfc7ea 100644
--- a/src/backend/utils/sort/gen_qsort_tuple.pl
+++ b/src/backend/utils/sort/gen_qsort_tuple.pl
@@ -1,4 +1,4 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
#
# gen_qsort_tuple.pl
@@ -26,6 +26,7 @@
#
use strict;
+use warnings;
my $SUFFIX;
my $EXTRAARGS;
diff --git a/src/bin/psql/create_help.pl b/src/bin/psql/create_help.pl
index a3b34603ef..ee82e64583 100644
--- a/src/bin/psql/create_help.pl
+++ b/src/bin/psql/create_help.pl
@@ -1,4 +1,4 @@
-#! /usr/bin/perl -w
+#! /usr/bin/perl
#################################################################
# create_help.pl -- converts SGML docs to internal psql help
@@ -20,6 +20,7 @@
#
use strict;
+use warnings;
my $docdir = $ARGV[0] or die "$0: missing required argument: docdir\n";
my $hfile = $ARGV[1] . '.h'
diff --git a/src/interfaces/libpq/test/regress.pl b/src/interfaces/libpq/test/regress.pl
index 3ad638a91b..54db4f1abf 100644
--- a/src/interfaces/libpq/test/regress.pl
+++ b/src/interfaces/libpq/test/regress.pl
@@ -1,6 +1,7 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
use strict;
+use warnings;
# use of SRCDIR/SUBDIR is required for supporting VPath builds
my $srcdir = $ENV{'SRCDIR'} or die 'SRCDIR environment variable is not set';
diff --git a/src/pl/plperl/plc_perlboot.pl b/src/pl/plperl/plc_perlboot.pl
index f41aa80e80..ee1b9bf463 100644
--- a/src/pl/plperl/plc_perlboot.pl
+++ b/src/pl/plperl/plc_perlboot.pl
@@ -1,6 +1,7 @@
# src/pl/plperl/plc_perlboot.pl
use strict;
+use warnings;
use 5.008001;
use vars qw(%_SHARED $_TD);
diff --git a/src/pl/plperl/plperl_opmask.pl b/src/pl/plperl/plperl_opmask.pl
index e4e64b843f..3b33112ff9 100644
--- a/src/pl/plperl/plperl_opmask.pl
+++ b/src/pl/plperl/plperl_opmask.pl
@@ -1,4 +1,4 @@
-#!perl -w
+#!perl
use strict;
use warnings;
diff --git a/src/test/locale/sort-test.pl b/src/test/locale/sort-test.pl
index b8fc93aab1..b61968b7e0 100755
--- a/src/test/locale/sort-test.pl
+++ b/src/test/locale/sort-test.pl
@@ -1,6 +1,7 @@
#! /usr/bin/perl
use strict;
+use warnings;
use locale;
open(my $in_fh, '<', $ARGV[0]) || die;
diff --git a/src/test/perl/SimpleTee.pm b/src/test/perl/SimpleTee.pm
index 9de7b1ac32..74409bde6d 100644
--- a/src/test/perl/SimpleTee.pm
+++ b/src/test/perl/SimpleTee.pm
@@ -9,6 +9,7 @@
package SimpleTee;
use strict;
+use warnings;
sub TIEHANDLE
{
diff --git a/src/tools/fix-old-flex-code.pl b/src/tools/fix-old-flex-code.pl
index 2954cf5a72..1bbb7cdb84 100644
--- a/src/tools/fix-old-flex-code.pl
+++ b/src/tools/fix-old-flex-code.pl
@@ -1,4 +1,4 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
#----------------------------------------------------------------------
#
# fix-old-flex-code.pl
diff --git a/src/tools/msvc/build.pl b/src/tools/msvc/build.pl
index 2e47f24783..3c886fcd49 100644
--- a/src/tools/msvc/build.pl
+++ b/src/tools/msvc/build.pl
@@ -3,6 +3,7 @@
# src/tools/msvc/build.pl
use strict;
+use warnings;
use File::Basename;
use File::Spec;
diff --git a/src/tools/msvc/pgbison.pl b/src/tools/msvc/pgbison.pl
index 490df83367..774d5be059 100644
--- a/src/tools/msvc/pgbison.pl
+++ b/src/tools/msvc/pgbison.pl
@@ -3,6 +3,8 @@
# src/tools/msvc/pgbison.pl
use strict;
+use warnings;
+
use File::Basename;
# assume we are in the postgres source root
diff --git a/src/tools/msvc/pgflex.pl b/src/tools/msvc/pgflex.pl
index aceed5ffd6..26c73dbfad 100644
--- a/src/tools/msvc/pgflex.pl
+++ b/src/tools/msvc/pgflex.pl
@@ -3,6 +3,8 @@
# src/tools/msvc/pgflex.pl
use strict;
+use warnings;
+
use File::Basename;
# silence flex bleatings about file path style
diff --git a/src/tools/msvc/vcregress.pl b/src/tools/msvc/vcregress.pl
index 82dca29a61..c39178a93c 100644
--- a/src/tools/msvc/vcregress.pl
+++ b/src/tools/msvc/vcregress.pl
@@ -3,6 +3,7 @@
# src/tools/msvc/vcregress.pl
use strict;
+use warnings;
our $config;
diff --git a/src/tools/perlcheck/perlcriticrc b/src/tools/perlcheck/perlcriticrc
index 5784a0f765..4550928319 100644
--- a/src/tools/perlcheck/perlcriticrc
+++ b/src/tools/perlcheck/perlcriticrc
@@ -35,7 +35,6 @@ verbose = %f: %m at line %l, column %c. %e. ([%p] Severity: %s)\n
[-Subroutines::RequireArgUnpacking]
[-TestingAndDebugging::ProhibitNoWarnings]
[-TestingAndDebugging::ProhibitProlongedStrictureOverride]
-[-TestingAndDebugging::RequireUseWarnings]
[-ValuesAndExpressions::ProhibitCommaSeparatedStatements]
[-ValuesAndExpressions::ProhibitConstantPragma]
[-ValuesAndExpressions::ProhibitMixedBooleanOperators]
diff --git a/src/tools/pginclude/pgcheckdefines b/src/tools/pginclude/pgcheckdefines
index 4edf7fc56e..0a760d6eca 100755
--- a/src/tools/pginclude/pgcheckdefines
+++ b/src/tools/pginclude/pgcheckdefines
@@ -1,4 +1,4 @@
-#! /usr/bin/perl -w
+#! /usr/bin/perl
#
# This script looks for symbols that are referenced in #ifdef or defined()
@@ -21,6 +21,7 @@
#
use strict;
+use warnings;
use Cwd;
use File::Basename;
diff --git a/src/tools/version_stamp.pl b/src/tools/version_stamp.pl
index cb59ad234a..fcd3f18048 100755
--- a/src/tools/version_stamp.pl
+++ b/src/tools/version_stamp.pl
@@ -1,4 +1,4 @@
-#! /usr/bin/perl -w
+#! /usr/bin/perl
#################################################################
# version_stamp.pl -- update version stamps throughout the source tree
@@ -21,6 +21,7 @@
#
use strict;
+use warnings;
# Major version is hard-wired into the script. We update it when we branch
# a new development version.
pg-perlcritic-transition-to-sev3.patchtext/x-patch; charset=UTF-8; name=pg-perlcritic-transition-to-sev3.patchDownload
diff --git a/src/tools/perlcheck/perlcriticrc b/src/tools/perlcheck/perlcriticrc
index 12c09a453e..5784a0f765 100644
--- a/src/tools/perlcheck/perlcriticrc
+++ b/src/tools/perlcheck/perlcriticrc
@@ -6,13 +6,77 @@
#
#####################################################################
-severity = 5
+severity = 3
+# ignore any other themes the use might have installed
theme = core
+# print the policy name as well as the normal output
+verbose = %f: %m at line %l, column %c. %e. ([%p] Severity: %s)\n
+
+# Note: for policy descriptions see https://metacpan.org/release/Perl-Critic
+
+# Policy settings. Eventually policies from the "currently violated"
+# sections below should either be addressed via patches or moved to
+# this section.
+
# allow octal constants with leading zeros
[-ValuesAndExpressions::ProhibitLeadingZeros]
-# for now raise severity of this to level 5
-[Subroutines::RequireFinalReturn]
-severity = 5
+# severity 4 policies currently violated
+
+[-BuiltinFunctions::RequireBlockGrep]
+[-BuiltinFunctions::RequireBlockMap]
+[-InputOutput::ProhibitReadlineInForLoop]
+[-InputOutput::RequireBriefOpen]
+[-Modules::ProhibitAutomaticExportation]
+[-Modules::ProhibitMultiplePackages]
+[-Objects::ProhibitIndirectSyntax]
+[-Subroutines::RequireArgUnpacking]
+[-TestingAndDebugging::ProhibitNoWarnings]
+[-TestingAndDebugging::ProhibitProlongedStrictureOverride]
+[-TestingAndDebugging::RequireUseWarnings]
+[-ValuesAndExpressions::ProhibitCommaSeparatedStatements]
+[-ValuesAndExpressions::ProhibitConstantPragma]
+[-ValuesAndExpressions::ProhibitMixedBooleanOperators]
+[-Variables::RequireLocalizedPunctuationVars]
+
+# severity 3 policies currently violated
+
+[-BuiltinFunctions::ProhibitComplexMappings]
+[-BuiltinFunctions::ProhibitLvalueSubstr]
+[-BuiltinFunctions::ProhibitVoidMap]
+[-BuiltinFunctions::RequireSimpleSortBlock]
+[-ClassHierarchies::ProhibitExplicitISA]
+[-CodeLayout::ProhibitHardTabs]
+[-ControlStructures::ProhibitCascadingIfElse]
+[-ControlStructures::ProhibitDeepNests]
+[-ControlStructures::ProhibitNegativeExpressionsInUnlessAndUntilConditions]
+[-ErrorHandling::RequireCarping]
+[-ErrorHandling::RequireCheckingReturnValueOfEval]
+[-InputOutput::ProhibitBacktickOperators]
+[-InputOutput::ProhibitJoinedReadline]
+[-InputOutput::RequireCheckedOpen]
+[-Miscellanea::ProhibitUnrestrictedNoCritic]
+[-Modules::ProhibitConditionalUseStatements]
+[-Modules::ProhibitExcessMainComplexity]
+[-NamingConventions::ProhibitAmbiguousNames]
+[-RegularExpressions::ProhibitCaptureWithoutTest]
+[-RegularExpressions::ProhibitComplexRegexes]
+[-RegularExpressions::ProhibitUnusedCapture]
+[-RegularExpressions::RequireExtendedFormatting]
+[-Subroutines::ProhibitExcessComplexity]
+[-Subroutines::ProhibitManyArgs]
+[-Subroutines::ProhibitUnusedPrivateSubroutines]
+[-TestingAndDebugging::RequireTestLabels]
+[-ValuesAndExpressions::ProhibitImplicitNewlines]
+[-ValuesAndExpressions::ProhibitMismatchedOperators]
+[-ValuesAndExpressions::ProhibitQuotesAsQuotelikeOperatorDelimiters]
+[-ValuesAndExpressions::ProhibitVersionStrings]
+[-ValuesAndExpressions::RequireQuotedHeredocTerminator]
+[-Variables::ProhibitPackageVars]
+[-Variables::ProhibitReusedNames]
+[-Variables::ProhibitUnusedVariables]
+[-Variables::RequireInitializationForLocalVars]
+
+# EOF
On Apr 11, 2020, at 9:13 AM, Andrew Dunstan <andrew.dunstan@2ndquadrant.com> wrote:
Hi Andrew. I appreciate your interest and efforts here. I hope you don't mind a few questions/observations about this effort:
The
last one fixes the mixture of high and low precedence boolean operators,
I did not spot examples of this in your diffs, but I assume you mean to prohibit conditionals like:
if ($a || $b and $c || $d)
As I understand it, perl introduced low precedence operators precisely to allow this. Why disallow it?
and the use of commas to separate statements
I don't understand the prejudice against commas used this way. What is wrong with:
$i++, $j++ if defined $k;
rather than:
if (defined $k)
{
$i++;
$j++;
}
—
Mark Dilger
EnterpriseDB: http://www.enterprisedb.com
The Enterprise PostgreSQL Company
On 4/11/20 12:28 PM, Mark Dilger wrote:
On Apr 11, 2020, at 9:13 AM, Andrew Dunstan <andrew.dunstan@2ndquadrant.com> wrote:
Hi Andrew. I appreciate your interest and efforts here. I hope you don't mind a few questions/observations about this effort:
Not at all.
The
last one fixes the mixture of high and low precedence boolean operators,I did not spot examples of this in your diffs, but I assume you mean to prohibit conditionals like:
if ($a || $b and $c || $d)
As I understand it, perl introduced low precedence operators precisely to allow this. Why disallow it?
The docs say:
Conway advises against combining the low-precedence booleans ( |and
or not| ) with the high-precedence boolean operators ( |&& || !| )
in the same expression. Unless you fully understand the differences
between the high and low-precedence operators, it is easy to
misinterpret expressions that use both. And even if you do
understand them, it is not always clear if the author actually
intended it.
|next| |if| |not ||$foo| ||| ||$bar||; ||#not ok|
|next| |if| |!||$foo| ||| ||$bar||; ||#ok|
|next| |if| |!( ||$foo| ||| ||$bar| |); ||#ok|
I don't feel terribly strongly about it, but personally I just about
never use the low precendence operators, and mostly prefer to resolve
precedence issue with parentheses.
and the use of commas to separate statements
I don't understand the prejudice against commas used this way. What is wrong with:
$i++, $j++ if defined $k;
rather than:
if (defined $k)
{
$i++;
$j++;
}
I don't think the example is terribly clear. I have to look at it and
think "Does it do $i++ if $k isn't defined?"
In the cases we actually have there isn't even any shorthand advantage
like this. There are only a couple of cases.
cheers
andrew
--
Andrew Dunstan https://www.2ndQuadrant.com
PostgreSQL Development, 24x7 Support, Remote DBA, Training & Services
Andrew Dunstan <andrew.dunstan@2ndquadrant.com> writes:
On 4/11/20 12:30 AM, Noah Misch wrote:
In summary, among those warnings, I see non-negative value in "Code before
warnings are enabled" only. While we're changing this, I propose removing
Subroutines::RequireFinalReturn. Implicit return values were not a material
source of PostgreSQL bugs, yet we've allowed this to litter our code:
That doesn't mean it won't be a source of problems in future, I've
actually been bitten by this in the past.
Yeah, as I recall, the reason for the restriction is that if you fall out
without a "return", what's returned is the side-effect value of the last
statement, which might be fairly surprising. Adding explicit "return;"
guarantees an undef result. So when this does prevent a bug it could
be a pretty hard-to-diagnose one. The problem is that it's a really
verbose/pedantic requirement for subs that no one ever examines the
result value of.
Is there a way to modify the test so that it only complains when
the final return is missing and there are other return(s) with values?
That would seem like a more narrowly tailored check.
regards, tom lane
On 4/11/20 12:48 PM, Tom Lane wrote:
Andrew Dunstan <andrew.dunstan@2ndquadrant.com> writes:
On 4/11/20 12:30 AM, Noah Misch wrote:
In summary, among those warnings, I see non-negative value in "Code before
warnings are enabled" only. While we're changing this, I propose removing
Subroutines::RequireFinalReturn. Implicit return values were not a material
source of PostgreSQL bugs, yet we've allowed this to litter our code:That doesn't mean it won't be a source of problems in future, I've
actually been bitten by this in the past.Yeah, as I recall, the reason for the restriction is that if you fall out
without a "return", what's returned is the side-effect value of the last
statement, which might be fairly surprising. Adding explicit "return;"
guarantees an undef result. So when this does prevent a bug it could
be a pretty hard-to-diagnose one. The problem is that it's a really
verbose/pedantic requirement for subs that no one ever examines the
result value of.Is there a way to modify the test so that it only complains when
the final return is missing and there are other return(s) with values?
That would seem like a more narrowly tailored check.
Not AFAICS:
<https://metacpan.org/pod/Perl::Critic::Policy::Subroutines::RequireFinalReturn>
That would probably require writing a replacement module. Looking at the
source if this module I think it might be possible, although I don't
know much of the internals of perlcritic.
cheers
andrew
--
Andrew Dunstan https://www.2ndQuadrant.com
PostgreSQL Development, 24x7 Support, Remote DBA, Training & Services
On Apr 11, 2020, at 9:47 AM, Andrew Dunstan <andrew.dunstan@2ndquadrant.com> wrote:
On 4/11/20 12:28 PM, Mark Dilger wrote:
On Apr 11, 2020, at 9:13 AM, Andrew Dunstan <andrew.dunstan@2ndquadrant.com> wrote:
Hi Andrew. I appreciate your interest and efforts here. I hope you don't mind a few questions/observations about this effort:
Not at all.
The
last one fixes the mixture of high and low precedence boolean operators,I did not spot examples of this in your diffs, but I assume you mean to prohibit conditionals like:
if ($a || $b and $c || $d)
As I understand it, perl introduced low precedence operators precisely to allow this. Why disallow it?
The docs say:
Conway advises against combining the low-precedence booleans ( |and
or not| ) with the high-precedence boolean operators ( |&& || !| )
in the same expression. Unless you fully understand the differences
between the high and low-precedence operators, it is easy to
misinterpret expressions that use both. And even if you do
understand them, it is not always clear if the author actually
intended it.|next| |if| |not ||$foo| ||| ||$bar||; ||#not ok|
|next| |if| |!||$foo| ||| ||$bar||; ||#ok|
|next| |if| |!( ||$foo| ||| ||$bar| |); ||#ok|
I don't think any of those three are ok, from a code review perspective, but it's not because high and low precedence operators were intermixed.
and the use of commas to separate statements
I don't understand the prejudice against commas used this way. What is wrong with:
$i++, $j++ if defined $k;
rather than:
if (defined $k)
{
$i++;
$j++;
}I don't think the example is terribly clear. I have to look at it and
think "Does it do $i++ if $k isn't defined?"
It works like the equivalent C-code:
if (k)
i++, j++;
which to my eyes is also fine.
I'm less concerned with which perlcritic features you enable than I am with accidentally submitting perl which looks fine to me but breaks the build. I mostly use perl from within TAP tests, which I run locally before submission to the project. Can your changes be integrated into the TAP_TESTS makefile target so that I get local errors about this stuff and can fix it before submitting a regression test to -hackers?
—
Mark Dilger
EnterpriseDB: http://www.enterprisedb.com
The Enterprise PostgreSQL Company
Andrew Dunstan <andrew.dunstan@2ndquadrant.com> writes:
On 4/11/20 12:48 PM, Tom Lane wrote:
Is there a way to modify the test so that it only complains when
the final return is missing and there are other return(s) with values?
That would seem like a more narrowly tailored check.
Not AFAICS:
<https://metacpan.org/pod/Perl::Critic::Policy::Subroutines::RequireFinalReturn>
Yeah, the list of all policies in the parent page doesn't offer any
promising alternatives either :-(
BTW, this bit in the policy's man page seems pretty disheartening:
Be careful when fixing problems identified by this Policy; don't
blindly put a return; statement at the end of every subroutine.
since I'd venture that's *exactly* what we've done every time perlcritic
moaned about this. I wonder what else the author expected would happen.
That would probably require writing a replacement module. Looking at the
source if this module I think it might be possible, although I don't
know much of the internals of perlcritic.
I doubt we want to go maintaining our own perlcritic policies; aside from
the effort involved, it'd become that much harder for anyone to reproduce
the results.
regards, tom lane
Mark Dilger <mark.dilger@enterprisedb.com> writes:
I'm less concerned with which perlcritic features you enable than I am with accidentally submitting perl which looks fine to me but breaks the build. I mostly use perl from within TAP tests, which I run locally before submission to the project. Can your changes be integrated into the TAP_TESTS makefile target so that I get local errors about this stuff and can fix it before submitting a regression test to -hackers?
As far as that goes, I think crake is just running
src/tools/perlcheck/pgperlcritic
which you can do for yourself as long as you've got perlcritic
installed.
regards, tom lane
On Sat, Apr 11, 2020 at 11:14:52AM -0400, Tom Lane wrote:
Noah Misch <noah@leadboat.com> writes:
In summary, among those warnings, I see non-negative value in "Code before
warnings are enabled" only. While we're changing this, I propose removing
Subroutines::RequireFinalReturn.If it's possible to turn off just that warning, then +several.
We'd not get that warning if src/tools/perlcheck/pgperlcritic stopped enabling
it by name, so it is possible to turn off by removing lines from that config.
It's routinely caused buildfarm failures, yet I can detect exactly
no value in it. If there were sufficient cross-procedural analysis
backing it to detect whether any caller examines the subroutine's
result value, then it'd be worth having. But there isn't, so those
extra returns are just pedantic verbosity.
Agreed.
On Sat, Apr 11, 2020 at 12:13:08PM -0400, Andrew Dunstan wrote:
--- a/src/tools/msvc/Project.pm +++ b/src/tools/msvc/Project.pm @@ -420,13 +420,10 @@ sub read_file { my $filename = shift; my $F; - my $t = $/; - - undef $/; + local $/ = undef; open($F, '<', $filename) || croak "Could not open file $filename\n"; my $txt = <$F>; close($F); - $/ = $t;
+1 for this and for the other three hunks like it. The resulting code is
shorter and more robust, so this is a good one-time cleanup. It's not
important to mandate this style going forward, so I wouldn't change
perlcriticrc for this one.
--- a/src/tools/version_stamp.pl +++ b/src/tools/version_stamp.pl @@ -1,4 +1,4 @@ -#! /usr/bin/perl -w +#! /usr/bin/perl#################################################################
# version_stamp.pl -- update version stamps throughout the source tree
@@ -21,6 +21,7 @@
#use strict;
+use warnings;
This and the other "use warnings" additions look good. I'm assuming you'd
change perlcriticrc like this:
+[TestingAndDebugging::RequireUseWarnings]
+severity = 5
On Sat, Apr 11, 2020 at 11:15 AM Tom Lane <tgl@sss.pgh.pa.us> wrote:
Noah Misch <noah@leadboat.com> writes:
In summary, among those warnings, I see non-negative value in "Code before
warnings are enabled" only. While we're changing this, I propose removing
Subroutines::RequireFinalReturn.If it's possible to turn off just that warning, then +several.
It's routinely caused buildfarm failures, yet I can detect exactly
no value in it. If there were sufficient cross-procedural analysis
backing it to detect whether any caller examines the subroutine's
result value, then it'd be worth having. But there isn't, so those
extra returns are just pedantic verbosity.
We've actually gone out of our way to enable that particular warning.
See src/tools/perlcheck/perlcriticrc.
The idea of that warning is not entirely without merit, but in
practice it's usually pretty clear whether a function is intended to
return anything or not, and it's unlikely that someone is going to
rely on the return value when they really shouldn't be doing so. I'd
venture to suggest that the language is lax about this sort of thing
precisely because it isn't very important, and thus not worth
bothering users about.
I agree with Noah's comment about CPAN: it would be worth being more
careful about things like this if we were writing code that was likely
to be used by a wide variety of people and a lot of code over which we
have no control and which we do not get to even see. But that's not
the case here. It does not seem worth stressing the authors of TAP
tests over such things.
--
Robert Haas
EnterpriseDB: http://www.enterprisedb.com
The Enterprise PostgreSQL Company
On 4/12/20 3:22 PM, Robert Haas wrote:
On Sat, Apr 11, 2020 at 11:15 AM Tom Lane <tgl@sss.pgh.pa.us> wrote:
Noah Misch <noah@leadboat.com> writes:
In summary, among those warnings, I see non-negative value in "Code before
warnings are enabled" only. While we're changing this, I propose removing
Subroutines::RequireFinalReturn.If it's possible to turn off just that warning, then +several.
It's routinely caused buildfarm failures, yet I can detect exactly
no value in it. If there were sufficient cross-procedural analysis
backing it to detect whether any caller examines the subroutine's
result value, then it'd be worth having. But there isn't, so those
extra returns are just pedantic verbosity.I agree with Noah's comment about CPAN: it would be worth being more
careful about things like this if we were writing code that was likely
to be used by a wide variety of people and a lot of code over which we
have no control and which we do not get to even see. But that's not
the case here. It does not seem worth stressing the authors of TAP
tests over such things.
FWIW, pgBackRest used Perl Critic when we were distributing Perl code
but stopped when our Perl code was only used for integration testing.
Perhaps that was the wrong call but we decided the extra time required
to run it was not worth the benefit. Most new test code is written in C
and the Perl test code is primarily in maintenance mode now.
When we did use Perl Critic we set it at level 1 (--brutal) and then
wrote an exception file for the stuff we wanted to ignore. The advantage
of this is that if new code violated a policy that did not already have
an exception we could evaluate it and either add an exception or modify
the code. In practice this was pretty rare, but we also had a short
excuse for many exceptions and a list of exceptions that should be
re-evaluated in the future.
About the time we introduced Perl Critic we were already considering the
C migration so most of the exceptions stayed.
Just in case it is useful, I have attached our old policy file with
exceptions and excuses (when we had one).
Regards,
--
-David
david@pgmasters.net
Attachments:
On 4/12/20 4:12 PM, David Steele wrote:
On 4/12/20 3:22 PM, Robert Haas wrote:
On Sat, Apr 11, 2020 at 11:15 AM Tom Lane <tgl@sss.pgh.pa.us> wrote:
Noah Misch <noah@leadboat.com> writes:
In summary, among those warnings, I see non-negative value in "Code
before
warnings are enabled" only. While we're changing this, I propose
removing
Subroutines::RequireFinalReturn.If it's possible to turn off just that warning, then +several.
It's routinely caused buildfarm failures, yet I can detect exactly
no value in it. If there were sufficient cross-procedural analysis
backing it to detect whether any caller examines the subroutine's
result value, then it'd be worth having. But there isn't, so those
extra returns are just pedantic verbosity.I agree with Noah's comment about CPAN: it would be worth being more
careful about things like this if we were writing code that was likely
to be used by a wide variety of people and a lot of code over which we
have no control and which we do not get to even see. But that's not
the case here. It does not seem worth stressing the authors of TAP
tests over such things.FWIW, pgBackRest used Perl Critic when we were distributing Perl code
but stopped when our Perl code was only used for integration testing.
Perhaps that was the wrong call but we decided the extra time required
to run it was not worth the benefit. Most new test code is written in
C and the Perl test code is primarily in maintenance mode now.When we did use Perl Critic we set it at level 1 (--brutal) and then
wrote an exception file for the stuff we wanted to ignore. The
advantage of this is that if new code violated a policy that did not
already have an exception we could evaluate it and either add an
exception or modify the code. In practice this was pretty rare, but we
also had a short excuse for many exceptions and a list of exceptions
that should be re-evaluated in the future.About the time we introduced Perl Critic we were already considering
the C migration so most of the exceptions stayed.Just in case it is useful, I have attached our old policy file with
exceptions and excuses (when we had one).
That's a pretty short list for --brutal, well done. I agree there is
value in keeping documented the policies you're not complying with.
Maybe the burden of that is too much for this use, that's up to the
project to decide.
For good or ill we now have a significant investment in perl code - I
just looked and it's 180 files with 38,135 LOC, and that's not counting
the catalog data files, so we have some interest in keeping it fairly clean.
I did something similar to what's above with the buildfarm code,
although on checking now I find it's a bit out of date for the sev 1 and
2 warnings, so I'm fixing that. Having said that, my normal target is
level 3.
The absolutely minimal things I want to do are a) fix the code that
we're agreed on fixing (use of warnings, idiomatic use of $/), and b)
fix the output format to include the name of the policy being violated.
cheers
andrew
--
Andrew Dunstan https://www.2ndQuadrant.com
PostgreSQL Development, 24x7 Support, Remote DBA, Training & Services
On 4/12/20 6:24 PM, Andrew Dunstan wrote:
On 4/12/20 4:12 PM, David Steele wrote:
Just in case it is useful, I have attached our old policy file with
exceptions and excuses (when we had one).That's a pretty short list for --brutal, well done. I agree there is
value in keeping documented the policies you're not complying with.
Maybe the burden of that is too much for this use, that's up to the
project to decide.
Thanks! Perl is, well Perl, and we made a lot of effort to keep it as
clean and consistent as possible.
Obviously I'm +1 on documenting all the exceptions.
For good or ill we now have a significant investment in perl code - I
just looked and it's 180 files with 38,135 LOC, and that's not counting
the catalog data files, so we have some interest in keeping it fairly clean.
Agreed. According to cloc pgBackRest still has 26,744 lines of Perl (not
including comments or whitespace) so we're in the same boat.
The absolutely minimal things I want to do are a) fix the code that
we're agreed on fixing (use of warnings, idiomatic use of $/), and b)
fix the output format to include the name of the policy being violated.
We found limiting results and being very verbose about the violation was
extremely helpful:
perlcritic --quiet --verbose=8 --brutal --top=10 \
--verbose "[%p] %f: %m at line %l, column %c. %e. (Severity: %s)\n"
--profile=test/lint/perlcritic.policy \
<files>
--
-David
david@pgmasters.net
On 4/12/20 3:42 AM, Noah Misch wrote:
On Sat, Apr 11, 2020 at 12:13:08PM -0400, Andrew Dunstan wrote:
--- a/src/tools/msvc/Project.pm +++ b/src/tools/msvc/Project.pm @@ -420,13 +420,10 @@ sub read_file { my $filename = shift; my $F; - my $t = $/; - - undef $/; + local $/ = undef; open($F, '<', $filename) || croak "Could not open file $filename\n"; my $txt = <$F>; close($F); - $/ = $t;+1 for this and for the other three hunks like it. The resulting code is
shorter and more robust, so this is a good one-time cleanup. It's not
important to mandate this style going forward, so I wouldn't change
perlcriticrc for this one.--- a/src/tools/version_stamp.pl +++ b/src/tools/version_stamp.pl @@ -1,4 +1,4 @@ -#! /usr/bin/perl -w +#! /usr/bin/perl#################################################################
# version_stamp.pl -- update version stamps throughout the source tree
@@ -21,6 +21,7 @@
#use strict;
+use warnings;This and the other "use warnings" additions look good. I'm assuming you'd
change perlcriticrc like this:+[TestingAndDebugging::RequireUseWarnings] +severity = 5
OK, I've committed all that stuff. I think that takes care of the
non-controversial part of what I proposed :-)
cheers
andrew
--
Andrew Dunstan https://www.2ndQuadrant.com
PostgreSQL Development, 24x7 Support, Remote DBA, Training & Services
On 4/13/20 12:47 PM, Andrew Dunstan wrote:
OK, I've committed all that stuff. I think that takes care of the
non-controversial part of what I proposed :-)
OK, it seems there is a majority of people commenting in this thread in
favor of not doing more except to reverse the policy of requiring
subroutine returns. I'll do that shortly. In the spirit of David
Steele's contribution, here is a snippet that when added to the
perlcriticrc would allow us to pass at the "brutal" setting (severity
1). But I'm not proposing to add this, it's just here so anyone
interested can see what's involved.
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.
cheers
andrew
--
Andrew Dunstan https://www.2ndQuadrant.com
PostgreSQL Development, 24x7 Support, Remote DBA, Training & Services
Attachments:
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.
--
�lvaro Herrera https://www.2ndQuadrant.com/
PostgreSQL Development, 24x7 Support, Remote DBA, Training & Services
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.patchtext/x-patch; charset=UTF-8; name=pgperlcritic-libraries.patchDownload
diff --git a/src/backend/catalog/Catalog.pm b/src/backend/catalog/Catalog.pm
index 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.pm
index 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.pm
index 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.pm
index 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.pm
index 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.pm
index 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.pm
index 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.pm
index 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.pm
index 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/perlcriticrc
index 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/pgperlcritic
index 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
On Wed, Apr 15, 2020 at 03:43:36PM -0400, Andrew Dunstan wrote:
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.
It would be an unpleasant surprise to cause a perlcritic buildfarm failure by
moving a function, verbatim, from a non-strategic file to a strategic file.
Having two Perl style regimes in one tree is itself a liability.
--- 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;
This policy against unreferenced groups makes the code harder to read, and the
chance of preventing a bug is too low to justify that.
--- 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'
I don't find these files to be especially strategic, and I'm mostly shrugging
about the stricter policy's effect on code quality. -1 for this patch.
On 4/15/20 11:01 PM, Noah Misch wrote:
On Wed, Apr 15, 2020 at 03:43:36PM -0400, Andrew Dunstan wrote:
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.It would be an unpleasant surprise to cause a perlcritic buildfarm failure by
moving a function, verbatim, from a non-strategic file to a strategic file.
Having two Perl style regimes in one tree is itself a liability.
Honestly, I think you're reaching here.
--- 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;This policy against unreferenced groups makes the code harder to read, and the
chance of preventing a bug is too low to justify that.
Non-capturing groups are also more efficient, and are something perl
programmers should be familiar with.
In fact, there's a much better renovation of semantics of this
particular instance, which is to make . match \n using the s modifier:
s;/\*.*\*/;;gs;
It would also be more robust using non-greedy matching:
s;/\*.*?\*/;;gs
After I wrote the above I went and looked at what we do the buildfarm
code to strip comments when looking for typedefs, and it's exactly that,
so at least I'm consistent :-)
I don't care that much if we throw this whole thing away. This was sent
in response to Alvaro's suggestion to "give it a try and see what comes up".
cheers
andrew
--
Andrew Dunstan https://www.2ndQuadrant.com
PostgreSQL Development, 24x7 Support, Remote DBA, Training & Services
Andrew Dunstan <andrew.dunstan@2ndquadrant.com> writes:
On 4/15/20 11:01 PM, Noah Misch wrote:
It would be an unpleasant surprise to cause a perlcritic buildfarm failure by
moving a function, verbatim, from a non-strategic file to a strategic file.
Having two Perl style regimes in one tree is itself a liability.
Honestly, I think you're reaching here.
I think that argument is wrong, actually. Moving a function from a single
use-case into a library (with, clearly, the intention for it to have more
use-cases) is precisely the time when any weaknesses in its original
implementation might be exposed. So extra scrutiny seems well warranted.
Whether the "extra scrutiny" involved in perlcritic's higher levels
is actually worth anything is a different debate, though, and so far
it's not looking like it's worth much :-(
regards, tom lane
On Thu, Apr 16, 2020 at 08:50:35AM -0400, Andrew Dunstan wrote:
It would also be more robust using non-greedy matching:
This seems more important.
I don't know how/where this is being used, but if it has input like:
/* one */
something;
/* two */
With the old expression 'something;' would be stripped away.
Is that an issue where this this is used? Why are we parsing
these headers?
Garick
On 4/16/20 10:20 AM, Hamlin, Garick L wrote:
On Thu, Apr 16, 2020 at 08:50:35AM -0400, Andrew Dunstan wrote:
It would also be more robust using non-greedy matching:
This seems more important.
I don't know how/where this is being used, but if it has input like:/* one */
something;
/* two */With the old expression 'something;' would be stripped away.
Is that an issue where this this is used? Why are we parsing
these headers?
It's not quite as bad as that, because we're doing it line by line
rather than on a whole file that's been slurped in. Multiline comments
are handled using some redo logic. But
/* one */ something(); /* two */
would all be removed. Of course, we hope we don't have anything so
horrible, but still ...
cheers
andrew
--
Andrew Dunstan https://www.2ndQuadrant.com
PostgreSQL Development, 24x7 Support, Remote DBA, Training & Services
On 2020-Apr-16, Hamlin, Garick L wrote:
With the old expression 'something;' would be stripped away.
Is that an issue where this this is used? Why are we parsing
these headers?
These are files from which bootstrap catalog data is generated, which is
why we parse from Perl; but also where C structs are declared, which is
why they're C.
I think switching to non-greedy is a win in itself. Non-capturing
parens is probably a wash (this doesn't run often so the performance
argument isn't very interesting).
An example. This eval in Catalog.pm
+ ## no critic (ProhibitStringyEval)
+ ## no critic (RequireCheckingReturnValueOfEval)
+ eval '$hash_ref = ' . $_;
is really weird stuff generally speaking, and the fact that we have to
mark it specially for critic is a good indicator of that -- it serves as
documentation. Catalog.pm is all a huge weird hack, but it's a critically
important hack. Heck, what about RequireCheckingReturnValueOfEval --
should we instead consider actually checking the return value of eval?
It would seem to make sense, would it not? (Not for this patch, though
-- I would be fine with just adding the nocritic line now, and removing
it later while fixing that).
All in all, I think it's a positive value in having this code be checked
with a bit more strength -- checks that are pointless in, say, t/00*.pl
prove files.
--
�lvaro Herrera https://www.2ndQuadrant.com/
PostgreSQL Development, 24x7 Support, Remote DBA, Training & Services
On 4/16/20 11:12 AM, Alvaro Herrera wrote:
On 2020-Apr-16, Hamlin, Garick L wrote:
With the old expression 'something;' would be stripped away.
Is that an issue where this this is used? Why are we parsing
these headers?These are files from which bootstrap catalog data is generated, which is
why we parse from Perl; but also where C structs are declared, which is
why they're C.I think switching to non-greedy is a win in itself. Non-capturing
parens is probably a wash (this doesn't run often so the performance
argument isn't very interesting).
Yeah, I'm inclined to fix this independently of the perlcritic stuff.
The change is more readable and more correct as well as being perlcritic
friendly.
I might take a closer look at Catalog.pm.
Meanwhile, the other regex highlighted in the patch, in Solution.pm:
if (/^AC_INIT\(\[([^\]]+)\], \[([^\]]+)\], \[([^\]]+)\], \[([^\]]*)\],
\[([^\]]+)\]/)
is sufficiently horrid that I think we should see if we can rewrite it,
maybe as an extended regex. And a better fix here instead of marking the
fourth group as non-capturing would be simply to get rid of the parens
altogether. The serve no purpose at all.
An example. This eval in Catalog.pm
+ ## no critic (ProhibitStringyEval) + ## no critic (RequireCheckingReturnValueOfEval) + eval '$hash_ref = ' . $_;is really weird stuff generally speaking, and the fact that we have to
mark it specially for critic is a good indicator of that -- it serves as
documentation. Catalog.pm is all a huge weird hack, but it's a critically
important hack. Heck, what about RequireCheckingReturnValueOfEval --
should we instead consider actually checking the return value of eval?
It would seem to make sense, would it not? (Not for this patch, though
-- I would be fine with just adding the nocritic line now, and removing
it later while fixing that).
+1
All in all, I think it's a positive value in having this code be checked
with a bit more strength -- checks that are pointless in, say, t/00*.pl
prove files.
thanks
cheers
andrew
--
Andrew Dunstan https://www.2ndQuadrant.com
PostgreSQL Development, 24x7 Support, Remote DBA, Training & Services
On Apr 16, 2020, at 2:07 PM, Andrew Dunstan <andrew.dunstan@2ndquadrant.com> wrote:
On 4/16/20 11:12 AM, Alvaro Herrera wrote:
On 2020-Apr-16, Hamlin, Garick L wrote:
With the old expression 'something;' would be stripped away.
Is that an issue where this this is used? Why are we parsing
these headers?These are files from which bootstrap catalog data is generated, which is
why we parse from Perl; but also where C structs are declared, which is
why they're C.I think switching to non-greedy is a win in itself. Non-capturing
parens is probably a wash (this doesn't run often so the performance
argument isn't very interesting).Yeah, I'm inclined to fix this independently of the perlcritic stuff.
The change is more readable and more correct as well as being perlcritic
friendly.I might take a closer look at Catalog.pm.
Meanwhile, the other regex highlighted in the patch, in Solution.pm:
if (/^AC_INIT\(\[([^\]]+)\], \[([^\]]+)\], \[([^\]]+)\], \[([^\]]*)\],
\[([^\]]+)\]/)is sufficiently horrid that I think we should see if we can rewrite it,
my $re = qr/
\[ # literal opening bracket
( # Capture anything but a closing bracket
(?> # without backtracking
[^\]]+
)
)
\] # literal closing bracket
/x;
if (/^AC_INIT\($re, $re, $re, $re, $re/)
maybe as an extended regex. And a better fix here instead of marking the
fourth group as non-capturing would be simply to get rid of the parens
altogether. The serve no purpose at all.
But then you'd have to use something else in position 4, which complicates the code.
—
Mark Dilger
EnterpriseDB: http://www.enterprisedb.com
The Enterprise PostgreSQL Company
On Thu, Apr 16, 2020 at 09:53:46AM -0400, Tom Lane wrote:
Andrew Dunstan <andrew.dunstan@2ndquadrant.com> writes:
On 4/15/20 11:01 PM, Noah Misch wrote:
It would be an unpleasant surprise to cause a perlcritic buildfarm failure by
moving a function, verbatim, from a non-strategic file to a strategic file.
Having two Perl style regimes in one tree is itself a liability.Honestly, I think you're reaching here.
I think that argument is wrong, actually. Moving a function from a single
use-case into a library (with, clearly, the intention for it to have more
use-cases) is precisely the time when any weaknesses in its original
implementation might be exposed. So extra scrutiny seems well warranted.
Moving a function to a library does call for various scrutiny. I don't think
it calls for replacing "no warnings;" with "no warnings; ## no critic", but
that observation is subordinate to your other point:
Whether the "extra scrutiny" involved in perlcritic's higher levels
is actually worth anything is a different debate, though, and so far
it's not looking like it's worth much :-(
Yeah, this is the central point. Many proposed style conformance changes are
(a) double-entry bookkeeping to emphasize the author's sincerity and (b) regex
performance optimization. Those are not better for libraries than for
non-libraries, and I think they decrease code quality.
Even if such policies were better for libraries, the proposed patch applies
them to .pm files with narrow audiences. If DBD::Pg were in this tree, that
would be a different conversation.