131014dae410799bfb128af2d396ee70374fa4b75florian#!/usr/bin/env perl 231014dae410799bfb128af2d396ee70374fa4b75florian 331014dae410799bfb128af2d396ee70374fa4b75florianuse warnings; 431014dae410799bfb128af2d396ee70374fa4b75florianuse strict; 531014dae410799bfb128af2d396ee70374fa4b75florian 631014dae410799bfb128af2d396ee70374fa4b75florian#--------------------------------------------------------------------- 731014dae410799bfb128af2d396ee70374fa4b75florian# A list of files specific to the tool at hand. Line numbers in 831014dae410799bfb128af2d396ee70374fa4b75florian# these files will be removed from backtrace entries matching these files. 931014dae410799bfb128af2d396ee70374fa4b75florian#--------------------------------------------------------------------- 1031014dae410799bfb128af2d396ee70374fa4b75florianmy @tool_files = ( "hg_intercepts.c", "vg_replace_malloc.c" ); 1131014dae410799bfb128af2d396ee70374fa4b75florian 1231014dae410799bfb128af2d396ee70374fa4b75florian 1331014dae410799bfb128af2d396ee70374fa4b75floriansub massage_backtrace_line ($$$) { 1431014dae410799bfb128af2d396ee70374fa4b75florian my ($line, $tool_files, $cmdlin_files) = @_; 1531014dae410799bfb128af2d396ee70374fa4b75florian my ($string, $qstring); 1631014dae410799bfb128af2d396ee70374fa4b75florian 1731014dae410799bfb128af2d396ee70374fa4b75florian# If LINE matches any of the file names passed on the command line 1831014dae410799bfb128af2d396ee70374fa4b75florian# (i.e. in CMDLIN_FILES) return LINE unmodified. 1931014dae410799bfb128af2d396ee70374fa4b75florian 2031014dae410799bfb128af2d396ee70374fa4b75florian foreach $string (@$cmdlin_files) { 2131014dae410799bfb128af2d396ee70374fa4b75florian $qstring = quotemeta($string); 2231014dae410799bfb128af2d396ee70374fa4b75florian return $line if ($line =~ /$qstring/); 2331014dae410799bfb128af2d396ee70374fa4b75florian } 2431014dae410799bfb128af2d396ee70374fa4b75florian 2531014dae410799bfb128af2d396ee70374fa4b75florian# If LINE matches any of the file names in TOOL_FILES remove the line 2631014dae410799bfb128af2d396ee70374fa4b75florian# number and return the so modified line. 2731014dae410799bfb128af2d396ee70374fa4b75florian 2831014dae410799bfb128af2d396ee70374fa4b75florian foreach $string (@$tool_files) { 2931014dae410799bfb128af2d396ee70374fa4b75florian $qstring = quotemeta($string); 3031014dae410799bfb128af2d396ee70374fa4b75florian return $line if ($line =~ s/$qstring:[0-9]+/$string:.../m); 3131014dae410799bfb128af2d396ee70374fa4b75florian# Special case for functions whose line numbers have been removed in 3231014dae410799bfb128af2d396ee70374fa4b75florian# filter_stderr_basic. FIXME: filter_stderr_basic should not do that. 3331014dae410799bfb128af2d396ee70374fa4b75florian return $line if ($line =~ s/$qstring:\.\.\./$string:.../m); 3431014dae410799bfb128af2d396ee70374fa4b75florian } 3531014dae410799bfb128af2d396ee70374fa4b75florian 3631014dae410799bfb128af2d396ee70374fa4b75florian# Did not match anything 3731014dae410799bfb128af2d396ee70374fa4b75florian $line =~ s/[\w]+.*/.../m; 3831014dae410799bfb128af2d396ee70374fa4b75florian 3931014dae410799bfb128af2d396ee70374fa4b75florian return "$line"; 4031014dae410799bfb128af2d396ee70374fa4b75florian} 4131014dae410799bfb128af2d396ee70374fa4b75florian 4231014dae410799bfb128af2d396ee70374fa4b75florian 4331014dae410799bfb128af2d396ee70374fa4b75florian#--------------------------------------------------------------------- 4431014dae410799bfb128af2d396ee70374fa4b75florian# Process lines. Two categories 4531014dae410799bfb128af2d396ee70374fa4b75florian# (a) lines from back traces 4631014dae410799bfb128af2d396ee70374fa4b75florian# pass through those lines that contain file names we're interested in 4731014dae410799bfb128af2d396ee70374fa4b75florian# (b) everything else 4831014dae410799bfb128af2d396ee70374fa4b75florian# pass through as is 4931014dae410799bfb128af2d396ee70374fa4b75florian#--------------------------------------------------------------------- 5031014dae410799bfb128af2d396ee70374fa4b75florianmy $prev_line = ""; 5131014dae410799bfb128af2d396ee70374fa4b75florianwhile (<STDIN>) { 5231014dae410799bfb128af2d396ee70374fa4b75florian my $line = $_; 5331014dae410799bfb128af2d396ee70374fa4b75florian chomp($line); 5431014dae410799bfb128af2d396ee70374fa4b75florian if ($line =~ /^\s+(at |by )/) { # lines in a back trace 5531014dae410799bfb128af2d396ee70374fa4b75florian $line = massage_backtrace_line($line, \@tool_files, \@ARGV); 5631014dae410799bfb128af2d396ee70374fa4b75florian if ($line =~ /\s+\.\.\./) { 5731014dae410799bfb128af2d396ee70374fa4b75florian print "$line\n" if ($prev_line !~ /\s+\.\.\./); 5831014dae410799bfb128af2d396ee70374fa4b75florian } else { 5931014dae410799bfb128af2d396ee70374fa4b75florian print "$line\n"; 6031014dae410799bfb128af2d396ee70374fa4b75florian } 6131014dae410799bfb128af2d396ee70374fa4b75florian } else { 6231014dae410799bfb128af2d396ee70374fa4b75florian print "$line\n"; # everything else 6331014dae410799bfb128af2d396ee70374fa4b75florian } 6431014dae410799bfb128af2d396ee70374fa4b75florian $prev_line = $line 6531014dae410799bfb128af2d396ee70374fa4b75florian} 6631014dae410799bfb128af2d396ee70374fa4b75florian 6731014dae410799bfb128af2d396ee70374fa4b75florianexit 0; 68