#! /usr/bin/perl
use strict;
use warnings;

@ARGV==1 or die;

sub readfile($)
{
  my($fname)=@_;

  local *F;
  open F,$fname or die $fname;
  my $F=do { local $/; <F>; };
  defined $F or die $fname;
  close F or die $fname;
  return $F;
}

# Figure out which changes are safe based on the warnings before and after the
# change.  We could simply check $f[1] and $t[1] for compatibility of types,
# but checking both the old and new changes allows us to retain places where we
# have accidentally changed signs.
sub safe_change($$) {
	my($ref_from, $ref_to) = @_;
	my @f = @{$ref_from};
	my @t = @{$ref_to};

	# It is OK if the warnings before and after were only for the sign of
	# the assignment or comparison.
	if  ($f[0] eq "int"  && $f[1] eq "LONGEST" &&
	     $t[0] eq "UINT" && $t[1] eq "ULONGEST") {
		return 1;
	}

	# Likewise for reverse sign.
	if ($f[0] eq "UINT" && $f[1] eq "ULONGEST" &&
	    $t[0] eq "int"  && $t[1] eq "LONGEST") {
		return 1;
	}

	# If the earlier the target was larger but with a different sign and
	# now we have the same size but different sign, then we're still OK.
	if ($f[0] eq "int" && $f[1] eq "LONGEST" &&
	    $t[0] eq "ULONGEST"  && $t[1] eq "ULONGEST") {
		return 1;
	}

	# Likewise for reverse sign.
	if ($f[0] eq "UINT" && $f[1] eq "ULONGEST" &&
	    $t[0] eq "LONGEST"  && $t[1] eq "LONGEST") {
		return 1;
	}

	# If the earlier the target was smaller but with a different sign and
	# now we have the same size but different sign then we have actually
	# fixed something.
	if ($f[0] eq "LONGEST" && $f[1] eq "LONGEST" &&
	    $t[0] eq "UINT"  && $t[1] eq "ULONGEST") {
		return 1;
	}

	# Likewise for reverse sign.
	if ($f[0] eq "ULONGEST" && $f[1] eq "ULONGEST" &&
	    $t[0] eq "int"  && $t[1] eq "LONGEST") {
		return 1;
	}

	# If we simply grew the target type without changing the sign, we're
	# fine there too.
	if ($f[0] eq "UINT" && $f[1] eq "UINT" &&
	    $t[0] eq "int"  && $t[1] eq "LONGEST") {
		return 1;
	}

	# Likewise for reverse sign.
	if ($f[0] eq "int" && $f[1] eq "int" &&
	    $t[0] eq "UINT"  && $t[1] eq "ULONGEST") {
		return 1;
	}

	# Similar logic for (s)size_t. size_t will always be smaller than or
	# equal to LONGEST/ULONGEST, so treat it as if it were smaller and use
	# the same logic as above.
	if ($f[0] eq "size_t" && $f[1] eq "size_t" &&
	    $t[0] eq "int"  && $t[1] eq "LONGEST") {
		return 1;
	}

	if ($f[0] eq "size_t" && $f[1] eq "ULONGEST" &&
	    $t[0] eq "LONGEST"  && $t[1] eq "LONGEST") {
		return 1;
	}

	if ($f[0] eq "ssize_t" && $f[1] eq "ssize_t" &&
	    $t[0] eq "UINT"  && $t[1] eq "ULONGEST") {
		return 1;
	}

	if ($f[0] eq "ssize_t" && $f[1] eq "LONGEST" &&
	    $t[0] eq "ULONGEST"  && $t[1] eq "ULONGEST") {
		return 1;
	}

	return 0;
}

# Read in the file and prepare it so that we can run our future regexes easily.
my $f = readfile $ARGV[0];

$f=~s{unsigned long int}{"ULONGEST";}egm;
$f=~s{long int}{"LONGEST";}egm;
$f=~s{unsigned int}{"UINT";}egm;

# 0 = Assignment of...
# 1 = Function <func> expects arg <num>...
# 2 = Function *signed_integer expects arg 2...
# 3 = Variable <var> initialized to type ...
my $match = -1;

my $look = -1;
my @savelines;
my @from;
my @to;
my @expr;
my @var;
my @argnum;

# Walk through the file.
LINE: for(split /^/, $f) {
	my $line = $_;

	# Skip blank lines
	next LINE if /^\s*$/;
	# Skip summary lines
	next LINE if /^[-+]Finished checking/;
	# Skip command warnings.
	next LINE if /^ Command Line: Setting/;
	next LINE if /^ Splint 3\.1\.2 ---/;

	# Found a LOC. We look at the next lines.
	if ($look < 0 && /^\s+LOC/) {
		push @savelines, $_;
		$look = 0;
		next LINE;
	}
	# We're looking at the next lines.
	elsif ($look >= 0) {
		my $l = $_;

		# Make sure that the type promotions are safe. See safe_change
		# for details
		if (($look == 0 || $match == 0) && /Assignment of (\w+) to (\w+):(.*)$/) {
			push @from, $1;
			push @to, $2;
			push @expr, $3;
			push @savelines, $l;
			$line = "";
			$look += 1;
			$match = 0;

			next LINE if $look == 1;

			# only if we're talking about the same expression
			if (($expr[0] eq $expr[1]) && safe_change (\@from, \@to)) {
				# Skip the changeset.
				$#savelines = -1;
			}
			goto done;
		}

		# The (store|extract)_(un)?signed_integer functions always have
		# a primitive size in arg 2 and hence this warning is moot for
		# this change..
		if (($look == 0 || $match == 2) && /Function ((extract)|(store))?_(long_)?(un)?signed_integer expects arg 2 to be int/) {
			$line = "";
			push @savelines, $l;
			$look += 1;
			$match = 2;
			next LINE if $look == 1;
			$#savelines = -1;
			goto done;
		}

		# Analogous change to the Assignment change above. Again, see
		# safe_change function for details.
		if (($look == 0 || $match == 1) && /Function (\w+) expects arg (\d) to be (\w+) gets (\w+): (.*)$/) {
			push @var, $1;
			push @argnum, $2;
			push @to, $3;
			push @from, $4;
			push @expr, $5;
			push @savelines, $l;
			$line = "";
			$look += 1;
			$match = 1;

			next LINE if $look == 1;

			# only if we're talking about the same expression
			if (($expr[0] eq $expr[1]) &&
				($var[0] eq $var[1]) &&
				($argnum[0] eq $argnum[1]) &&
				(safe_change (\@from, \@to))) {
				# Skip the changeset.
				$#savelines = -1;
			}
			goto done;
		}

		# Analogous change to the Function change above.
		if (($look == 0 || $match == 3) && /Variable (\w+) initialized to type (\w+), expects (\w+): (.*)$/) {
			push @var, $1;
			push @to, $3;
			push @from, $2;
			push @expr, $4;
			push @savelines, $l;
			$line = "";
			$look += 1;
			$match = 3;

			next LINE if $look == 1;

			# only if we're talking about the same expression
			if (($expr[0] eq $expr[1]) &&
				($var[0] eq $var[1]) &&
				(safe_change (\@from, \@to))) {
				# Skip the changeset.
				$#savelines = -1;
			}
			goto done;
		}

		# Skip non-boolean warnings.
		if (($look == 0 || $match == 4) && /Test expression for (\w+) not boolean/) {
			$line = "";
			push @savelines, $l;
			$look += 1;
			$match = 4;
			next LINE if $look == 1;
			$#savelines = -1;
			goto done;
		}

		# These warnings are again not a result of our change.
		if (($look == 0 || $match == 5) && /New fresh storage \(type (\w+) \*\) passed as implicitly temp/) {
			$line = "";
			push @savelines, $l;
			$look += 1;
			$match = 5;
			next LINE if $look == 1;
			$#savelines = -1;
			goto done;
		}

		if (($look == 0 || $match == 6) && /Operands of ([^\s]+) have incompatible types \((\w+), (\w+)\): (.*)$/) {
			push @var, $1;
			push @to, $2;
			push @from, $3;
			push @expr, $4;
			push @savelines, $l;
			$line = "";
			$look += 1;
			$match = 6;

			next LINE if $look == 1;

			# ULONGEST to LONGEST comparisons are safe.
			if (($expr[0] eq $expr[1]) &&
				(($from[1] eq "LONGEST" && $to[1] eq "ULONGEST") ||
				 ($from[1] eq "ULONGEST" && $to[1] eq "LONGEST"))
			) {
				# Skip the changeset.
				$#savelines = -1;
			}
			goto done;
		}

		# Remove blocks that are not really changes at all
		# We only drop complete blocks, i.e. something that is nested by
		# two LOC lines and the first LOC is preceded by a space.
		if ($look == 0 || $match == 7) {
			# Got the next LOC.
			if (/^([ -+])\s*LOC/) {
				$#savelines = -1;
				push @savelines, $l;
				if ($1 eq " ") {
					$look = 0;
					$match = -1;
					next LINE;
				}
			}
			# Anything else, we just schedule to remove.
			elsif (/^ /) {
				$line = "";
				push @savelines, $l;
				$look += 1;
				$match = 7;
				next LINE;
			}

			goto done;
		}

	}

	# The next lines didn't work out as expected, so clear and print
	# everything out as if nothing happened.
done:	$look = -1;
	foreach(@savelines) {
		print $_;
	}
	print $line;
	$#savelines = -1;
	$#var = -1;
	$#argnum = -1;
	$#from = -1;
	$#to = -1;
	$#expr = -1;
}