#!/usr/bin/perl
#
# Usage: redundant_null_check.pl < $file.sm
#
#  This software may be used and distributed according to the terms
#  of the GNU General Public License, incorporated herein by reference.
#
#  Copyright 2004-2007 Michael Stefaniuc


use strict;
use smatch;

# Variables
############

# If true print some debugging output.
my $DEBUG = 0;
# If true print occurrences we think are false positives.
my $PRINTFALSEPOSITIVE = 0;

# Functions that do not need an extra NULL check before being called.
# The value is used only for documentation purpose and has no effect
# in the code: (o)fficial, (i)nternal, (a)utomaticly found functions.
my %functions = (
		  'HeapFree'    => 'o',
		  'RtlFreeHeap' => 'o',
		  'free' => 'o',
		  'SysFreeString' => 'o',
		  # Wrappers around one of the above functions but which
		  # are official Win API so we cannot find them ourselfs.
		  "CryptMemFree" => 'o',
		  "CoTaskMemFree" => 'o',
		  "DllFreeSplMem" => 'o',
		  "FreeEnvironmentStringsA" => 'o',
		  "Free" => 'o',
		  "GdipFree" => 'o',
		  "I_RpcFree" => 'o',
		  "ldap_memfreeA" => 'o',
		  "ldap_memfreeW" => 'o',
		  "LsaFreeMemory" => 'o',
		  "MyFree" => 'o',
		  "SetupTermDefaultQueueCallback" => 'o',
		);


# Functions
############
my $line = 0;
my $func_pos = 0;
sub error_msg($) {
    my $msg = shift;
    print get_filename(), " ", $line, " ", $func_pos,
	    " NULL pointer check before $msg\n";
}

# This function searches for the first unbalanced ')' in a string and
# returns the string up to the ')' (not included).
sub get_str_close_bracket($) {
    my $str = shift;
    my $count = 1; # We are searching for the first unbalanced ')'

    while ($str =~ m/[^()]*(\(|\))/g) {
	if ($1 eq ')') {
	    $count--;
	    if ($count == 0) {
		last;
	    }
	} else {
	    $count++;
	}
    }
    if ($count > 0) {
	# Couldn't find an unbalanced ')'
	return ($str);
    }
    return substr($str, 0, pos($str) - 1);
}

# Split the arguments to a C function into separate array entries
sub split_c_func_args($) {
    my $str = shift;
    if ($str !~ s/^\(tree_list: //) {
	die "FATAL ERROR: split_c_func_args";
    }

    $str = get_str_close_bracket($str);
    my @args = split(/, /, $str);
    return @args;
}


# Main
#######
my $data;

while($data = get_data()){
    if ($data =~ s/^if_cond //) {
	my @vars = ();
	my $saved = "";
	my $block;
	if ($data !~ /(?:eq|ne)_expr/) {
	    # the smatch gcc generates for "if (bla) blubb;" a
	    # "if_expr bla" smatch code line and not ne_expr with 0
	    push(@vars, $data);
	} else {
	    # ubercool regexp to make the simple ".*?" not swallow a ne_expr
	    while ($data =~ /ne_expr\(\(((?:.(?!ne_expr))*?)\)\(integer_cst\(0\)\)\)/g) {
		# Save all non-null variables
		push(@vars, $1);
	    }
	}
	if (defined($vars[0])) {
	    $saved = $data;
	    $line = get_lineno();
	    $func_pos = get_func_pos();
	} else {
	    next;
	}
	$data = get_data();
	if ($data =~ /^cmpstmt_start$/) {
	    # skip the '{'
	    $data = get_data();
	    $block = 1;
	} else {
	    $block = 0;
	}

	if ($data =~ /^expr_stmt call_expr\(\(addr_expr function_decl\(([^ ():]+)\)\)(.*)/o) {
	    my $func = $1;
	    my $arglist = $2;
	    if (!exists($functions{$func})) {
		next;
	    }
	    my @args = split_c_func_args($arglist);

	    my $var = "";
	    # Check all function arguments against the non-null variables.
	    # Start with the last one to speed up HeapFree checks. Sane
	    # free'ing function have only one argument anyway.
	    for (my $i = $#args; $i >= 0; $i--) {
		foreach my $v (@vars) {
		    if ($v eq $args[$i]) {
			$var = $v;
			last;
		    }
		}
	    }
	    if (!$var) {
		next;
	    }
	    $var = quotemeta($var);

	    if ($block) {
		# check what is also included in the {}
		$data = get_data();
		    if ($data =~ /^expr_stmt modify_expr\($var= integer_cst\(0\)\)$/) {
			# variable = NULL;
			$data = get_data();
		    }
		    if ($data !~ /^cmpstmt_end$/) {
			# not the expected '}'. Treat it as false positive
			if ($PRINTFALSEPOSITIVE) {
			    error_msg($func . " (false positive)");
			}
			redo;
		    }
	    }
	    # Check that we do not dereference the $var in the
	    # if expression.
	    if ($saved !~ /ne_expr\(\($var\)\(integer_cst\(0\)\)\).*\(indirect_ref $var\)/) {
		error_msg($func);
	    } elsif ($PRINTFALSEPOSITIVE) {
		error_msg($func . " (false positive)");
	    }
	} else {
	    redo;
	}
	next;
    }

    # Find wrappers around the freeing functions
    if ($data =~ /^function_decl \S+ function_decl\(([^ ():]+)\)\(/) {
	my $func = $1;
	$data = get_data();
	if ($data eq 'cmpstmt_start') {
	    $data = get_data();
	    # Check if this is stuff produced by a TRACE() line and skip over it
	    if ($data eq 'do_stmt') {
		# TRACE() expands to the same source line
		my $traceline = get_lineno();
		$data = get_data();
		if ($data eq 'cmpstmt_start' && $traceline == get_lineno()) {
		    $data = get_data();
		    if ($data eq 'if_cond bit_and_expr((component_ref((indirect_ref var_decl(__wine_dbch___default))(field_decl(flags))))(integer_cst(8)))'
			&& $traceline == get_lineno()) {
			# We found a TRACE(). Skip now everything on the same
			# line until we see the end of the do {} while (0).
			$data = get_data();
			while ($traceline == get_lineno()
			       && $data ne 'do_cond integer_cst(0)') {
			    $data = get_data();
			}
			if ($data eq 'do_cond integer_cst(0)') {
			    $data = get_data();
			} else {
			    redo;
			}
		    } else {
			redo;
		    }
		} else {
		    redo;
		}
	    }
	    if ($data =~ /^(?:expr_stmt|return_stmt modify_expr\(result_decl \S+ =) call_expr\(\(addr_expr function_decl\(([^ ():]+)\)\)\(/) {
		if (exists($functions{$1})) {
		    $data = get_data();
		    if ($data eq 'cmpstmt_end') {
			# Found a wrapper
			$functions{$func} = 'a';
			next;
		    }
		}
	    }
	}
	redo;
    }
}

if ($DEBUG) {
    foreach my $func (keys(%functions)) {
	if ($functions{$func} eq 'a') {
	    print(STDERR $func . "\n");
	}
    }
}
