stlfilt.pl

STLstlfilt.zip

 	s/\b_Tree<($t),\1,((?:multi)?set)<\1((?:,$t(?:<\1 ?>)?)?) ?(,$t)?>\:\:_Kfn(?:\3(?:<\1 ?>)?)? ?(,\4)?>/$2<$1$3>/g;

# Dinkumware set/multiset:

	s/\b_Tree<_Tset_traits<($t)((?:,$t)?),(0|false) ?> ?>/set<$1$2>/g;
	s/\b_Tree<_Tset_traits<($t)((?:,$t)?),(1|true) ?> ?>/multiset<$1$2>/g;

# Dinkumware hash_set/hash_multiset:

	s/\b_Hash<_Hset_traits<($t)((?:,$t)?),(0|false) ?> ?>/hash_set<$1$2>/g;
	s/\b_Hash<_Hset_traits<($t)((?:,$t)?),(1|true) ?> ?>/hash_multiset<$1$2>/g;
	s/\blist<($t),_Hset_traits<$t(,$t)?,false>\:\:allocator_type>/hash_set<$1>/g;

# simplify default comparison function objects (not "functors", right Chuck Allison?), but leave others intact:

	s/,_?less<$t ?>//g;
	s/,Comp<$t ?>//g;		# STLPort's default comparison function
 	s/\b(,)?const less<$t ?> &/$1less &/g;

# handle vc7 nested typedefs by substituting back their actual types:

	s/\b($id<($t)>)\:\:_Pairib/pair<$1::iterator,bool>/g;									# set iterator
	s/\b(?:hash_)?(?:multi)?set<($t)(,$t)?>::value_type/$1/g;								# set value_type
	s/\b($id<($t),$t(,$t)?>)\:\:_Pairib/pair<$1::iterator,bool>/g;							# map iter-bool pair
	s/\b(?:hash_)?(?:multi)?map<($t),($t)(,$t)?>\:\:value_type/pair<$1,$2>/g;				# map value_type
	s/\blist<(_Hset_traits<($t),$id<\2>,(true|false)>)\:\:value_type,\1\:\:allocator_type>/hash_set<$2>/g;
	s/\blist<(_Hmap_traits<($t),($t),$id<\2>,(true|false)>)\:\:value_type,\1\:\:allocator_type>/hash_map<$2,$3>/g;

#
# Call custom post-processing subroutines here, e.g.:
#	custom;
#

	last if $before eq $_;					# stop looping only if there were no changes this pass
  }


  s/\:\:iterator\:\:iterator/::iterator/g;
  s/\:\:const_iterator\:\:const_iterator/::const_iterator/g;

# reduce iterators according to $iter_policy:

  $olditer = '(reverse_)?(bidirectional_)?((back_)?insert_)?iterator';
  if ($iter_policy eq 'M')					# policy 'M': USUALLY remove:
  {
	unless (/( of type|' to '|from ')$t\:\:(const_)?$olditer/  # Shorten to $newiter and
			or /iterator' does/)							   # *remove* the base type completely...
	{														   # as long as the error message doesn't	
		s/$t\:\:((const_)?$olditer)\b/$1/g;					   # mention iterators!				
	}			
  }
  elsif ($iter_policy eq 'S')								# policy 'S': ALWAYS remove:
  {
	s/$t\:\:((const_)?$olditer)\b/$1/g;						#	remove the base type completely
  }

  s/\biterator\b/$newiter/g;								# All policies (including 'L'):
  s/\b(const_|reverse_|const_reverse_)iterator\b/$1$newiter/g; 

  s/\breverse_iterator<($t)<($t)>::iterator>/$1<$2>::reverse_iterator/g;
  s/\breverse_iterator<($t)<($t)>::const_iterator>/$1<$2>::const_reverse_iterator/g;


# reduce "double" constructor names 'T::T' to just 'T':

  s/'string\:\:string([\('])/'string$1/g;
  s/'(.*)\:\:\1([\('])/'$1$2/g;

# I'm sorry, Microsoft needs grammar lessons:

  s/take 1 parameters/take 1 parameter/g;

# get rid of that useless space between stars in ptrs-to-ptrs:

  s/ \* \* \* \*/ ****/g;
  s/ \* \* \*/ ***/g;
  s/ \* \*/ **/g;

# deal with some other non-critical (and often not even very aesthetic) spaces (or lack thereof):

 												# Put spaces between the close brackets
  s/>>>>>([\(:',*&])/> > > > >$1/g;
  s/>>>>([\(:',*&])/> > > >$1/g;
  s/>>>([\(:',*&])/> > >$1/g;

  if (/(.)>>(.)/)						# careful, ">>" could be operator...
  {
	  $before = $1;
	  $after = $2;
	  s/(.)>>([ \(:',*&])/$1> >$2/g unless (/operator ?>>/ or ($before eq ' ' and $after eq ' ')
										   or ($before eq "'" and $after eq "'"));
  }

  s/([^> ]) >([^=])/$1>$2/g;							# remove space before '>' (unless between another '>' or '>=')
  s/([\w>])([&*])/$1 $2/g if !$smush_amps_and_stars;	# conditionally force space between identifier and '*' or '&'
  s/' \:/':/g;
  s/ ,/,/g;										# space *before* a comma? I don't think so.
  s/,([^ ])/, $1/g if $space_after_commas;		# add space *after* a comma, however, if desired.
  s/^        /$tab/;							# those 8 leading spaces make for some really ugly wrapping...

# re-format new VC++ 7 ';'-delimited messages and multiple-candidate messages:

  s/\boperator`(..?)'/operator$1/g;
  s/; ([A-Za-z]:\\)/\n$1/g;
  s/       ('[A-Za-z]:\\)/\n$tab$1/g;
  s/\bat ('[A-Za-z]:\\)/\n$tab$1/g;
  s/'; /'$indent_string/g;
  s/; (\w+\.(h|cpp)\(\d+\) \:)/\n$1/g;
  s/\bcould be '/could be$indent_string$tab'/;
  s/: or       '/: or$indent_string$tab'/g;
  s/; while trying/\n  while trying/;

# Break error lines at column $output_width (if non-zero), and, FINALLY,
# print out the result of all transformations, preceded by saved prefix:

  @lines = split(/\n/);
  break_and_print $prefix . (shift @lines);
  print "\n";
  foreach $line (@lines)
  {
	  break_and_print $line;
	  print "\n";
  }
}

close LOGNATIVE if $lognative;					# close native messages logfile if active

# If a line containing just the text "with" was detected, display a reminder about using /WL under VC7:

break_and_print "\n **** Decryptor Note: To filter VC7 messages, use the /WL compile option! ****\n" if $justWith == 1;

if ($choked and $show_internal_err)
{
	print "\n";
	print "***********************************************************************\n";
	print "An internal STL Decryptor error occurred somewhere above; it should\n";
	print "have said as much, and then emitted the partially-filtered line.\n";
	print "Please look for a file just created named NativeLog.txt,\n";
	print "and email this file to me (leor\@bdsoft.com). This will greatly help me\n";
	print "to understand and correct the problem. Sorry for the hassle!\n";
	print "***********************************************************************\n";
}

exit 0;			# The proxy CL will take care of returning the appropriate status to caller


sub break_and_print {
	my $line = shift(@_);

	if ($output_width == 0 or ($break_algorithm eq 'P' and length($line) < $output_width))
	{
		$line =~ s/\s+\n/\n/g;	# delete trailing space on a line
		print "************** PRINT DBG 4 **************\n" if $pdbg;
		print "$line";
		return;
	}

	if ($break_algorithm eq 'P')
	{
		print "************** PRINT DBG 5 **************\n" if $pdbg;
		break_and_print_plain "$line";	
		return;
	}

	$nesting_level = 0;			# track combined nesting level for () [] <> {}
	$in_quotes = 0;				# not in quotes

WRAPLOOP:
	for ($frag_count = 0; ;$frag_count++)
	{
		$indentation = $nesting_level;		# save indentation at start of every line
		$width = $output_width - ($nesting_level * $tabsize);

		print "DBG: top of WRAPLOOP a: frag_count = $frag_count, nesting_level = $nesting_level, indentation = $indentation\n" if $wrapdbg;
		print "DBG: width = $width, tabsize = $tabsize, in_quotes = $in_quotes\n" if $wrapdbg;
		print "DBG: Top of WRAPLOOP, line to process is: '$line'\n" if $wrapdbg;

		$line =~ s/^\s*//;				# delete leading spaces
		$line =~ s/,([^ \t])/, $1/g;	# make sure commas are followed by a  space for gcc2


		if ($frag_count > 0)			# make sure only 1st line of message hugs left margin
		{
			$indentation++;
			$width -= $tabsize;
		}

		$at_left = 0;					# recognize when there's no nested parens
		$at_left = 1 if ($close_wrap eq 'N' and
						($frag_count == 0 or ($frag_count > 0 and $nesting_level == 1)));

		# Preprocess line, creating table mapping close- to open-parens:

		print "\n\nDBG: line to process (width = $width, nesting_level = $nesting_level, in_quotes = $in_quotes):\n$line" if $pdbg;
		showkey $width if $pdbg;


        $first_unmatched_close = $width;				# position of first unmatched close paren
        $unmatched_close_nesting = $nesting_level;      # the nesting level below which we'll consider a close paren to be unmatched
        $initial_close = 0;						        # assume first character is not a close paren
        
		@delims = ();		# list of unmatched open delims
		@delim_index = ();	# for each open, record its position
		@nesting_key = ();	# record nesting level at each char position
		@quoting_key = ();	# record whether in quotations at each char position

		# for each closer, we'll record the position of the corresponding opener in @delim_opener

		# begin by resetting each position:
		for ($i = 0; $i < length($line); $i++)
		{
			$delim_opener[$i] = -1;
		}

		for ($pos = 0; $pos < $width and $pos < length($line); $pos++)
		{
			$c = substr($line, $pos, 1);

			print "DBG: delimiter de-bugging, column pos = $pos (char there = '$c')\n" if $delimdbg;

			if (exists $open_delims{$c})
			{
				$before = ' ';
				$before = substr($line, $pos-1, 1) if $pos > 0;

				$beforetext = "";
				$beforetext = substr($line, $pos - 10, 10) if ($pos >= 10);	# looking for "operator"

				$after = ' ';
				if ($pos < (length($line) - 1))
				{
					$after = substr($line, $pos+1, 1);
					$aftertext = substr($line, $pos+1);
				}
																			# Exclude some special cases:
				if (!($before eq '\'' and $after eq '\'') and				# 'paren'
					!($before eq ' ' and $after eq ' ' and $c eq '<') and	# <space> < <space> (relop)
					!( ($before eq $c or $after eq $c) and ($c eq '<')) and	# two <'s in a row
					!($c eq '<' and $after eq '=') and						# <=
					!($c eq '<' and ($after eq '"' or $before eq '"')) and	# "< or <"
					!($c eq '(' and $after eq ')') and						# ()
					!(($c eq '<' or $c eq '(') and $beforetext =~ /\boperator ?<?$/) 	# operator<, operator<<, operator()
				   )
				{
					print "DBG: matched opening delim '$c', aftertext = '$aftertext'\n" if $delimdbg;
					$nesting_level++;
					push @delims, $c;
					push @delim_index, $pos;
				}
			}
			elsif (exists $close_delims{$c})
			{
				$before = ' ';
				$before = substr($line, $pos-1, 1) if $pos > 0;

				$beforetext = "";
				$beforetext = substr($line, $pos - 8, 8) if ($pos >= 8);	# looking for "operator"

				$after = ' ';
				if ($pos < (length($line) - 1))
				{
					$after = substr($line, $pos+1, 1);
					$aftertext = substr($line, $pos+1);
				}
																				# Exclude some special cases:
				if (!($before eq '\'' and $after eq '\'') and					# 'paren'
					!($beforetext =~ /\s$/ and $c eq '>' and $after eq '>') and	# whitespace >>
					!($beforetext =~ /\s>$/ and $c eq '>' and					# whitespace >> whitespace
								   $aftertext =~ /^\s/) and
					!($c eq '>' and $after eq '=') and							# >=
					!($c eq '>' and ($after eq '"' or $before eq '"')) and		# "> or >"
					!($c eq '>' and $beforetext =~ /\boperator ?>?$/) and		# operator> or operator>>
					!($c eq ')' and $before eq '(') and							# ()
					!($before eq '-' and $c eq '>'))							# special case: -> operator (!!)
				{
					print "DBG: matched closing delim '$c', aftertext = '$aftertext'\n" if $delimdbg;
					$nesting_level--;
					# If the nesting_level ever falls below its level at
					# the beginning of the line, we have an unmatched
					# close paren and we must force a break there.
					if ($pos == 0)
					{
						 # initial close delimiters don't count, we'll break after the nesting falls again
						$initial_close = 1;
						$unmatched_close_nesting--;
					}
					elsif ($close_wrap eq 'Y' and $in_quotes 
						   and $first_unmatched_close > $pos
						   and $nesting_level < $unmatched_close_nesting)
					{
						$first_unmatched_close = $pos;
					}

					if (@delims > 0)
					{
						if ($c ne $opps{$delims[$#delims]})
						{
							if ($show_internal_err)
							{
								if (!$lognative)
								{
									lognative_header;
									print LOGNATIVE "$save_line_for_dbg\n";		# write out the unprocessed offending line							}
									$lognative = 1;
								}

								print LOGNATIVE "$save_line_for_dbg\n"		# write out the unprocessed offending line
									if !$lognative;

								print LOGNATIVE "\nThe line at the point of the error was:\n$line\n";
								print LOGNATIVE " " x $pos . "^\n";
								print LOGNATIVE "\nNesting key: " . "@nesting_key\n";

								print LOGNATIVE "\nSTL Decryptor ERROR: the char '$c' (position $pos) DOESN'T MATCH DELIMITER '$delims[$#delims]'!\n";

								$choked = 1;
								print "\n";
								print "       [An Internal STL Decryptor error has occurred while processing\n";
								print "        the line that follows. Note that the line has not been successfully\n";
								print "        wrapped, but substitutions should still be intact:]\n\n";
							}
							print "$line\n";
							next MAIN_LOOP;
						}
						else
						{
							pop @delims;
							$delim_opener[$pos] = pop @delim_index;	# map close index to open index