#! /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.
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 (/^ 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, $2;
			push @from, $3;
			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;
		}
	}

	# 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;
}
