exercise-seqs

#!/usr/bin/env perl

use strict;
use warnings;

my $TESEQ = 'teseq';
$TESEQ = $ENV{'TESEQ'} if exists $ENV{'TESEQ'};

#my @rows = map { sprintf ". x%X0", $_ } (0..15);
my @interesting =
    # Following are interesting characters that exercise various
    # divisions that might be encountered by escape-sequence parsing.
    split //, "\x00\x1b\x1f\x20\x21\x3a\x3e\x3f\x40\x5f\x60\x7e\x7f\x80\xC0";
my @inputs = (
    ["\x1b"],
    [undef, '[', @interesting],
    [undef, @interesting],
    [undef, @interesting]
);

my (@hangs, @nonzeroes, @nonasciis);

$SIG{'INT'} = sub {
    print "\n\nSIGINT received. Results so far:\n";
    &summarize;
    exit 1;
};

&process([], [@inputs]);
&summarize;

# Note, the following would probably produce a "0" on multiples of 256.
# I judge it unlikely we would reach such a high number.
exit (@hangs + @nonzeroes + @nonasciis);

###

BEGIN {
    sub process {
        my @decideds = @{ (shift) };
        my @undecideds = @{ (shift) };

        if (@decideds == 0) {
            # Do nothing; the other else-if clauses here don't apply.
        }
        elsif (! defined ($decideds[$#decideds])) {
            # An attempt on an undef value means "try an EOF here", so
            # this is a leaf condition.
            pop @decideds;
            @undecideds = ();
        }
        elsif ($decideds[$#decideds] eq '') {
            # A value of '' means "ignore me and keep processing".
            pop @decideds;
        }

        if (@undecideds == 0) {
            &run_test(@decideds);
        }
        else {
            foreach (@{ $undecideds[0] }) {
                &process([@decideds, $_],[@undecideds[1..$#undecideds]])
            }
        }
    }

    sub run_test {
        local $" = '';

        my $input = "@_";
        my $sanitized = $input;
        $sanitized =~ s/[^\x21-\x7e'"\\]/ sprintf "\\%03o", ord($&) /eg;
        print "INPUT: $sanitized : ";
        open my $run, "ulimit -c 0; printf '%b' '$sanitized' | $TESEQ 2>&1 |" or die "$0: Couldn't run reseq or teseq. Exiting.\n";
        my $toread = 400;
        my $nread = read($run, my $stuff, $toread);
        close $run;
        my $ret = $?;

        if ($nread == $toread) {
            print "*** hangs\a\n";
            push @hangs, $sanitized;
        }
        elsif ($stuff =~ /[^[:ascii:]]|[\x00-\x09\x0b-\x12\x14-\x1f\x7F]/) {
            # Above hexadecimal stuff identifies the ASCII control
            # characters, including DEL, but skipping CR and LF as permitted.
            print "*** non-ascii\a\n";
            push @nonasciis, $sanitized;
        }
        elsif ($ret != 0) {
            print "*** non-zero exit ";
            if ($ret & 127) {
                printf "(SIGNAL %d)", ($ret & 127);
            }
            else {
                printf "%d", ($ret >> 8);
            }
            print "\a\n";
            push @nonzeroes, $sanitized;
        }
        else {
            print "ok\n";
        }
    }

    sub summarize {
        print "\nResults: ";
        if (@hangs + @nonzeroes + @nonasciis == 0) {
            print "All runs look okay.\n";
            return;
        }

        my ($nhangs, $nnz, $nna) =
            (scalar @hangs, scalar @nonzeroes, scalar @nonasciis);
        print "$nhangs hangs, $nnz non-zero exits, $nna non-ascii outputs\n";

        local $" = "\n";
        foreach (['Hanging', \@hangs], ['Non-zero exit', \@nonzeroes],
                 ['Non-printable-ascii result', \@nonasciis]) {
             my ($title, $inputs) = @$_;

             next unless @$inputs;

             printf "\n\n=== %s inputs: ===\n", $title;
             {
                 local $" = "\n";
                 print "@$inputs\n=== End $title ===\n\n";
             }
        }
    }
} # BEGIN