#!/usr/bin/env perl

use 5.006001;
use strict;
use warnings;

use English qw< -no_match_vars >;
use Carp qw< confess >;

use Carp qw< confess >;
use Fatal qw< open close >;

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    ## no critic (RequireBriefOpen)
    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';

#-----------------------------------------------------------------------------

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

#-----------------------------------------------------------------------------
# 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 :