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
;
}