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
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);
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;
$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},
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,
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/;
##################################################
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;
}
}
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{
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};
use File::Slurp qw/write_file/;
use Log::Log4perl qw/get_logger/;
-our $VERSION = "5999.000_004";
+our $VERSION = '5999.000_004';
##################################################
use Log::Log4perl qw/get_logger/;
-our $VERSION = "5999.000_004";
+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)
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';
##################################################
$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
}
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;
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/;
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';
}
--- /dev/null
+#!/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
--- /dev/null
+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