1#!/usr/bin/env perl 2 3use strict; 4use warnings; 5 6my $TESEQ = 'teseq'; 7$TESEQ = $ENV{'TESEQ'} if exists $ENV{'TESEQ'}; 8 9#my @rows = map { sprintf ". x%X0", $_ } (0..15); 10my @interesting = 11 # Following are interesting characters that exercise various 12 # divisions that might be encountered by escape-sequence parsing. 13 split //, "\x00\x1b\x1f\x20\x21\x3a\x3e\x3f\x40\x5f\x60\x7e\x7f\x80\xC0"; 14my @inputs = ( 15 ["\x1b"], 16 [undef, '[', @interesting], 17 [undef, @interesting], 18 [undef, @interesting] 19); 20 21my (@hangs, @nonzeroes, @nonasciis); 22 23$SIG{'INT'} = sub { 24 print "\n\nSIGINT received. Results so far:\n"; 25 &summarize; 26 exit 1; 27}; 28 29&process([], [@inputs]); 30&summarize; 31 32# Note, the following would probably produce a "0" on multiples of 256. 33# I judge it unlikely we would reach such a high number. 34exit (@hangs + @nonzeroes + @nonasciis); 35 36### 37 38BEGIN { 39 sub process { 40 my @decideds = @{ (shift) }; 41 my @undecideds = @{ (shift) }; 42 43 if (@decideds == 0) { 44 # Do nothing; the other else-if clauses here don't apply. 45 } 46 elsif (! defined ($decideds[$#decideds])) { 47 # An attempt on an undef value means "try an EOF here", so 48 # this is a leaf condition. 49 pop @decideds; 50 @undecideds = (); 51 } 52 elsif ($decideds[$#decideds] eq '') { 53 # A value of '' means "ignore me and keep processing". 54 pop @decideds; 55 } 56 57 if (@undecideds == 0) { 58 &run_test(@decideds); 59 } 60 else { 61 foreach (@{ $undecideds[0] }) { 62 &process([@decideds, $_],[@undecideds[1..$#undecideds]]) 63 } 64 } 65 } 66 67 sub run_test { 68 local $" = ''; 69 70 my $input = "@_"; 71 my $sanitized = $input; 72 $sanitized =~ s/[^\x21-\x7e'"\\]/ sprintf "\\%03o", ord($&) /eg; 73 print "INPUT: $sanitized : "; 74 open my $run, "ulimit -c 0; printf '%b' '$sanitized' | $TESEQ 2>&1 |" or die "$0: Couldn't run reseq or teseq. Exiting.\n"; 75 my $toread = 400; 76 my $nread = read($run, my $stuff, $toread); 77 close $run; 78 my $ret = $?; 79 80 if ($nread == $toread) { 81 print "*** hangs\a\n"; 82 push @hangs, $sanitized; 83 } 84 elsif ($stuff =~ /[^[:ascii:]]|[\x00-\x09\x0b-\x12\x14-\x1f\x7F]/) { 85 # Above hexadecimal stuff identifies the ASCII control 86 # characters, including DEL, but skipping CR and LF as permitted. 87 print "*** non-ascii\a\n"; 88 push @nonasciis, $sanitized; 89 } 90 elsif ($ret != 0) { 91 print "*** non-zero exit "; 92 if ($ret & 127) { 93 printf "(SIGNAL %d)", ($ret & 127); 94 } 95 else { 96 printf "%d", ($ret >> 8); 97 } 98 print "\a\n"; 99 push @nonzeroes, $sanitized; 100 } 101 else { 102 print "ok\n"; 103 } 104 } 105 106 sub summarize { 107 print "\nResults: "; 108 if (@hangs + @nonzeroes + @nonasciis == 0) { 109 print "All runs look okay.\n"; 110 return; 111 } 112 113 my ($nhangs, $nnz, $nna) = 114 (scalar @hangs, scalar @nonzeroes, scalar @nonasciis); 115 print "$nhangs hangs, $nnz non-zero exits, $nna non-ascii outputs\n"; 116 117 local $" = "\n"; 118 foreach (['Hanging', \@hangs], ['Non-zero exit', \@nonzeroes], 119 ['Non-printable-ascii result', \@nonasciis]) { 120 my ($title, $inputs) = @$_; 121 122 next unless @$inputs; 123 124 printf "\n\n=== %s inputs: ===\n", $title; 125 { 126 local $" = "\n"; 127 print "@$inputs\n=== End $title ===\n\n"; 128 } 129 } 130 } 131} # BEGIN 132