7586 lines · 225.6 KB · Perl
RawDownload
	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 = {		LINENR => $linenr,		LINE => $line,	}; 	push(@fixed_deleted, $deleted);} sub ERROR {	my ($type, $msg) = @_; 	if (report("ERROR", $type, $msg)) {		our $clean = 0;		our $cnt_error++;		return 1;	}	return 0;}sub WARN {	my ($type, $msg) = @_; 	if (report("WARNING", $type, $msg)) {		our $clean = 0;		our $cnt_warn++;		return 1;	}	return 0;}sub CHK {	my ($type, $msg) = @_; 	if ($check && report("CHECK", $type, $msg)) {		our $clean = 0;		our $cnt_chk++;		return 1;	}	return 0;} sub check_absolute_file {	my ($absolute, $herecurr) = @_;	my $file = $absolute; 	##print "absolute<$absolute>\n"; 	# See if any suffix of this path is a path within the tree.	while ($file =~ s@^[^/]*/@@) {		if (-f "$root/$file") {			##print "file<$file>\n";			last;		}	}	if (! -f _)  {		return 0;	} 	# It is, so see if the prefix is acceptable.	my $prefix = $absolute;	substr($prefix, -length($file)) = ''; 	##print "prefix<$prefix>\n";	if ($prefix ne ".../") {		WARN("USE_RELATIVE_PATH",		     "use relative pathname instead of absolute in changelog text\n" . $herecurr);	}} sub trim {	my ($string) = @_; 	$string =~ s/^\s+|\s+$//g; 	return $string;} sub ltrim {	my ($string) = @_; 	$string =~ s/^\s+//; 	return $string;} 

Lines 2001–2500 of 7586. Previous lines