#!/usr/bin/perl

=head1 NAME

find_minimal_error - Find the minimal source file to reproduce an error

=head1 SYNOPSIS

find_error source-file 'test to run'

=head1 DESCRIPTION

Problem: You have a file that gives error when doing something to the
file. You are sure that this file is not the minimal file that will
reproduce this error. Now you want to find the minimal file that will
reproduce the error.

Solution: Make a shell script that checks if the error exists. The
shell script must return 0 (true in $?) if the error is still there
and 1 (false in $?) if the error is not there anymore.

=head1 EXAMPLE

Let us assume that compiling foo.c gives a signal 11. The shell script
for testing could be:

  rm foo.o 2>/dev/null
  cc -c foo.o foo.c >/tmp/$$ 2>&1
  grep 'signal 11' /tmp/$$ >/dev/null

After running

  find_minimal_error foo.c 'shell-script'

foo.c will contain the minimal code that will trigger the error.

=head1 AUTHOR

Ole Tange, http://ole.tange.dk

=head1 LICENSE

GPL http://www.gnu.org/copyleft/gpl.html

=head1 SEE ALSO

perl(1).

=cut

$source_file_name = shift;

# If test returns true (0 in $?) then the error still exist
#$test_for_error = "rm ui.o 2>/dev/null; make ui.o >/tmp/$$ 2>&1 ; grep 'signal 11' /tmp/$$ >/dev/null";
$test_for_error = shift;

$debug=1;

open (F,$source_file_name) || die;
@org_prg=<F>;
close F;

run(@org_prg);

sub run {
    my (@prg)=@_;
    @working::prg=@prg;
    $i=0;$n=$#prg/100;

    while($n>0) {
	$debug && print "i=$i n=$n\n";
        $test=test(@prg);
        if($test) {
            save_current(@prg);
            @prg=go_forward();
        } else {
            @prg=go_back();
            @prg=go_forward();
        }
        $debug && print ++$t," $test\n";
    }
    open(PRG,">best");
    print PRG @working::prg;
    close PRG;
    print "Minimal error in 'best'\n";
}

# for n = #linjer - 0
# for i = 0 - (#linjer - n)
# fjern n linjer fra linje i

sub go_forward {
    my (@prg)=@working::prg;
    if($i++ + $n > $#prg) {
        $i=0; $n--;
    }
    splice(@prg,$i,$n);
    return @prg;
}

sub go_back {
    return @working::prg;
}

sub save_current {
    my (@prg)=@_;
    @working::prg=@prg;
    ## reset n og i
    #$n=$#working::prg/100;
    #$i=0;
    #open(PRG,">/tmp/minimize-$$-current");
    open(PRG,">minimize-$$-current");
    print PRG @prg;
    close PRG;
    print "Best #lines: $#prg\n";
}

sub test {
    my (@prg)=@_;
    open(PRG,">$source_file_name");
    print PRG @prg;
    close PRG;
    print `$test_for_error`;
    return not $?;
}