path: root/scripts/checkpatch.pl

#!/usr/bin/perl -w
# (c) 2001, Dave Jones. <davej@codemonkey.org.uk> (the file handling bit)
# (c) 2005, Joel Scohpp <jschopp@austin.ibm.com> (the ugly bit)
# (c) 2007, Andy Whitcroft <apw@uk.ibm.com> (new conditions, test suite, etc)
# Licensed under the terms of the GNU GPL License version 2

use strict;

my $P = $0;

my $V = '0.03';

use Getopt::Long qw(:config no_auto_abbrev);

my $quiet = 0;
my $tree = 1;
my $chk_signoff = 1;
my $chk_patch = 1;
GetOptions(
	'q|quiet'	=> \$quiet,
	'tree!'		=> \$tree,
	'signoff!'	=> \$chk_signoff,
	'patch!'	=> \$chk_patch,
) or exit;

my $exit = 0;

if ($#ARGV < 0) {
	print "usage: patchstylecheckemail.pl [options] patchfile\n";
	print "version: $V\n";
	print "options: -q           => quiet\n";
	print "         --no-tree    => run without a kernel tree\n";
	exit(1);
}

if ($tree && !top_of_kernel_tree()) {
	print "Must be run from the top-level dir. of a kernel tree\n";
	exit(2);
}

my @dep_includes = ();
my @dep_functions = ();
my $removal = 'Documentation/feature-removal-schedule.txt';
if ($tree && -f $removal) {
	open(REMOVE, "<$removal") || die "$P: $removal: open failed - $!\n";
	while (<REMOVE>) {
		if (/^Files:\s+(.*\S)/) {
			for my $file (split(/[, ]+/, $1)) {
				if ($file =~ m@include/(.*)@) {
					push(@dep_includes, $1);
				}
			}

		} elsif (/^Funcs:\s+(.*\S)/) {
			for my $func (split(/[, ]+/, $1)) {
				push(@dep_functions, $func);
			}
		}
	}
}

my @lines = ();
while (<>) {
	chomp;
	push(@lines, $_);
	if (eof(ARGV)) {
		if (!process($ARGV, @lines)) {
			$exit = 1;
		}
		@lines = ();
	}
}

exit($exit);

sub top_of_kernel_tree {
	if ((-f "COPYING") && (-f "CREDITS") && (-f "Kbuild") &&
	    (-f "MAINTAINERS") && (-f "Makefile") && (-f "README") &&
	    (-d "Documentation") && (-d "arch") && (-d "include") &&
	    (-d "drivers") && (-d "fs") && (-d "init") && (-d "ipc") &&
	    (-d "kernel") && (-d "lib") && (-d "scripts")) {
		return 1;
	}
	return 0;
}

sub expand_tabs {
	my ($str) = @_;

	my $res = '';
	my $n = 0;
	for my $c (split(//, $str)) {
		if ($c eq "\t") {
			$res .= ' ';
			$n++;
			for (; ($n % 8) != 0; $n++) {
				$res .= ' ';
			}
			next;
		}
		$res .= $c;
		$n++;
	}

	return $res;
}

sub line_stats {
	my ($line) = @_;

	# Drop the diff line leader and expand tabs
	$line =~ s/^.//;
	$line = expand_tabs($line);

	# Pick the indent from the front of the line.
	my ($white) = ($line =~ /^(\s*)/);

	return (length($line), length($white));
}

sub ctx_block_get {
	my ($linenr, $remain, $outer) = @_;
	my $line;
	my $start = $linenr - 1;
	my $end = $linenr - 1 + $remain;
	my $blk = '';
	my @o;
	my @c;
	my @res = ();

	for ($line = $start; $line < $end; $line++) {
		$blk .= $lines[$line];

		@o = ($blk =~ /\{/g);
		@c = ($blk =~ /\}/g);

		if (!$outer || (scalar(@o) - scalar(@c)) == 1) {
			push(@res, $lines[$line]);
		}

		last if (scalar(@o) == scalar(@c));
	}

	return @res;
}
sub ctx_block_outer {
	my ($linenr, $remain) = @_;

	return ctx_block_get($linenr, $remain, 1);
}
sub ctx_block {
	my ($linenr, $remain) = @_;

	return ctx_block_get($linenr, $remain, 0);
}

sub ctx_locate_comment {
	my ($first_line, $end_line) = @_;

	# Catch a comment on the end of the line itself.
	my ($current_comment) = ($lines[$end_line - 1] =~ m@.*(/\*.*\*/)\s*$@);
	return $current_comment if (defined $current_comment);

	# Look through the context and try and figure out if there is a
	# comment.
	my $in_comment = 0;
	$current_comment = '';
	for (my $linenr = $first_line; $linenr < $end_line; $linenr++) {
		my $line = $lines[$linenr - 1];
		##warn "           $line\n";
		if ($linenr == $first_line and $line =~ m@^.\s*\*@) {
			$in_comment = 1;
		}
		if ($line =~ m@/\*@) {
			$in_comment =