ncursesw-morphos/test/tracemunch
Thomas E. Dickey 1f7a36fe16 ncurses 6.2 - patch 20200829
+ remove a redundant NCURSES_EXPORT as a build-fix for "Maarten
  Anonymous".
+ merge/adapt in-progress work by Juergen Pfeifer for new version of
  win32-driver.
+ modify configure script, moving gcc -Werror options to EXTRA_CFLAGS
  to avoid breaking configure-checks (adapted from ongoing work on
  mawk and lynx).
> errate for terminfo.src (report by Florian Weimer):
+ correct icl6404 csr
+ correct ti916 cup
+ improve ndr9500
2020-08-30 01:38:16 +00:00

634 lines
20 KiB
Perl
Executable File

#!/usr/bin/env perl
# $Id: tracemunch,v 1.30 2020/08/29 18:59:58 tom Exp $
##############################################################################
# Copyright 2018-2019,2020 Thomas E. Dickey #
# Copyright 1998-2005,2017 Free Software Foundation, Inc. #
# #
# Permission is hereby granted, free of charge, to any person obtaining a #
# copy of this software and associated documentation files (the "Software"), #
# to deal in the Software without restriction, including without limitation #
# the rights to use, copy, modify, merge, publish, distribute, distribute #
# with modifications, sublicense, and/or sell copies of the Software, and to #
# permit persons to whom the Software is furnished to do so, subject to the #
# following conditions: #
# #
# The above copyright notice and this permission notice shall be included in #
# all copies or substantial portions of the Software. #
# #
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR #
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, #
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL #
# THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER #
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING #
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER #
# DEALINGS IN THE SOFTWARE. #
# #
# Except as contained in this notice, the name(s) of the above copyright #
# holders shall not be used in advertising or otherwise to promote the sale, #
# use or other dealings in this Software without prior written #
# authorization. #
##############################################################################
# tracemunch -- compactify ncurses trace logs
#
# The error logs produced by ncurses with tracing enabled can be very tedious
# to wade through. This script helps by compacting runs of log lines that
# can be conveniently expressed as higher-level operations.
use strict;
use warnings;
$| = 1;
our $putattr =
'PutAttrChar\(\{\{ ' . "'(.)'"
. ' = 0[0-7]+ \}\}\) at \(([0-9]+), ([0-9]+)\)';
our $waddnstr =
'^called \{waddnstr\((0x[[:xdigit:]]+|window\d+),"((\\.|[^\"]*))",[-]?[0-9]+\)';
our %TR = qw(
DISABLE 0x0000
TIMES 0x0001
TPUTS 0x0002
UPDATE 0x0004
MOVE 0x0008
CHARPUT 0x0010
ORDINARY 0x001F
CALLS 0x0020
VIRTPUT 0x0040
IEVENT 0x0080
BITS 0x0100
ICALLS 0x0200
CCALLS 0x0400
DATABASE 0x0800
ATTRS 0x1000
);
our $tracelevel = 0;
# If the trace is complete, we can infer addresses using the return value from
# newwin, etc. But if it is incomplete, we can still check for special cases
# such as SCREEN* and WINDOW* parameters. In this table, the type for the
# first parameter is encoded, relying upon an ncurses programming convention:
# 1 = SCREEN*
# 2 = WINDOW*
# 4 = TERMINAL*
our %known_p1 = qw(
TransformLine 1
_nc_console_read 1
_nc_freewin 2
_nc_initscr 1
_nc_makenew 1
_nc_mingw_console_read 1
_nc_reset_colors 1
_nc_scroll_optimize 1
_nc_tinfo 1
_nc_tinfo_mvcur 1
_nc_wgetch 2
adjust_window 2
assume_default_colors 1
attr_get 2
baudrate 1
beep 1
border_set 2
box 2
box_set 2
can_change_color 1
cbreak 1
clearok 2
color_content 1
copywin 2
curs_set 1
decrease_size 1
def_prog_mode 1
def_shell_mode 1
define_key 1
del_curterm 1
delay_output 1
delscreen 1
delwin 2
derwin 2
doupdate 1
dupwin 2
echo 1
endwin 1
erasechar 1
filter 1
flash 1
flushinp 1
getattrs 2
getbegx 2
getbegy 2
getbkgd 2
getcurx 2
getcury 2
getmaxx 2
getmaxy 2
getmouse 1
getparx 2
getpary 2
halfdelay 1
has_ic 1
has_il 1
has_key 1
idcok 2
idlok 2
immedok 2
increase_size 1
init_color 1
init_pair 1
intrflush 1
is_cleared 2
is_idcok 2
is_idlok 2
is_immedok 2
is_keypad 2
is_leaveok 2
is_linetouched 2
is_nodelay 2
is_notimeout 2
is_pad 2
is_scrollok 2
is_subwin 2
is_syncok 2
is_term_resized 1
is_wintouched 2
key_defined 1
keybound 1
keyok 1
keypad 2
killchar 1
leaveok 2
longname 1
meta 2
mouseinterval 1
mousemask 1
mvcur 1
mvderwin 2
mvwadd_wch 2
mvwadd_wchnstr 2
mvwadd_wchstr 2
mvwaddch 2
mvwaddchnstr 2
mvwaddchstr 2
mvwaddnstr 2
mvwaddnwstr 2
mvwaddstr 2
mvwaddwstr 2
mvwchgat 2
mvwdelch 2
mvwget_wch 2
mvwget_wstr 2
mvwgetch 2
mvwgetn_wstr 2
mvwgetnstr 2
mvwgetstr 2
mvwhline 2
mvwhline_set 2
mvwin 2
mvwin_wch 2
mvwin_wchnstr 2
mvwin_wchstr 2
mvwinch 2
mvwinchnstr 2
mvwinchstr 2
mvwins_nwstr 2
mvwins_wch 2
mvwins_wstr 2
mvwinsch 2
mvwinsnstr 2
mvwinsstr 2
mvwinstr 2
mvwinwstr 2
mvwvline 2
mvwvline_set 2
newpad 1
newterm 1
newwin 1
nl 1
nocbreak 1
nodelay 2
noecho 1
nofilter 1
nonl 1
noqiflush 1
noraw 1
notimeout 2
overlap 2
overlay 2
overwrite 2
pair_content 1
pecho_wchar 2
pechochar 2
pnoutrefresh 2
putwin 2
qiflush 1
raw 1
redrawwin 2
reset_prog_mode 1
reset_shell_mode 1
resetty 1
resize_term 1
resizeterm 1
restartterm 1
ripoffline 1
savetty 1
scr_init 1
scr_restore 1
scr_set 1
scroll 2
scrollok 2
set_curterm 4
set_term 1
slk_attr 1
slk_attr_set 1
slk_attroff 1
slk_attron 1
slk_attrset 1
slk_clear 1
slk_color 1
slk_init 1
slk_label 1
slk_noutrefresh 1
slk_refresh 1
slk_restore 1
slk_set 1
slk_touch 1
start_color 1
subwin 2
syncok 2
termattrs 1
termname 1
tgetflag 1
tgetnum 1
tigetflag 1
tigetnum 1
tigetstr 1
tinfo 1
touchline 2
touchwin 2
typeahead 1
unget_wch 1
ungetch 1
ungetmouse 1
untouchwin 2
use_default_colors 1
use_env 1
use_legacy_coding 1
use_screen 1
use_tioctl 1
use_window 2
vidattr 1
vidputs 1
vw_printw 2
vwprintw 2
wadd_wch 2
wadd_wchnstr 2
wadd_wchstr 2
waddch 2
waddchnstr 2
waddchstr 2
waddnstr 2
waddnwstr 2
waddstr 2
waddwstr 2
wattr_get 2
wattr_off 2
wattr_on 2
wattr_set 2
wattroff 2
wattron 2
wattrset 2
wbkgd 2
wbkgdset 2
wborder 2
wborder_set 2
wchgat 2
wclear 2
wclrtobot 2
wclrtoeol 2
wcolor_set 2
wcursyncup 2
wdelch 2
wdeleteln 2
wechochar 2
wenclose 2
werase 2
wget_wch 2
wget_wstr 2
wgetbkgrnd 2
wgetch 2
wgetch_events 2
wgetdelay 2
wgetn_wstr 2
wgetnstr 2
wgetparent 2
wgetscrreg 2
wgetstr 2
whline 2
whline_set 2
win_wch 2
win_wchnstr 2
win_wchstr 2
winch 2
winchnstr 2
winchstr 2
winnstr 2
winnwstr 2
wins_nwstr 2
wins_wch 2
wins_wstr 2
winsch 2
winsdelln 2
winsertln 2
winsnstr 2
winsstr 2
winstr 2
winwstr 2
wmouse_trafo 2
wmove 2
wnoutrefresh 2
wprintw 2
wredrawln 2
wrefresh 2
wresize 2
wscrl 2
wsetscrreg 2
wstandend 2
wstandout 2
wsyncdown 2
wsyncup 2
wtimeout 2
wtouchln 2
wvline 2
);
our $scr_nums = 0;
our $thr_nums = 0;
our $trm_nums = 0;
our $try_nums = 0;
our $win_nums = 0;
our $curscr = "";
our $newscr = "";
our $stdscr = "";
our %scr_addr;
our %thr_addr;
our %trm_addr;
our %try_addr;
our %win_addr;
sub has_addr($) {
my $value = shift;
my $result = 0;
$result = 1 if ( $value =~ /\b0x[[:xdigit:]]+\b/i );
return $result;
}
sub transaddr($) {
my $arg = shift;
my $n;
$arg =~ s/\b$curscr\b/curscr/g if ($curscr);
$arg =~ s/\b$newscr\b/newscr/g if ($newscr);
$arg =~ s/\b$stdscr\b/stdscr/g if ($stdscr);
if ( &has_addr($arg) ) {
foreach my $addr ( keys %scr_addr ) {
$n = $scr_addr{$addr};
$arg =~ s/\b$addr\b/screen$n/g if ( defined $n );
}
}
if ( &has_addr($arg) ) {
foreach my $addr ( keys %thr_addr ) {
$n = $thr_addr{$addr};
$arg =~ s/\b$addr\b/thread$n/g if ( defined $n );
}
}
if ( &has_addr($arg) ) {
foreach my $addr ( keys %trm_addr ) {
$n = $trm_addr{$addr};
$arg =~ s/\b$addr\b/terminal$n/g if ( defined $n );
}
}
if ( &has_addr($arg) ) {
foreach my $addr ( keys %try_addr ) {
$n = $try_addr{$addr};
$arg =~ s/\b$addr\b/tries_$n/g if ( defined $n );
}
}
if ( &has_addr($arg) ) {
foreach my $addr ( keys %win_addr ) {
$n = $win_addr{$addr};
$arg =~ s/\b$addr\b/window$n/g if ( defined $n );
}
}
if ( &has_addr($arg) ) {
if ( $arg =~ /add_wch\((window\d+,)?0x[[:xdigit:]]+\)/i ) {
$arg =~ s/(0x[[:xdigit:]]+)[)]/\&wch)/i;
}
elsif (
$arg =~ /color_content\((screen\d+,)?\d+(,0x[[:xdigit:]]+){3}/i )
{
$arg =~ s/(,0x[[:xdigit:]]+){3}[)]/,\&r,\&g,\&b)/i;
}
elsif ( $arg =~ /pair_content\((screen\d+,)?\d+(,0x[[:xdigit:]]+){2}/i )
{
$arg =~ s/(,0x[[:xdigit:]]+){2}[)]/,\&fg,\&bg)/i;
}
}
if ( &has_addr($arg) and $arg =~ /called\s+\{/ ) {
my $func = $arg;
chomp $func;
$func =~ s/^.*called\s+\{([[:alnum:]_]+)\(.*$/$1/;
if ( defined $known_p1{$func} ) {
my $addr = $arg;
my $type = $known_p1{$func};
chomp $addr;
$addr =~ s/^[^(]+\((0x[[:xdigit:]]+).*/$1/i;
if ( $addr !~ /^0x[[:xdigit:]]+$/i ) {
printf "OOPS - expected type #$type, skipping\n>>$addr\n";
}
elsif ( $type == 1 ) {
$scr_addr{$addr} = ++$scr_nums;
$arg = &transaddr($arg);
}
elsif ( $type == 2 ) {
$win_addr{$addr} = ++$win_nums;
$arg = &transaddr($arg);
}
elsif ( $type == 4 ) {
$trm_addr{$addr} = ++$trm_nums;
$arg = &transaddr($arg);
}
}
}
return $arg;
}
sub muncher($) {
my $STDIN = shift;
while (<$STDIN>) {
my $addr;
my $n;
my $awaiting = "";
CLASSIFY: {
# just in case someone tries a file with cr/lf line-endings:
$_ =~ s/\r\n/\n/g;
$_ =~ s/\r/\n/g;
if ( $_ =~
/^TRACING NCURSES version.*\(tracelevel=(0x[[:xdigit:]]+)\)/ )
{
$tracelevel = hex $1;
print;
next;
}
my $thread = "";
if ( $_ =~ /^(0x[[:xdigit:]]+):/ ) {
$thr_addr{$1} = ++$thr_nums unless defined $thr_addr{$1};
$thread = "thread" . $thr_addr{$1} . ":";
$_ =~ s/^[^:]*://;
}
# Transform window pointer addresses so it's easier to compare logs
$awaiting = "curscr" if ( $_ =~ /creating curscr/ );
$awaiting = "newscr" if ( $_ =~ /creating newscr/ );
$awaiting = "stdscr" if ( $_ =~ /creating stdscr/ );
$awaiting = "screen" if ( $_ =~ /^(\+ )*called \{new_prescr\(\)/ );
if ( $_ =~ /^create :window 0x([[:xdigit:]]+)/ ) {
$addr = "0x$1";
if ( $awaiting eq "curscr" ) {
$curscr = $addr;
}
elsif ( $awaiting eq "newscr" ) {
$newscr = $addr;
}
elsif ( $awaiting eq "stdscr" ) {
$stdscr = $addr;
}
else {
$win_addr{$addr} = $win_nums++;
}
$awaiting = "";
}
elsif ( $_ =~ /^(\+ )*called \{set_curterm\((0x[[:xdigit:]]+)\)/ ) {
$trm_addr{$2} = ++$trm_nums unless defined $trm_addr{$2};
}
elsif ( $_ =~ /^(\+ )*called \{_nc_add_to_try\((0x[[:xdigit:]]+),/ )
{
$try_addr{$2} = ++$try_nums unless defined $try_addr{$2};
}
elsif ( $_ =~ /^(\+ )*_nc_alloc_screen_sp 0x([[:xdigit:]]+)/ ) {
$addr = "0x$2";
$scr_addr{$addr} = ++$scr_nums unless ( $scr_addr{$addr} );
$awaiting = "";
}
elsif ( $_ =~ /^(\+ )*return }0x([[:xdigit:]]+)/ ) {
$addr = "0x$2";
if ( $awaiting eq "screen" ) {
$scr_addr{$addr} = ++$scr_nums unless ( $scr_addr{$addr} );
}
}
elsif ( $_ =~ /^\.\.\.deleted win=0x([[:xdigit:]]+)/ ) {
$addr = "0x$1";
$_ = &transaddr($_);
if ( $addr eq $curscr ) {
$curscr = "";
}
elsif ( $addr eq $newscr ) {
$newscr = "";
}
elsif ( $addr eq $stdscr ) {
$stdscr = "";
}
else {
undef $win_addr{$addr};
}
}
# Compactify runs of PutAttrChar
if ( ( ( $tracelevel & $TR{CHARPUT} ) != 0 ) and $_ =~ /$putattr/ )
{
my $putattr_chars = $1;
my $starty = $2;
my $startx = $3;
while (<$STDIN>) {
if ( $_ =~ /$putattr/ ) {
$putattr_chars .= $1;
}
else {
next if ( $_ =~ /^PUTC 0x[[:xdigit:]]+.*/ );
next if ( $_ =~ /^\.\.\.skip.*/ );
next if ( $_ =~ /^forced to blank.*/ );
last;
}
}
print "RUN of PutAttrChar()s:"
. " \"$putattr_chars\" from ${starty}, ${startx}\n";
redo CLASSIFY;
}
# Compactify runs of waddnstr calls
if ( ( ( $tracelevel & $TR{CALLS} ) != 0 ) and $_ =~ /$waddnstr/ ) {
my $waddnstr_chars = $2;
my $winaddr = $1;
while (<$STDIN>) {
next if ( $_ =~ /^return \}0/ );
if ( $_ =~ /$waddnstr/ && $1 eq $winaddr ) {
$waddnstr_chars .= $2;
}
else {
last;
}
}
my $winaddstr = &transaddr($winaddr);
print "RUN of waddnstr()s:"
. " $winaddstr, \"$waddnstr_chars\"\n";
redo CLASSIFY;
}
# More transformations can go here
# Repeated runs of anything
my $anyline = &transaddr($_);
my $repeatcount = 1;
while (<$STDIN>) {
if ( &transaddr($_) eq $anyline ) {
$repeatcount++;
}
else {
last;
}
}
if ( $repeatcount > 1 ) {
print "${repeatcount} REPEATS OF $anyline";
}
else {
print $thread . $anyline;
}
redo CLASSIFY if $_;
} # :CLASSIFY
}
}
for my $tr ( keys %TR ) {
$TR{$tr} = hex $TR{$tr};
}
if ( $#ARGV >= 0 ) {
while ( $#ARGV >= 0 ) {
my $file = shift @ARGV;
open my $ifh, "<", $file or die $!;
&muncher($ifh);
}
}
else {
&muncher( \*STDIN );
}
# tracemunch ends here