| 1 | #!/usr/bin/perl -w |
|---|
| 2 | use strict; |
|---|
| 3 | use File::Temp qw/ tempdir /; |
|---|
| 4 | my $prog = "reducer"; |
|---|
| 5 | |
|---|
| 6 | die "$prog <code file> <error string> [optional command]\n" if ($#ARGV < 0); |
|---|
| 7 | my $file = shift @ARGV; |
|---|
| 8 | die "$prog: [error] cannot read file $file\n" if (! -r $file); |
|---|
| 9 | |
|---|
| 10 | my $magic = shift @ARGV; |
|---|
| 11 | die "$prog: [error] no error string specified\n" if (! defined $magic); |
|---|
| 12 | |
|---|
| 13 | # Create a backup of the file. |
|---|
| 14 | my $dir = tempdir( CLEANUP => 1 ); |
|---|
| 15 | print "$prog: created temporary directory '$dir'\n"; |
|---|
| 16 | my $srcFile = "$dir/$file"; |
|---|
| 17 | `cp $file $srcFile`; |
|---|
| 18 | |
|---|
| 19 | # Create the script. |
|---|
| 20 | my $scriptFile = "$dir/script"; |
|---|
| 21 | open(OUT, ">$scriptFile") or die "$prog: cannot create '$scriptFile'\n"; |
|---|
| 22 | my $reduceOut = "$dir/reduceOut"; |
|---|
| 23 | |
|---|
| 24 | my $command; |
|---|
| 25 | if (scalar(@ARGV) > 0) { $command = \@ARGV; } |
|---|
| 26 | else { |
|---|
| 27 | my $compiler = "clang"; |
|---|
| 28 | $command = [$compiler, "-fsyntax-only", "-Wfatal-errors", "-Wno-deprecated-declarations", "-Wimplicit-function-declaration"]; |
|---|
| 29 | } |
|---|
| 30 | push @$command, $srcFile; |
|---|
| 31 | my $commandStr = "@$command"; |
|---|
| 32 | |
|---|
| 33 | print OUT <<ENDTEXT; |
|---|
| 34 | #!/usr/bin/perl -w |
|---|
| 35 | use strict; |
|---|
| 36 | my \$BAD = 1; |
|---|
| 37 | my \$GOOD = 0; |
|---|
| 38 | `rm -f $reduceOut`; |
|---|
| 39 | my \$command = "$commandStr > $reduceOut 2>&1"; |
|---|
| 40 | system(\$command); |
|---|
| 41 | open(IN, "$reduceOut") or exit(\$BAD); |
|---|
| 42 | my \$found = 0; |
|---|
| 43 | while(<IN>) { |
|---|
| 44 | if (/$magic/) { exit \$GOOD; } |
|---|
| 45 | } |
|---|
| 46 | exit \$BAD; |
|---|
| 47 | ENDTEXT |
|---|
| 48 | close(OUT); |
|---|
| 49 | `chmod +x $scriptFile`; |
|---|
| 50 | |
|---|
| 51 | print "$prog: starting reduction\n"; |
|---|
| 52 | sub multidelta($) { |
|---|
| 53 | my ($level) = @_; |
|---|
| 54 | system("multidelta -level=$level $scriptFile $srcFile"); |
|---|
| 55 | } |
|---|
| 56 | |
|---|
| 57 | for (my $i = 1 ; $i <= 5; $i++) { |
|---|
| 58 | foreach my $level (0,0,1,1,2,2,10) { |
|---|
| 59 | multidelta($level); |
|---|
| 60 | } |
|---|
| 61 | } |
|---|
| 62 | |
|---|
| 63 | # Copy the final file. |
|---|
| 64 | `cp $srcFile $file.reduced`; |
|---|
| 65 | print "$prog: generated '$file.reduced"; |
|---|
| 66 | |
|---|