X-Git-Url: https://ncurses.scripts.mit.edu/?p=ncurses.git;a=blobdiff_plain;f=test%2Ftracemunch;h=9d15dd58fbcb3dcd80bb659b1734a3953b9dadf6;hp=cdb91bc83560fc19ba3619091791f3c8cd1c9e1d;hb=cf6a62567b2365c8678b7d561845bdbd1739e5da;hpb=02c4e383be9337e73a0e75844dfd1047745adb28 diff --git a/test/tracemunch b/test/tracemunch index cdb91bc8..9d15dd58 100755 --- a/test/tracemunch +++ b/test/tracemunch @@ -1,7 +1,8 @@ #!/usr/bin/env perl -# $Id: tracemunch,v 1.19 2018/04/07 20:37:08 tom Exp $ +# $Id: tracemunch,v 1.29 2020/04/18 23:52:24 tom Exp $ ############################################################################## -# Copyright (c) 1998-2017,2018 Free Software Foundation, Inc. # +# 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"), # @@ -36,13 +37,333 @@ use strict; use warnings; +$| = 1; + our $putattr = - "PutAttrChar\\({{ '(.)' = 0[0-7]+ }}\\) at \\(([0-9]+), ([0-9]+)\\)"; + 'PutAttrChar\(\{\{ ' . "'(.)'" + . ' = 0[0-7]+ \}\}\) at \(([0-9]+), ([0-9]+)\)'; our $waddnstr = - "waddnstr\\(0x([[:xdigit:]]+),\"([^\"]+)\",[0-9]+\\) called {A_NORMAL}"; +'^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_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 = ""; @@ -50,168 +371,262 @@ our $newscr = ""; our $stdscr = ""; our %scr_addr; our %thr_addr; +our %trm_addr; our %try_addr; our %win_addr; -sub transaddr { +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; - my $arg = $_[0]; $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); - 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 %scr_addr ) { + $n = $scr_addr{$addr}; + $arg =~ s/\b$addr\b/screen$n/g if ( defined $n ); + } } - 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 %thr_addr ) { + $n = $thr_addr{$addr}; + $arg =~ s/\b$addr\b/thread$n/g if ( defined $n ); + } } - 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 %trm_addr ) { + $n = $trm_addr{$addr}; + $arg =~ s/\b$addr\b/terminal$n/g if ( defined $n ); + } } - 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) ) { + foreach my $addr ( keys %try_addr ) { + $n = $try_addr{$addr}; + $arg =~ s/\b$addr\b/tries_$n/g if ( defined $n ); + } } - if ( $arg =~ /add_wch\((window\d+,)?0x[[:xdigit:]]+\)/i ) { - $arg =~ s/(0x[[:xdigit:]]+)[)]/\&wch)/i; + 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 ); + } } - elsif ( $arg =~ /color_content\((screen\d+,)?\d+(,0x[[:xdigit:]]+){3}/i ) { - $arg =~ s/(,0x[[:xdigit:]]+){3}[)]/,\&r,\&g,\&b)/i; + 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; + } } - 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; } -while () { - my $addr; - my $n; - my $awaiting = ""; +sub muncher($) { + my $STDIN = shift; - CLASSIFY: { + while (<$STDIN>) { + my $addr; + my $n; + my $awaiting = ""; - my $thread = ""; - if ( $_ =~ /^(0x[[:xdigit:]]+):/ ) { - $thr_addr{$1} = ++$thr_nums unless defined $thr_addr{$1}; - $thread = "thread" . $thr_addr{$1} . ":"; - $_ =~ s/^[^:]*://; - } + CLASSIFY: { - # 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; + # 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; } - elsif ( $awaiting eq "stdscr" ) { - $stdscr = $addr; + + my $thread = ""; + if ( $_ =~ /^(0x[[:xdigit:]]+):/ ) { + $thr_addr{$1} = ++$thr_nums unless defined $thr_addr{$1}; + $thread = "thread" . $thr_addr{$1} . ":"; + $_ =~ s/^[^:]*://; } - else { - $win_addr{$addr} = $win_nums++; + + # 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 = ""; } - $awaiting = ""; - } - 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 ( $_ =~ /^(\+ )*called \{set_curterm\((0x[[:xdigit:]]+)\)/ ) { + $trm_addr{$2} = ++$trm_nums unless defined $trm_addr{$2}; } - } - elsif ( $_ =~ /^\.\.\.deleted win=0x([[:xdigit:]]+)/ ) { - $addr = "0x$1"; - $_ = &transaddr($_); - if ( $addr eq $curscr ) { - $curscr = ""; + elsif ( $_ =~ /^(\+ )*called \{_nc_add_to_try\((0x[[:xdigit:]]+),/ ) + { + $try_addr{$2} = ++$try_nums unless defined $try_addr{$2}; } - elsif ( $addr eq $newscr ) { - $newscr = ""; + elsif ( $_ =~ /^(\+ )*_nc_alloc_screen_sp 0x([[:xdigit:]]+)/ ) { + $addr = "0x$2"; + $scr_addr{$addr} = ++$scr_nums unless ( $scr_addr{$addr} ); + $awaiting = ""; } - elsif ( $addr eq $stdscr ) { - $stdscr = ""; + elsif ( $_ =~ /^(\+ )*return }0x([[:xdigit:]]+)/ ) { + $addr = "0x$2"; + if ( $awaiting eq "screen" ) { + $scr_addr{$addr} = ++$scr_nums unless ( $scr_addr{$addr} ); + } } - else { - undef $win_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 calls (TR_CHARPUT) - if ( $_ =~ /$putattr/ ) { - my $putattr_chars = $1; - my $starty = $2; - my $startx = $3; - while () { - if ( $_ =~ /$putattr/ ) { - $putattr_chars .= $1; + # 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; + } } - else { - 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; } - print -"RUN of PutAttrChar()s: \"$putattr_chars\" from ${starty}, ${startx}\n"; - redo CLASSIFY; - } - # Compactify runs of waddnstr calls (TR_CALLS) - if ( $_ =~ /$waddnstr/ ) { - my $waddnstr_chars = $2; - my $winaddr = $1; - while () { - if ( $_ =~ /$waddnstr/ && $1 eq $winaddr ) { - $waddnstr_chars .= $2; + # More transformations can go here + + # Repeated runs of anything + my $anyline = &transaddr($_); + my $repeatcount = 1; + while (<$STDIN>) { + if ( &transaddr($_) eq $anyline ) { + $repeatcount++; } else { last; } } - my $winaddstr = &transaddr($winaddr); - print "RUN of waddnstr()s: $winaddr, \"$waddnstr_chars\"\n"; - redo CLASSIFY; - } - - # More transformations can go here - - # Repeated runs of anything - my $anyline = &transaddr($_); - my $repeatcount = 1; - while () { - if ( &transaddr($_) eq $anyline ) { - $repeatcount++; + if ( $repeatcount > 1 ) { + print "${repeatcount} REPEATS OF $anyline"; } else { - last; + print $thread . $anyline; } - } - if ( $repeatcount > 1 ) { - print "${repeatcount} REPEATS OF $anyline"; - } - else { - print $thread . $anyline; - } - redo CLASSIFY if $_; + redo CLASSIFY if $_; + + } # :CLASSIFY + } +} - } # :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