use strict;
my $this_program = __FILE__;
(my $test_file_name = $this_program) =~ s/[.]PL\Z/.t/ms;
if ($this_program eq $test_file_name) {
die "Was not able to figure out the name of the file to generate. This program: $this_program.";
}
print "\n\nGenerating $test_file_name.\n";
open my $test_file, '>', $test_file_name or die "Could not open $test_file_name: $!";
print {$test_file} "# Do not edit!!! This test suite generated by $this_program.\n";
print {$test_file} <<'END_CODE';
use strict;
use warnings;
use Perl::Lint::Policy::ControlStructures::ProhibitNegativeExpressionsInUnlessAndUntilConditions;
use t::Policy::Util qw/fetch_violations/;
use Test::Base::Less;
my $class_name = 'ControlStructures::ProhibitNegativeExpressionsInUnlessAndUntilConditions';
filters {
params => [qw/eval/],
};
for my $block (blocks) {
my $violations = fetch_violations($class_name, $block->input, $block->params);
is scalar @$violations, $block->failures, $block->dscr;
}
done_testing;
__DATA__
END_CODE
foreach my $operator ( qw/ ! not / ) {
emit_not_operator_code($test_file, $operator);
}
foreach my $operator ( qw/ ne != < > <= >= <=> lt gt le ge cmp / ) {
emit_comparator_code($test_file, $operator);
}
emit_not_match_code($test_file);
foreach my $operator ( qw/ ne != < > <= >= <=> lt gt le ge cmp / ) {
emit_comparator_code($test_file, $operator);
}
close $test_file;
print "Done.\n\n";
#-----------------------------------------------------------------------------
sub emit_not_operator_code {
my ($test_file, $operator) = @_;
print {$test_file} <<"END_NOT_OPERATOR_CODE";
===
--- dscr: "$operator" within positive control structures
--- failures: 0
--- params:
--- input
if ($operator \$foo) {
blah();
}
if (\$foo) {
blah(\$foo);
}
elsif ($operator \$bar) {
blah(\$bar);
}
else {
blah(undef);
}
while ($operator \$foo) {
blah();
}
foreach my \$bar ( grep { $operator \$_ } \@foo ) {
blah(\$bar);
}
for (my \$bar = 0; $operator \$bar; \$bar++) {
blah(\$bar);
}
===
--- dscr: "$operator" within positive postfix statement modifiers
--- failures: 0
--- params:
--- input
blah() if $operator \$foo;
blah() while $operator \$foo;
blah(\$_) for grep { $operator \$_ } \@foo;
===
--- dscr: "$operator" within negative control structures
--- failures: 2
--- params:
--- input
unless ($operator \$foo) {
blah();
}
until ($operator \$foo) {
blah();
}
===
--- dscr: "$operator" within negative postfix statement modifiers
--- failures: 2
--- params:
--- input
blah() unless $operator \$foo;
blah() until $operator \$foo;
END_NOT_OPERATOR_CODE
return;
}
sub emit_not_match_code {
my ($test_file) = @_;
print {$test_file} <<'END_NOT_MATCH_CODE';
===
--- dscr: "!~" within positive control structures
--- failures: 0
--- params:
--- input
if ($foo !~ m/bar/) {
blah();
}
if ($foo) {
blah($foo);
}
elsif ($bar !~ m/bar/) {
blah($bar);
}
else {
blah(undef);
}
while ($foo !~ m/bar/) {
blah();
}
foreach my $bar ( grep { $_ !~ m/baz/ } @foo ) {
blah($bar);
}
for (my $bar = 0; $bar =~ m/baz/; $bar++) {
blah($bar);
}
===
--- dscr: "!~" within positive postfix statement modifiers
--- failures: 0
--- params:
--- input
blah() if $foo !~ m/bar/;
blah() while $foo !~ m/bar/;
blah($_) for grep { $_ !~ m/bar/ } @foo;
===
--- dscr: "!~" within negative control structures
--- failures: 2
--- params:
--- input
unless ($foo !~ m/bar/) {
blah();
}
until ($foo !~ m/bar/) {
blah();
}
===
--- dscr: "!~" within negative postfix statement modifiers
--- failures: 2
--- params:
--- input
blah() unless $foo !~ m/bar/;
blah() until $foo !~ m/bar/;
END_NOT_MATCH_CODE
return;
}
sub emit_comparator_code {
my ($test_file, $operator) = @_;
print {$test_file} <<"END_COMPARATOR_CODE";
===
--- dscr: "$operator" within positive control structures
--- failures: 0
--- params:
--- input
if (\$foo $operator \$bar) {
blah();
}
if (\$foo $operator \$bar) {
blah(\$foo);
}
elsif (\$bar $operator \$baz) {
blah(\$bar);
}
else {
blah(undef);
}
while (\$foo $operator \$bar) {
blah();
}
foreach my \$bar ( grep { \$_ $operator \$baz } \@foo ) {
blah(\$bar);
}
for (my \$bar = 0; \$bar $operator \$baz; \$bar++) {
blah(\$bar);
}
===
--- dscr: "$operator" within positive postfix statement modifiers
--- failures: 0
--- params:
--- input
blah() if \$foo $operator \$bar;
blah() while \$foo $operator \$bar;
blah(\$_) for grep { \$_ $operator \$bar } \@foo;
===
--- dscr: "$operator" within negative control structures
--- failures: 2
--- params:
--- input
unless (\$foo $operator \$bar) {
blah();
}
until (\$foo $operator \$bar) {
blah();
}
===
--- dscr: "$operator" within negative postfix statement modifiers
--- failures: 2
--- params:
--- input
blah() unless \$foo $operator \$bar;
blah() until \$foo $operator \$bar;
END_COMPARATOR_CODE
return;
}