X-Git-Url: http://ncurses.scripts.mit.edu/?p=ncurses.git;a=blobdiff_plain;f=test%2Ftracemunch;h=0e05aaee58d189d52723e30ad06d947148c68461;hp=a56c44ad9f4537ff50bb648e687175f101c9517b;hb=7d6371e47006c8aef4ac94f52998a35b03bf89cf;hpb=07e31b3b587a07281ff7c71e5c13248a31048257 diff --git a/test/tracemunch b/test/tracemunch index a56c44ad..0e05aaee 100755 --- a/test/tracemunch +++ b/test/tracemunch @@ -1,7 +1,7 @@ #!/usr/bin/env perl -# $Id: tracemunch,v 1.9 2017/05/07 19:59:08 tom Exp $ +# $Id: tracemunch,v 1.20 2018/05/02 00:14:29 tom Exp $ ############################################################################## -# Copyright (c) 1998-2005,2017 Free Software Foundation, Inc. # +# Copyright (c) 1998-2017,2018 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"), # @@ -37,17 +37,20 @@ use strict; use warnings; 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}"; + 'waddnstr\(0x([[:xdigit:]]+),"([^\"]+)",[0-9]+\) called \{A_NORMAL\}'; our $scr_nums = 0; +our $thr_nums = 0; our $try_nums = 0; our $win_nums = 0; our $curscr = ""; our $newscr = ""; our $stdscr = ""; our %scr_addr; +our %thr_addr; our %try_addr; our %win_addr; @@ -60,15 +63,28 @@ sub transaddr { $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; + $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 ); } foreach my $addr ( keys %try_addr ) { $n = $try_addr{$addr}; - $arg =~ s/\b$addr\b/tries_$n/g; + $arg =~ s/\b$addr\b/tries_$n/g if ( defined $n ); } foreach my $addr ( keys %win_addr ) { $n = $win_addr{$addr}; - $arg =~ s/\b$addr\b/window$n/g; + $arg =~ s/\b$addr\b/window$n/g if ( defined $n ); + } + 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; } return $arg; @@ -77,15 +93,22 @@ sub transaddr { while () { my $addr; my $n; - my $awaiting; + my $awaiting = ""; CLASSIFY: { + 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\(\)/ ); + $awaiting = "screen" if ( $_ =~ /^(\+ )*called \{new_prescr\(\)/ ); if ( $_ =~ /^create :window 0x([[:xdigit:]]+)/ ) { $addr = "0x$1"; if ( $awaiting eq "curscr" ) { @@ -102,13 +125,18 @@ while () { } $awaiting = ""; } - elsif ( $_ =~ /^(\+ )*called {_nc_add_to_try\((0x[[:xdigit:]]+),/ ) { + 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; + $scr_addr{$addr} = ++$scr_nums unless ( $scr_addr{$addr} ); } } elsif ( $_ =~ /^\.\.\.deleted win=0x([[:xdigit:]]+)/ ) { @@ -180,7 +208,7 @@ while () { print "${repeatcount} REPEATS OF $anyline"; } else { - print $anyline; + print $thread . $anyline; } redo CLASSIFY if $_;