Add perlcritic test and make code comply
authorMarius Gavrilescu <marius@ieval.ro>
Thu, 22 Jan 2015 22:18:09 +0000 (00:18 +0200)
committerMarius Gavrilescu <marius@ieval.ro>
Thu, 22 Jan 2015 22:18:15 +0000 (00:18 +0200)
12 files changed:
MANIFEST
lib/Gruntmaster/Daemon.pm
lib/Gruntmaster/Daemon/Constants.pm
lib/Gruntmaster/Daemon/Format.pm
lib/Gruntmaster/Daemon/Generator/File.pm
lib/Gruntmaster/Daemon/Generator/Undef.pm
lib/Gruntmaster/Daemon/Judge/Points.pm
lib/Gruntmaster/Daemon/Runner/File.pm
lib/Gruntmaster/Daemon/Runner/Interactive.pm
lib/Gruntmaster/Daemon/Runner/Verifier.pm
t/perlcritic.t [new file with mode: 0644]
t/perlcriticrc [new file with mode: 0644]

index d3f7e1b..469cb5d 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -25,6 +25,8 @@ selinux/gruntmasterd.fc
 selinux/gruntmasterd.te
 t/00-compile.t
 t/01-jobs.t
+t/perlcriticrc
+t/perlcritic.t
 t/problems/aminusb/1.in
 t/problems/aminusb/2.in
 t/problems/aminusb/3.in
index 1d1ca01..64f8231 100644 (file)
@@ -40,8 +40,7 @@ my $db;
 sub safe_can_nodie {
        my ($type, $sub, $name) = @_;
 
-       return unless $name =~ /^\w+$/;
-       no strict 'refs';
+       return unless $name =~ /^\w+$/s;
        my $pkg = __PACKAGE__ . "::${type}::${name}";
        eval "require $pkg" or get_logger->warn("Error while requiring $pkg: $@");
        $pkg->can($sub);
@@ -87,7 +86,7 @@ sub process{
                prepare_files $meta;
                chomp $errors;
 
-               my ($files, $generator, $runner, $judge, $testcnt) = map { $meta->{$_} or die "Required parameter missing: $_"} qw/files generator runner judge testcnt/;
+               my ($files, $generator, $runner, $judge, $testcnt) = map { $meta->{$_} or die "Required parameter missing: $_\n"} qw/files generator runner judge testcnt/;
 
                $generator = safe_can Generator => generate => $generator;
                $runner = safe_can Runner => run => $runner;
@@ -122,14 +121,14 @@ sub process{
                $meta->{$_} = $results{$_} for keys %results;
                $meta->{results} = \@full_results
        } catch {
-               s,(.*) at .*,$1,;
+               s/(.*) at .*/$1/s;
                chomp;
                $meta->{result} = -1;
                $meta->{result_text} = $_;
        };
        stopvms;
 
-       get_logger->info("Job result: " . $meta->{result_text});
+       get_logger->info('Job result: ' . $meta->{result_text});
        return unless $jobr;
        $jobr->update({
                result => $meta->{result},
index c64f57a..0ffe114 100644 (file)
@@ -5,9 +5,9 @@ use strict;
 use warnings;
 use parent qw/Exporter/;
 
-our $VERSION = "5999.000_004";
+our $VERSION = '5999.000_004';
 
-use constant +{
+use constant +{ ## no critic (Capitalization)
        # Accepted
        AC => 0,
 
index 5f503a1..a51b6cb 100644 (file)
@@ -15,7 +15,7 @@ use POSIX qw/mkfifo/;
 use String::ShellQuote qw/shell_quote/;
 use Try::Tiny;
 
-our $VERSION = "5999.000_004";
+our $VERSION = '5999.000_004';
 our @EXPORT_OK = qw/prepare_files stopvms/;
 
 ##################################################
@@ -47,11 +47,11 @@ sub execlist {
                get_logger->trace("Running in VM $vm: $cmd");
                $vm{$vm}->send($cmd);
        } else {
-               my $ret = fork // die 'Cannot fork';
+               my $ret = fork // die "Cannot fork\n";
                if ($ret) {
                        waitpid $ret, 0;
                } else {
-                       open STDOUT, ">$er";
+                       open STDOUT, '>', $er or die "Cannot open $er\n";
                        exec 'gruntmaster-exec', @args;
                }
        }
@@ -59,9 +59,9 @@ sub execlist {
        die "gruntmaster-exec died\n" if -z $er;
        my ($excode, $exmsg) = read_file $er;
        unlink $er;
-       chomp ($excode, $exmsg);
+       chomp ($excode, $exmsg); ## no critic (ProhibitParensWithBuiltins)
        get_logger->trace("Exec result: $excode $exmsg");
-       die [$excode, $exmsg] if $excode > 0;
+       die [$excode, $exmsg] if $excode > 0; ## no critic (RequireCarping)
 }
 
 sub command_and_args{
@@ -83,7 +83,7 @@ sub mkrun{
                local *__ANON__ = 'mkrun_runner';
                my ($name, %args) = @_;
                get_logger->trace("Running $name...");
-               my $basename = fileparse $name, qr/\.[^.]*/;
+               my $basename = fileparse $name, qr/[.][^.]*/s;
                my @args;
                push @args, '--timeout', $args{timeout} if $args{timeout};
                push @args, '--mlimit',  $args{mlimit}  if $args{mlimit};
index be10f26..c5023a7 100644 (file)
@@ -8,7 +8,7 @@ use File::Copy qw/copy/;
 use File::Slurp qw/write_file/;
 use Log::Log4perl qw/get_logger/;
 
-our $VERSION = "5999.000_004";
+our $VERSION = '5999.000_004';
 
 ##################################################
 
index 649a5d8..3a30f7a 100644 (file)
@@ -6,7 +6,7 @@ use warnings;
 
 use Log::Log4perl qw/get_logger/;
 
-our $VERSION = "5999.000_004";
+our $VERSION = '5999.000_004';
 
 ##################################################
 
index 26c19f9..66286b2 100644 (file)
@@ -13,7 +13,7 @@ our $VERSION = '5999.000_004';
 ##################################################
 
 sub judge{
-       no warnings qw/numeric/;
+       no warnings qw/numeric/; ## no critic (ProhibitNoWarnings)
        get_logger->trace("Judging results: @_");
        my $points = sum 0, grep { !ref } @_;
        $points == 100 ? (result => AC, result_text => 'Accepted') : (result => REJ, result_text => "$points points", points => $points)
index a79500c..386b02c 100644 (file)
@@ -3,12 +3,13 @@ package Gruntmaster::Daemon::Runner::File;
 use 5.014000;
 use strict;
 use warnings;
+use re '/s';
 
 use Gruntmaster::Daemon::Constants qw/WA/;
 use File::Slurp qw/slurp/;
 use Log::Log4perl qw/get_logger/;
 
-our $VERSION = "5999.000_004";
+our $VERSION = '5999.000_004';
 
 ##################################################
 
@@ -31,7 +32,7 @@ sub run{
        $out =~ s/\s+$//;
        $ok  =~ s/\s+$//;
 
-       die [WA, "Wrong answer"] if $out ne $ok;
+       die [WA, 'Wrong answer'] if $out ne $ok; ## no critic (RequireCarping)
        $meta->{tests}[$test - 1] // 0
 }
 
index 1825fcd..dfdf95b 100644 (file)
@@ -18,8 +18,8 @@ sub run{
        my ($test, $meta) = @_;
        get_logger->trace("Running on test $test...");
 
-       mkfifo 'fifo1', 0600 or die $! unless -e 'fifo1';
-       mkfifo 'fifo2', 0600 or die $! unless -e 'fifo2';
+       mkfifo 'fifo1', 0600 or die "$!\n" unless -e 'fifo1';
+       mkfifo 'fifo2', 0600 or die "$!\n" unless -e 'fifo2';
 
        if ($test == 1 && $ENV{GRUNTMASTER_VM}) {
                exec 'cat <prog.out >ver.in' if fork;
@@ -32,11 +32,11 @@ sub run{
                        my @fds = $ENV{GRUNTMASTER_VM} ? qw,0 /dev/ttyS1 1 >/dev/ttyS1, : qw/0 fifo1 1 >fifo2/;
                        $meta->{files}{prog}{run}->($meta->{files}{prog}{name}, fds => \@fds, map {defined $meta->{$_} ? ($_ => $meta->{$_}) : () } qw/timeout mlimit/);
                } catch {
-                       die $_
+                       die $_ ## no critic (RequireCarping)
                } finally {
                        waitpid $ret, 0;
                };
-               die [WA, "Wrong Answer"] if $?;
+               die [WA, 'Wrong Answer'] if $?; ## no critic (RequireCarping)
        } else {
                try {
                        my @fds = $ENV{GRUNTMASTER_VM} ? qw,1 >/dev/ttyS1 0 /dev/ttyS1, : qw/1 >fifo1 0 fifo2/;
index fd267cd..7111f6b 100644 (file)
@@ -21,7 +21,7 @@ sub run{
        try {
                $meta->{files}{ver}{run}->($meta->{files}{ver}{name}, fds => [qw/0 input 3 output 1 >result/], args => [$test]);
        } catch {
-               die [WA, "Wrong answer"]
+               die [WA, 'Wrong answer'] ## no critic (RequireCarping)
        };
        scalar slurp 'result';
 }
diff --git a/t/perlcritic.t b/t/perlcritic.t
new file mode 100644 (file)
index 0000000..51bad9d
--- /dev/null
@@ -0,0 +1,10 @@
+#!/usr/bin/perl
+use v5.14;
+use warnings;
+
+use Test::More;
+
+BEGIN { plan skip_all => '$ENV{RELEASE_TESTING} is false' unless $ENV{RELEASE_TESTING} }
+use Test::Perl::Critic -profile => 't/perlcriticrc';
+
+all_critic_ok
diff --git a/t/perlcriticrc b/t/perlcriticrc
new file mode 100644 (file)
index 0000000..96564fe
--- /dev/null
@@ -0,0 +1,35 @@
+severity = 1
+
+[-BuiltinFunctions::ProhibitComplexMappings]
+[-CodeLayout::RequireTidyCode]
+[-ControlStructures::ProhibitPostfixControls]
+[-ControlStructures::ProhibitUnlessBlocks]
+[-Documentation::PodSpelling]
+[-Documentation::RequirePodLinksIncludeText]
+[-InputOutput::RequireBracedFileHandleWithPrint]
+[-References::ProhibitDoubleSigils]
+[-RegularExpressions::ProhibitEnumeratedClasses]
+[-RegularExpressions::RequireLineBoundaryMatching]
+[-Subroutines::RequireFinalReturn]
+[-ValuesAndExpressions::ProhibitConstantPragma]
+[-ValuesAndExpressions::ProhibitEmptyQuotes]
+[-ValuesAndExpressions::ProhibitLeadingZeros]
+[-ValuesAndExpressions::ProhibitMagicNumbers]
+[-ValuesAndExpressions::ProhibitNoisyQuotes]
+[-Variables::ProhibitLocalVars]
+[-Variables::ProhibitPackageVars]
+[-Variables::ProhibitPunctuationVars]
+
+[BuiltinFunctions::ProhibitStringyEval]
+allow_includes = 1
+
+[RegularExpressions::RequireExtendedFormatting]
+minimum_regex_length_to_complain_about = 20
+
+[Documentation::RequirePodSections]
+lib_sections = NAME | SYNOPSIS | DESCRIPTION | AUTHOR | COPYRIGHT AND LICENSE
+script_sections = NAME | SYNOPSIS | DESCRIPTION | AUTHOR | COPYRIGHT AND LICENSE
+
+[Subroutines::RequireArgUnpacking]
+short_subroutine_statements = 5
+allow_subscripts = 1
This page took 0.044767 seconds and 4 git commands to generate.