Merge pull request #54 from perlpunk/perlcritic-plugins

Fix and test perlcritic plugins

.github/workflows/test.yaml

@@ -0,0 +1,13 @@
+---
+name: 'Unit Tests'
+
+on: [push, pull_request]
+
+jobs:
+  test:
+    runs-on: ubuntu-latest
+    container:
+      image: perldocker/perl-tester
+    steps:
+      - uses: actions/checkout@v4
+      - run: make test-t

.perlcriticrc

@@ -41,9 +41,9 @@ severity = 1
 
 # == Custom Policies
 # -- Useless quotes on hashes
-[HashKeyQuotes]
+[OpenQA::HashKeyQuotes]
 severity = 5
 
 # -- Superfluous use strict/warning.
-[RedundantStrictWarning]
+[OpenQA::RedundantStrictWarning]
 equivalent_modules = Test::Most

Makefile

@@ -8,7 +8,7 @@ update-deps:
 	tools/update-deps --cpanfile cpanfile
 
 .PHONY: test
-test: test-tidy test-critic test-yaml test-author
+test: test-tidy test-critic test-yaml test-author test-t
 
 .PHONY: test-tidy
 test-tidy:
@@ -25,3 +25,7 @@ test-yaml:
 .PHONY: test-author
 test-author:
 	prove -l -r xt/
+
+.PHONY: test-t
+test-t:
+	prove -l -r t/

lib/perlcritic/Perl/Critic/Policy/ArgumentInUseStrictWarnings.pm → lib/perlcritic/Perl/Critic/Policy/OpenQA/ArgumentInUseStrictWarnings.pm

@@ -1,7 +1,7 @@
 # Copyright SUSE LLC
 # SPDX-License-Identifier: GPL-2.0-or-later
 
-package Perl::Critic::Policy::ArgumentInUseStrictWarnings;
+package Perl::Critic::Policy::OpenQA::ArgumentInUseStrictWarnings;
 
 use strict;
 use warnings;

lib/perlcritic/Perl/Critic/Policy/HashKeyQuotes.pm → lib/perlcritic/Perl/Critic/Policy/OpenQA/HashKeyQuotes.pm

@@ -1,7 +1,7 @@
 # Copyright SUSE LLC
 # SPDX-License-Identifier: GPL-2.0-or-later
 
-package Perl::Critic::Policy::HashKeyQuotes;
+package Perl::Critic::Policy::OpenQA::HashKeyQuotes;
 
 use strict;
 use warnings;
@@ -22,6 +22,8 @@ sub applies_to { return qw(PPI::Token::Quote::Single PPI::Token::Quote::Double)
 sub violates ($self, $elem, $document) {
     # skip anything that's not a hash key
     return () unless is_hash_key($elem);
+    # skip if it has a sibling, e.g. $h{'foo' . 'bar'}
+    return () if $elem->snext_sibling or $elem->sprevious_sibling;
 
     # only some PPI::Token::Quote::* classes implement literal
     my $k = $elem->can('literal') ? $elem->literal : $elem->string;

lib/perlcritic/Perl/Critic/Policy/RedundantStrictWarning.pm → lib/perlcritic/Perl/Critic/Policy/OpenQA/RedundantStrictWarning.pm

@@ -1,7 +1,7 @@
 # Copyright SUSE LLC
 # SPDX-License-Identifier: GPL-2.0-or-later
 
-package Perl::Critic::Policy::RedundantStrictWarning;
+package Perl::Critic::Policy::OpenQA::RedundantStrictWarning;
 
 use strict;
 use warnings;

lib/perlcritic/Perl/Critic/Policy/SpaceAfterSubroutineName.pm → lib/perlcritic/Perl/Critic/Policy/OpenQA/SpaceAfterSubroutineName.pm

@@ -1,7 +1,7 @@
 # Copyright SUSE LLC
 # SPDX-License-Identifier: GPL-2.0-or-later
 
-package Perl::Critic::Policy::SpaceAfterSubroutineName;
+package Perl::Critic::Policy::OpenQA::SpaceAfterSubroutineName;
 
 use strict;
 use warnings;
@@ -68,6 +68,8 @@ sub check_complete_sub ($self, $elem, @tokens) {
     #   5. Whitespace - must be 1
     #   6. Structure - the actual code block
 
+    my $nsib = $elem->snext_sibling;
+    my $psib = $elem->sprevious_sibling;
     return () if _is_surrounded_by_one_space($tokens[2]) && _is_surrounded_by_one_space($tokens[4]);
     return $self->report_violation($elem);
 }
@@ -77,7 +79,8 @@ sub _is_block ($token) {
 }
 
 sub _is_only_one_space ($token) {
-    return $token->isa('PPI::Token::Whitespace') && $token->content eq ' ';
+    # We also allow line breaks, e.g. perltidy forces to break up long subroutine headers
+    return $token->isa('PPI::Token::Whitespace') && $token->content =~ m/^[ \n]$/;
 }
 
 sub _is_surrounded_by_one_space ($token) {

t/10-perlcritic.t

@@ -0,0 +1,11 @@
+#!/usr/bin/perl
+# Copyright SUSE LLC
+# SPDX-License-Identifier: GPL-2.0-or-later
+
+use strict;
+use warnings;
+use FindBin '$Bin';
+use lib "$Bin/../lib/perlcritic";
+use Test::Perl::Critic::Policy qw/ all_policies_ok /;
+
+all_policies_ok();

t/OpenQA/ArgumentInUseStrictWarnings.run

@@ -0,0 +1,12 @@
+## name Passing
+## failures 0
+## cut
+
+use strict;
+use warnings;
+
+## name Failing
+## failures 1
+## cut
+
+use warnings 'redefined';

t/OpenQA/HashKeyQuotes.run

@@ -0,0 +1,19 @@
+my %h;
+## name Passing
+## failures 0
+## cut
+
+$h{bare} = 1;
+$h{"line\nbreak"} = 2;
+$h{'special!'} = 3;
+$h{'concatenate_' . 'strings'} = 4;
+$h{bare2 } = 5;
+
+## name Failing
+## failures 4
+## cut
+
+$h{'single'} = 1;
+$h{  'single'  } = 2;
+$h{"double"} = 3;
+$h{"double2" } = 4;

t/OpenQA/RedundantStrictWarning.run

@@ -0,0 +1,16 @@
+## name Passing
+## failures 0
+## cut
+
+use Mojo::Base 'DBIx::Class::Core';
+
+## name Passing
+## failures 0
+## TODO It can be neessary to use two modules that both enable strict
+## cut
+
+use Mojo::Base 'DBIx::Class::Core';
+
+use Moose;
+extends 'OpenQA::Schema::Result::Jobs';
+

t/OpenQA/SpaceAfterSubroutineName.run

@@ -0,0 +1,31 @@
+## name Passing
+## failures 0
+## cut
+
+sub long ($self, $jobid, $job_labels, $aggregated, $failed_modules, $actually_failed_modules,
+    $todo = undef)
+{
+}
+
+sub long2
+($x, $y) {
+}
+
+sub a ($x) {
+}
+
+## name Failing
+## failures 4
+## cut
+
+sub foo($x) {
+}
+
+sub foo ($x){
+}
+
+sub foo  ($x) {
+}
+
+sub foo ($x)  {
+}