# Intent:
#     Improve egcs Internal Compiler Error (ICE) reporting from people doing
#     snapshot or CVS builds by leaving them at the point of failure in gdb,
#     and providing a consistent email Subject line
#
# Assumes:
#     make output in build.log as mail-report.log requires
#     in the tool level obj dir with build.log
#
# Usage: 
#     script ice
#     perl ice.pl build.log
#     # do whatever gdb explorations
#     exit
#     perl icescript.pl ice > ice.out
#     # Should be able to chmod +x ice.out ; ./ice.out
#     # to send off email
#    
# Parse egcs snapshot build.log files for an Internal Compiler Error
# re-run failing compilation with -v -save-temps
# then run the failing gcc subprocess under gdb with a breakpoint at
# the point of the Internal Compiler Error
# Assumes in the snapshot.obj directory

use Cwd;
local($triplet, $offending_src, $pt_of_failure);

sub ccv_gdb {
    if ($ccv_output[0] =~ /^\s*(\S+)(\s.*)$/) {
	my($exe, $cmd_args) = ($1, $2);
	my($i, $break_loc, $do_break);
	for ($i = $#ccv_output;
	$i > 0 && $ccv_output[$i] !~ /^\S+: Internal compiler error[ :]/;
	$i--) {
	}
	if ($ccv_output[$i] =~
	/^\S+: Internal compiler error(?: in `\S+', at (\S+:\d+)|: .*)$/) {
	    my($break_loc);
	    if (defined($1)) {
		$break_loc = $1;
		$pt_of_failure = $break_loc;
	    }
	    open GDB_ICE, ">gdb.ice.$$"
	    or "open gdb.ice.$$ failed $!";
	    if (!(-f '.gdbinit') && $exe =~ m|^(.*/)[^/]+$|) {
		open GCC_GDBINIT, "$obj_dir/gcc/.gdbinit"
		or die "open $obj_dir/gcc/.gdbinit failed $!";
		while (<GCC_GDBINIT>) {
		    print GDB_ICE "dir $obj_dir/gcc/$1\n"
		    if /^dir (.{2,})\n$/;
		}
		close GCC_GDBINIT;
	    }
	    print GDB_ICE "delete\n";
	    print GDB_ICE "break $break_loc\n" if defined($break_loc);
	    print GDB_ICE "run $cmd_args\n";
	    print GDB_ICE "bt\nl\n";
	    close GDB_ICE;
	    # Run gdb on the relevant gcc subprocess,
	    # breaking only at the point of the ICE
	    print "\n\n";
	    system("gdb -q -x gdb.ice.$$ $exe\n");
	    unlink "gdb.ice.$$";
	}
    }
}

$obj_dir = cwd();
while (<>) {
    if (/^(stage\d|\S+|  \.)\/xgcc\s/) {
	$#cc_output = -1;
	$cc_seen = 1;
    }
    if ($cc_seen) {
	push @cc_output, $_;
	$ICE_seen = 1 if /^\S+: Internal compiler error[ :]/;
	if ($ICE_seen && /^make\[\d\]: Leaving directory `([^']+)'$/) {
	   undef $ICE_seen;
	    $cc_dir = $1;
	    # Should do better, wrapping long lines etc here
	    print "cat <<EOF |\n";
	    print @cc_output;
	    if (chdir $cc_dir) {
		my($tmp, $i);
		$tmp = $cc_output[0];
		$tmp =~ s/^\s*(\S+\s)/$1-v -save-temps /;
		if ($tmp =~ /\\\s*\n$/) {
		    for ($i = 1; $i < $#cc_output; $i++) {
			$tmp =~ s/\\\s*\n/ /;
			$tmp .= $cc_output[$i];
			last if $tmp !~ /\\\s*\n$/;
		    }
		}
		chop($tmp);
		if ($tmp =~ /\$\{name\}\s.*\/gcc\/libgcc2\.c\s/) {
		    for ($i = $#cc_output - 2;
		    $i > 0 && $cc_output[$i] !~ /^_\w+\n$/;
		    $i--) {
		    }
		    if ($i > 0) {
			my($name) = $cc_output[$i];
			chop($name);
			$tmp =~ s/\$\{name\}/$name/g;
			$tmp =~ s/;.*$//;
			$offending_src = 'gcc/libgcc2.c(' . $name .')';
		    }
		}
		if (!defined($offending_src)
		&& $tmp =~ m#/((?:lib[^/ \t]+|gcc)/\S+\.(?:c|C|f|cc))\s*$#) {
		    $offending_src = $1;
		}
		$tmp = $tmp . ' 2>&1 |';
		#print $cc_dir, "\t",  $tmp, "\n";
		if ($tmp =~ m#\s-B\S+/([^/]+)/bin/\s#) {
		    $triplet = $1;
		}
		open CC_V, $tmp or die "pipe from $tmp failed $!";
		while ($l = <CC_V>) {
		    if ($l =~ /^ ((?:stage\d|\S+)\/\w+)\s/ && -f $1 && -x $1) {
			$#ccv_output = -1;
			$ccv_seen = 1;
		    }
		    elsif (!defined($egcs_version)
		    && $l =~ /^gcc version \S+ (\S+) /) {
			$egcs_version = $1;
		    }
		    if ($ccv_seen) {
			push @ccv_output, $l;
			if ($l =~ /^Please submit a full bug report\.\n/) {
			    # Should do better, wrapping long lines etc here
			    print "\n\n", @ccv_output;
			    undef $ccv_seen;
			    &ccv_gdb;
			}
		    }
		}
		if (defined($ccv_seen)) {
		    print "\n\n", @ccv_output;
		    undef $ccv_seen;
		    &ccv_gdb;
		}
	    }
	}
    }
}
$pt_of_failure = ' at ' . $pt_of_failure if defined($pt_of_failure);
print "EOF\nMail -s \"$egcs_version ICE$pt_of_failure compiling $offending_src on $triplet\" gcc-bugs\@gcc.gnu.org\n";