#!/usr/bin/perl -w
#
# fixpointerarg.pl
#
# Takes as input (STDIN) the output of a wine make and automaticly fixes
# for DPRINTF/TRACE/FIXME/WARN/ERR's the format specifier of an $HANDLE arg.
# To run it just do:
# cd wine/dlls/$dll
# make clean
# make 2>&1 | fixpointerarg.pl
# This should fix almost every "int format, HANDLE arg" type of warning
#
# Michael Stefaniuc
# License: X11

use strict;
use POSIX;
use DB_File;
use Fcntl;


my $wine_base_dir = getcwd();
my @dirs = ($wine_base_dir);

my %cfile = ( name => "none",
	      lines => [],
	    );

# regexps
my $debugcmd_r = '(?:(?:DPRINTF)|(?:TRACE)|(?:WARN)|(?:FIXME)|(?:ERR))(?:_\s*\([^\n)]+\))?';
my $string_r = '"[^"\n\\\\]*(?:(?:\\\\[^\n])*[^"\n\\\\]*)*"';

sub openfile($) {
    my $name = shift;

    if ($cfile{"name"} eq $name) {
	return 1;
    }
    if ($cfile{"name"} ne "none") {
	untie(@{$cfile{"lines"}});
    }
    tie(my @lines, 'DB_File', $name, O_RDWR, 0, $DB_RECNO) or do {
	$cfile{"name"} = "none";
	return 0;
    };
    $cfile{"name"} = $name;
    $cfile{"lines"} = \@lines;
    return 1;
}
    
sub fixformatspec($$$) {
    my $filename = shift;
    my $lineno = shift() - 1;	# arrays start with 0
    my $arg = shift;

    openfile($filename) or return;
    # The compiler reports the last line of the expression which produced
    # the warning. We have to search backwards for the beginning of the
    # expression but limit the search to 10 lines.
    my $ref = $cfile{"lines"};
    my $i = 0;
    for (my $i = 0; $i <= 10; $i++) {
	$$ref[$lineno - $i] =~ m/^({?\s*$debugcmd_r\s*\(\s*)($string_r)([^\n]*$)/ and do {
	    my $pre = $1;
	    my $format = $2;
	    my $post = $3;

	    # correction factor to get the right format arg in a 
	    # TRACE/FIXME/WARN/ERR
	    my $arg_factor = 5;
	    if ($pre =~ DPRINTF) {
		$arg_factor = 2;
	    }
	    $arg -= $arg_factor;
	    if ($arg < 0) {
		return 0;
	    }
	    
	    # exchange the conversion specifier with 'p'
	    my $conv_spec = 'diouxX';
	    $format =~ s/("(?:[^%]+|(?:%%))*(?:%[^%](?:[^%]+|(?:%%))*){$arg})%[^diouxX%]*[diouxX](.*")$/$1\%p$2/;
	    
	    # check if we got "0x%p" and fix it
	    $format =~ s/0x%p/%p/g;

	    # save the modified line
	    $$ref[$lineno - $i] = $pre . $format . $post;
	    return 1;
	};
	# don't change into an other expression
	$$ref[$lineno - $i] =~ m/;\s*$/ and last;
    }
    # if we got here we couldn't find the format string
    return 0;
}

# Main Loop
###########
while (<>) {
    # lot's of this so skip them first
    m/^gcc / and next;
    # make entering a directory
    m/^make[^\n]+Entering directory `([^\n']+)'/ and do {
	unshift(@dirs, $1);
	chdir($1) or die "Can't change dir to $1";
	next;
    };
    # make leaving a directory
    m/^make[^\n]+Leaving directory `([^\n']+)'/ and do {
	chdir(shift(@dirs)) or die "Can't change dir to $1";
	next;
    };
    # we are only interested in the format mismatch warnings
    m/([^\s\n:]+):(\d+): warning: [^\n(]+ \(arg (\d+)\)/ and do {
	my $filename = "$dirs[0]/$1";
	my $lineno = $2;
	my $arg = $3;

	if (!fixformatspec($filename, $lineno, $arg)) {
	    printf(STDERR "can't handle:\n\t%s", $_);
	}
	next;
    };

}