#!/usr/bin/env perl
use 5.006001;
use Fatal qw< open close >;our $VERSION = '1.107_001';
my $this_program = __FILE__;
(my $test_file_name = $this_program) =~ s/ [.] PL \z //xms;
if ($this_program eq $test_file_name) {
confess
'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 confess "Could not open $test_file_name: $ERRNO";
print {$test_file} <<"END_HEADER";
# Do not edit!!! This test suite generated by $this_program.
END_HEADER
foreach my $operator ( qw/ ! not / ) {
emit_not_operator_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);
}
print {$test_file} <<'END_FOOTER';
#-----------------------------------------------------------------------------
##############################################################################
# $Date: 2010-06-13 18:26:31 -0500 (Sun, 13 Jun 2010) $
# $Author: clonezone $
# $Revision: 3824 $
##############################################################################
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
# fill-column: 78
# indent-tabs-mode: nil
# c-indentation-style: bsd
# End:
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
END_FOOTER
close $test_file;
print "Done.\n\n";
sub emit_not_operator_code {
my ($test_file, $operator) = @_;
print {$test_file} <<"END_NOT_OPERATOR_CODE";
## name "$operator" within positive control structures
## failures 0
## cut
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);
}
#-----------------------------------------------------------------------------
## name "$operator" within positive postfix statement modifiers
## failures 0
## cut
blah() if $operator \$foo;
blah() while $operator \$foo;
blah(\$_) for grep { $operator \$_ } \@foo;
#-----------------------------------------------------------------------------
## name "$operator" within negative control structures
## failures 2
## cut
unless ($operator \$foo) {
blah();
}
until ($operator \$foo) {
blah();
}
#-----------------------------------------------------------------------------
## name "$operator" within negative postfix statement modifiers
## failures 2
## cut
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';
## name "!~" within positive control structures
## failures 0
## cut
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);
}
#-----------------------------------------------------------------------------
## name "!~" within positive postfix statement modifiers
## failures 0
## cut
blah() if $foo !~ m/bar/;
blah() while $foo !~ m/bar/;
blah($_) for grep { $_ !~ m/bar/ } @foo;
#-----------------------------------------------------------------------------
## name "!~" within negative control structures
## failures 2
## cut
unless ($foo !~ m/bar/) {
blah();
}
until ($foo !~ m/bar/) {
blah();
}
#-----------------------------------------------------------------------------
## name "!~" within negative postfix statement modifiers
## failures 2
## cut
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";
## name "$operator" within positive control structures
## failures 0
## cut
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);
}
#-----------------------------------------------------------------------------
## name "$operator" within positive postfix statement modifiers
## failures 0
## cut
blah() if \$foo $operator \$bar;
blah() while \$foo $operator \$bar;
blah(\$_) for grep { \$_ $operator \$bar } \@foo;
#-----------------------------------------------------------------------------
## name "$operator" within negative control structures
## failures 2
## cut
unless (\$foo $operator \$bar) {
blah();
}
until (\$foo $operator \$bar) {
blah();
}
#-----------------------------------------------------------------------------
## name "$operator" within negative postfix statement modifiers
## failures 2
## cut
blah() unless \$foo $operator \$bar;
blah() until \$foo $operator \$bar;
#-----------------------------------------------------------------------------
END_COMPARATOR_CODE
return;
}