#! /usr/bin/perl -w use strict; my $VERSION = "0.04"; my @tests = ("iron1.pl" => [ [[], < \$unsafe, "U" => \$unsafe, "help!" => \$help, "h" => \$help, "version!" => \$version, "verbose!" => \$verbose, "v" => \$verbose, "markers!" => \$markers, "m" => \$markers, "binary!" => \$binary, "b" => \$binary, "force!" => \$force, ); if ($version) { print<<"EOF"; generic perl golf tester $VERSION EOF exit 0; } if ($help) { require Config; $ENV{PATH} .= ":" unless $ENV{PATH} eq ""; $ENV{PATH} = "$ENV{PATH}$Config::Config{'installscript'}"; exec("perldoc", "-F", $unsafe ? "-U" : (), $0) || exit 1; # make parser happy %Config::Config = (); } my $marker = "|"; sub lines { return [map"$_\n",@_]; } sub count { my $file = $props{+shift}{work}; local (*FILE, $/); open(FILE, "< $file") || die "Could not open $file: $!\n"; binmode FILE if $binary; defined(local $_=) || return 0; s/\#! ?\S+\s?// if /^\#!/; s/\s*\z//; return length; } sub check_one { my ($file, $nr, $test) = @_; my ($args, $in, $out, $err, $exit, $name) = @$test; $err = "" if @$test <= 3; local(*FILE); my $in_file = "$file.in.$$"; my $out_file = "$file.out.$$"; my $err_file = "$file.err.$$"; $args = "@$args" if ref($args); $in = join("", @$in) if ref($in); eval { $SIG{HUP} = $SIG{INT} = $SIG{QUIT} = $SIG{TERM} = sub { die "Argh. Killed by signal"; }; open(FILE, "> $in_file") || die "Could not create $in_file: $!\n"; print FILE $in; close FILE; local $/; open(FILE, "< $in_file") || die "Could not open $in_file: $!\n"; my $all = ; if (!defined($all)) { die "unexpected short read from $in_file. Disk full ?\n" if $in ne ""; $all = ""; } $name = $_ unless defined($name) && $name ne ""; printf STDERR "%s: Running test %2s ... ", $file, $name; my $rc = system("$^X $props{$file}{work} $args < $in_file >$out_file 2>$err_file"); print STDERR "Program $file dumped core\n" if $rc & 0x80; print STDERR "Program $file killed by signal\n" if $rc & 0x7f; $rc = $rc >> 8; die "Program $file should finish with exitcode $exit, not $rc\n" if defined($exit) && $exit != $rc; if (defined($err)) { open(FILE, "< $err_file"); $all = ; if (defined($all) && $all ne "") { if ($err eq "") { $all =~ s/\n?\z/\n/; die "Unexpected output on STDERR:\n$all"; } elsif ($err ne $all) { $all =~ s/\n?\z/\n/; die "Expected '$err' on STDERR, but got:\n$all"; } } elsif ($err ne "") { die "Expected '$err' on STDERR, but got nothing\n"; } } open(FILE, "< $out_file") || die "Could not open $out_file: $!\n"; $all = ; $all = "" if !defined($all); $out = join("", @$out) if ref($out); if ($all ne $out) { $all =~ s/(?=\n)/$marker/g if $markers; $all =~ s/\n?\z//; $out =~ s/(?=\n)/$marker/g if $markers; $out =~ s/\n?\z//; die "Wrong output. Expected:\n$out\nbut got:\n$all\n"; } }; unlink($in_file, $out_file, $err_file); if ($@) { die $@ unless $force; print STDERR $@; } else { print STDERR "Ok\n"; } } sub copy { my $file = shift; $props{$file}{work} = my $new = "$file.$$"; local (*IN, *OUT); open(IN, "< $file") || die "Could not open $file: $!"; binmode(IN); open(OUT, "> $new") || die "Could not create $new: $!"; binmode(OUT); print OUT while ; } sub check_all { my ($file, $test) = @_; die "Already tested $file\n" if exists $props{$file}; push(@files, $file); copy($file); $sum += $props{$file}{count} = count($file); check_one($file, $_, $test->[$_-1]) for 1..@$test; } sub check_data { @tests % 2 && die "Odd number of values in \@test\n"; eval { check_all(shift @tests, shift @tests) while @tests; }; unlink($props{$_}{work}) for @files; die $@ if $@; my $count_length = length($sum); my $name_length = 1e9; for my $file (@files) { $name_length = length($file) if length($file) < $name_length; } for my $file (@files) { printf("%*d: %-*s\n", $count_length, $props{$file}{count}, $name_length, $file); } if (@files > 1) { printf("%s\n%*d\n", "-" x $count_length, $count_length, $sum); } } #check_data($_) for @ARGV; check_data(); __END__ =head1 NAME gentest.pl - Generic perl golf tester =head1 OPTIONS =over 4 =item -b, --binary Do the bytecounting of the files in binary. Strictly speaking on windows you should remove the carriage return just before the linefeed and do the test using this option. This is awkward, and usually the difference will not matter. But it will if you have B carriage returns before the newline. =item -m, --markers Put a marker just before every newline when outputting a difference between expected and gotten output. This makes seeing some differences easier. =item --force Keep running even after errors. =item -h, --help This help. =item -U, --unsafe Allows you to run this help as root. However, L is not designed to run as root, and you will also be calling several external programs as root. Avoid it. =item --version Show the version number of this program. =back