7976 lines · 239.6 KB · Perl
RawDownload
	# If c99 comment on the current line, or the line before or after	my ($current_comment) = ($rawlines[$end_line - 1] =~ m@^\+.*(//.*$)@);	return $current_comment if (defined $current_comment);	($current_comment) = ($rawlines[$end_line - 2] =~ m@^[\+ ].*(//.*$)@);	return $current_comment if (defined $current_comment);	($current_comment) = ($rawlines[$end_line] =~ m@^[\+ ].*(//.*$)@);	return $current_comment if (defined $current_comment); 	# Catch a comment on the end of the line itself.	($current_comment) = ($rawlines[$end_line - 1] =~ m@.*(/\*.*\*/)\s*(?:\\\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 = $rawlines[$linenr - 1];		#warn "           $line\n";		if ($linenr == $first_line and $line =~ m@^.\s*\*@) {			$in_comment = 1;		}		if ($line =~ m@/\*@) {			$in_comment = 1;		}		if (!$in_comment && $current_comment ne '') {			$current_comment = '';		}		$current_comment .= $line . "\n" if ($in_comment);		if ($line =~ m@\*/@) {			$in_comment = 0;		}	} 	chomp($current_comment);	return($current_comment);}sub ctx_has_comment {	my ($first_line, $end_line) = @_;	my $cmt = ctx_locate_comment($first_line, $end_line); 	##print "LINE: $rawlines[$end_line - 1 ]\n";	##print "CMMT: $cmt\n"; 	return ($cmt ne '');} sub raw_line {	my ($linenr, $cnt) = @_; 	my $offset = $linenr - 1;	$cnt++; 	my $line;	while ($cnt) {		$line = $rawlines[$offset++];		next if (defined($line) && $line =~ /^-/);		$cnt--;	} 	return $line;} sub get_stat_real {	my ($linenr, $lc) = @_; 	my $stat_real = raw_line($linenr, 0);	for (my $count = $linenr + 1; $count <= $lc; $count++) {		$stat_real = $stat_real . "\n" . raw_line($count, 0);	} 	return $stat_real;} sub get_stat_here {	my ($linenr, $cnt, $here) = @_; 	my $herectx = $here . "\n";	for (my $n = 0; $n < $cnt; $n++) {		$herectx .= raw_line($linenr, $n) . "\n";	} 	return $herectx;} sub cat_vet {	my ($vet) = @_;	my ($res, $coded); 	$res = '';	while ($vet =~ /([^[:cntrl:]]*)([[:cntrl:]]|$)/g) {		$res .= $1;		if ($2 ne '') {			$coded = sprintf("^%c", unpack('C', $2) + 64);			$res .= $coded;		}	}	$res =~ s/$/\$/; 	return $res;} my $av_preprocessor = 0;my $av_pending;my @av_paren_type;my $av_pend_colon; sub annotate_reset {	$av_preprocessor = 0;	$av_pending = '_';	@av_paren_type = ('E');	$av_pend_colon = 'O';} sub annotate_values {	my ($stream, $type) = @_; 	my $res;	my $var = '_' x length($stream);	my $cur = $stream; 	print "$stream\n" if ($dbg_values > 1); 	while (length($cur)) {		@av_paren_type = ('E') if ($#av_paren_type < 0);		print " <" . join('', @av_paren_type) .				"> <$type> <$av_pending>" if ($dbg_values > 1);		if ($cur =~ /^(\s+)/o) {			print "WS($1)\n" if ($dbg_values > 1);			if ($1 =~ /\n/ && $av_preprocessor) {				$type = pop(@av_paren_type);				$av_preprocessor = 0;			} 		} elsif ($cur =~ /^(\(\s*$Type\s*)\)/ && $av_pending eq '_') {			print "CAST($1)\n" if ($dbg_values > 1);			push(@av_paren_type, $type);			$type = 'c'; 		} elsif ($cur =~ /^($Type)\s*(?:$Ident|,|\)|\(|\s*$)/) {			print "DECLARE($1)\n" if ($dbg_values > 1);			$type = 'T'; 		} elsif ($cur =~ /^($Modifier)\s*/) {			print "MODIFIER($1)\n" if ($dbg_values > 1);			$type = 'T'; 		} elsif ($cur =~ /^(\#\s*define\s*$Ident)(\(?)/o) {			print "DEFINE($1,$2)\n" if ($dbg_values > 1);			$av_preprocessor = 1;			push(@av_paren_type, $type);			if ($2 ne '') {				$av_pending = 'N';			}			$type = 'E'; 		} elsif ($cur =~ /^(\#\s*(?:undef\s*$Ident|include\b))/o) {			print "UNDEF($1)\n" if ($dbg_values > 1);			$av_preprocessor = 1;			push(@av_paren_type, $type); 		} elsif ($cur =~ /^(\#\s*(?:ifdef|ifndef|if))/o) {			print "PRE_START($1)\n" if ($dbg_values > 1);			$av_preprocessor = 1; 			push(@av_paren_type, $type);			push(@av_paren_type, $type);			$type = 'E'; 		} elsif ($cur =~ /^(\#\s*(?:else|elif))/o) {			print "PRE_RESTART($1)\n" if ($dbg_values > 1);			$av_preprocessor = 1; 			push(@av_paren_type, $av_paren_type[$#av_paren_type]); 			$type = 'E'; 		} elsif ($cur =~ /^(\#\s*(?:endif))/o) {			print "PRE_END($1)\n" if ($dbg_values > 1); 			$av_preprocessor = 1; 			# Assume all arms of the conditional end as this			# one does, and continue as if the #endif was not here.			pop(@av_paren_type);			push(@av_paren_type, $type);			$type = 'E'; 		} elsif ($cur =~ /^(\\\n)/o) {			print "PRECONT($1)\n" if ($dbg_values > 1); 		} elsif ($cur =~ /^(__attribute__)\s*\(?/o) {			print "ATTR($1)\n" if ($dbg_values > 1);			$av_pending = $type;			$type = 'N'; 		} elsif ($cur =~ /^(sizeof)\s*(\()?/o) {			print "SIZEOF($1)\n" if ($dbg_values > 1);			if (defined $2) {				$av_pending = 'V';			}			$type = 'N'; 		} elsif ($cur =~ /^(if|while|for)\b/o) {			print "COND($1)\n" if ($dbg_values > 1);			$av_pending = 'E';			$type = 'N'; 		} elsif ($cur =~/^(case)/o) {			print "CASE($1)\n" if ($dbg_values > 1);			$av_pend_colon = 'C';			$type = 'N'; 		} elsif ($cur =~/^(return|else|goto|typeof|__typeof__)\b/o) {			print "KEYWORD($1)\n" if ($dbg_values > 1);			$type = 'N'; 		} elsif ($cur =~ /^(\()/o) {			print "PAREN('$1')\n" if ($dbg_values > 1);			push(@av_paren_type, $av_pending);			$av_pending = '_';			$type = 'N'; 		} elsif ($cur =~ /^(\))/o) {			my $new_type = pop(@av_paren_type);			if ($new_type ne '_') {				$type = $new_type;				print "PAREN('$1') -> $type\n"							if ($dbg_values > 1);			} else {				print "PAREN('$1')\n" if ($dbg_values > 1);			} 		} elsif ($cur =~ /^($Ident)\s*\(/o) {			print "FUNC($1)\n" if ($dbg_values > 1);			$type = 'V';			$av_pending = 'V'; 		} elsif ($cur =~ /^($Ident\s*):(?:\s*\d+\s*(,|=|;))?/) {			if (defined $2 && $type eq 'C' || $type eq 'T') {				$av_pend_colon = 'B';			} elsif ($type eq 'E') {				$av_pend_colon = 'L';			}			print "IDENT_COLON($1,$type>$av_pend_colon)\n" if ($dbg_values > 1);			$type = 'V'; 		} elsif ($cur =~ /^($Ident|$Constant)/o) {			print "IDENT($1)\n" if ($dbg_values > 1);			$type = 'V'; 		} elsif ($cur =~ /^($Assignment)/o) {			print "ASSIGN($1)\n" if ($dbg_values > 1);			$type = 'N'; 		} elsif ($cur =~/^(;|{|})/) {			print "END($1)\n" if ($dbg_values > 1);			$type = 'E';			$av_pend_colon = 'O'; 		} elsif ($cur =~/^(,)/) {			print "COMMA($1)\n" if ($dbg_values > 1);			$type = 'C'; 		} elsif ($cur =~ /^(\?)/o) {			print "QUESTION($1)\n" if ($dbg_values > 1);			$type = 'N'; 		} elsif ($cur =~ /^(:)/o) {			print "COLON($1,$av_pend_colon)\n" if ($dbg_values > 1); 			substr($var, length($res), 1, $av_pend_colon);			if ($av_pend_colon eq 'C' || $av_pend_colon eq 'L') {				$type = 'E';			} else {				$type = 'N';			}			$av_pend_colon = 'O'; 		} elsif ($cur =~ /^(\[)/o) {			print "CLOSE($1)\n" if ($dbg_values > 1);			$type = 'N'; 		} elsif ($cur =~ /^(-(?![->])|\+(?!\+)|\*|\&\&|\&)/o) {			my $variant; 			print "OPV($1)\n" if ($dbg_values > 1);			if ($type eq 'V') {				$variant = 'B';			} else {				$variant = 'U';			} 			substr($var, length($res), 1, $variant);			$type = 'N'; 		} elsif ($cur =~ /^($Operators)/o) {			print "OP($1)\n" if ($dbg_values > 1);			if ($1 ne '++' && $1 ne '--') {				$type = 'N';			} 		} elsif ($cur =~ /(^.)/o) {			print "C($1)\n" if ($dbg_values > 1);		}		if (defined $1) {			$cur = substr($cur, length($1));			$res .= $type x length($1);		}	} 	return ($res, $var);} sub possible {	my ($possible, $line) = @_;	my $notPermitted = qr{(?:		^(?:			$Modifier|			$Storage|			$Type|			DEFINE_\S+		)$|		^(?:			goto|			return|			case|			else|			asm|__asm__|			do|			\#|			\#\#|		)(?:\s|$)|		^(?:typedef|struct|enum)\b	    )}x;	warn "CHECK<$possible> ($line)\n" if ($dbg_possible > 2);	if ($possible !~ $notPermitted) {		# Check for modifiers.		$possible =~ s/\s*$Storage\s*//g;		$possible =~ s/\s*$Sparse\s*//g;		if ($possible =~ /^\s*$/) { 		} elsif ($possible =~ /\s/) {			$possible =~ s/\s*$Type\s*//g;			for my $modifier (split(' ', $possible)) {				if ($modifier !~ $notPermitted) {					warn "MODIFIER: $modifier ($possible) ($line)\n" if ($dbg_possible);					push(@modifierListFile, $modifier);				}			} 		} else {			warn "POSSIBLE: $possible ($line)\n" if ($dbg_possible);			push(@typeListFile, $possible);		}		build_types();	} else {		warn "NOTPOSS: $possible ($line)\n" if ($dbg_possible > 1);	}} my $prefix = ''; sub show_type {	my ($type) = @_; 	$type =~ tr/[a-z]/[A-Z]/; 	return defined $use_type{$type} if (scalar keys %use_type > 0); 	return !defined $ignore_type{$type};} sub report {	my ($level, $type, $msg) = @_; 	if (!show_type($type) ||	    (defined $tst_only && $msg !~ /\Q$tst_only\E/)) {		return 0;	}	my $output = '';	if ($color) {		if ($level eq 'ERROR') {			$output .= RED;		} elsif ($level eq 'WARNING') {			$output .= YELLOW;		} else {			$output .= GREEN;		}	}	$output .= $prefix . $level . ':';	if ($show_types) {		$output .= BLUE if ($color);		$output .= "$type:";	}	$output .= RESET if ($color);	$output .= ' ' . $msg . "\n"; 	if ($showfile) {		my @lines = split("\n", $output, -1);		splice(@lines, 1, 1);		$output = join("\n", @lines);	} 	if ($terse) {		$output = (split('\n', $output))[0] . "\n";	} 	if ($verbose && exists($verbose_messages{$type}) &&	    !exists($verbose_emitted{$type})) {		$output .= $verbose_messages{$type} . "\n\n";		$verbose_emitted{$type} = 1;	} 	push(our @report, $output); 	return 1;} sub report_dump {	our @report;} sub fixup_current_range {	my ($lineRef, $offset, $length) = @_; 	if ($$lineRef =~ /^\@\@ -\d+,\d+ \+(\d+),(\d+) \@\@/) {		my $o = $1;		my $l = $2;		my $no = $o + $offset;		my $nl = $l + $length;		$$lineRef =~ s/\+$o,$l \@\@/\+$no,$nl \@\@/;	}} sub fix_inserted_deleted_lines {	my ($linesRef, $insertedRef, $deletedRef) = @_; 	my $range_last_linenr = 0;	my $delta_offset = 0; 	my $old_linenr = 0;	my $new_linenr = 0; 	my $next_insert = 0;	my $next_delete = 0; 	my @lines = (); 	my $inserted = @{$insertedRef}[$next_insert++];	my $deleted = @{$deletedRef}[$next_delete++]; 	foreach my $old_line (@{$linesRef}) {		my $save_line = 1;		my $line = $old_line;	#don't modify the array		if ($line =~ /^(?:\+\+\+|\-\-\-)\s+\S+/) {	#new filename			$delta_offset = 0;		} elsif ($line =~ /^\@\@ -\d+,\d+ \+\d+,\d+ \@\@/) {	#new hunk			$range_last_linenr = $new_linenr;			fixup_current_range(\$line, $delta_offset, 0);		} 		while (defined($deleted) && ${$deleted}{'LINENR'} == $old_linenr) {			$deleted = @{$deletedRef}[$next_delete++];			$save_line = 0;			fixup_current_range(\$lines[$range_last_linenr], $delta_offset--, -1);		} 		while (defined($inserted) && ${$inserted}{'LINENR'} == $old_linenr) {			push(@lines, ${$inserted}{'LINE'});			$inserted = @{$insertedRef}[$next_insert++];			$new_linenr++;			fixup_current_range(\$lines[$range_last_linenr], $delta_offset++, 1);		} 		if ($save_line) {			push(@lines, $line);			$new_linenr++;		} 		$old_linenr++;	} 	return @lines;} sub fix_insert_line {	my ($linenr, $line) = @_; 	my $inserted = {		LINENR => $linenr,		LINE => $line,	};	push(@fixed_inserted, $inserted);} sub fix_delete_line {	my ($linenr, $line) = @_; 	my $deleted = {

Lines 2001–2500 of 7976. Previous lines