mirror of
https://github.com/Aigor44/ncursesw-morphos.git
synced 2024-12-21 07:39:06 +08:00
99 lines
2.2 KiB
Plaintext
99 lines
2.2 KiB
Plaintext
|
#!/usr/bin/perl
|
||
|
#
|
||
|
# 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.
|
||
|
#
|
||
|
# ($Id: tracemunch,v 1.2 1995/10/06 15:02:37 esr Exp $)
|
||
|
|
||
|
$putattr="PutAttrChar\\('(.)' = 0x.., {A_NORMAL}\\) at \\(([0-9]+), ([0-9]+)\\)";
|
||
|
$waddnstr="waddnstr\\(0x([0-9a-f]+),\"([^\"]+)\",[0-9]+\\) called {A_NORMAL}";
|
||
|
|
||
|
sub transaddr
|
||
|
{
|
||
|
$arg = $_[0];
|
||
|
|
||
|
$arg =~ s/$curscr/curscr/ if ($curscr);
|
||
|
$arg =~ s/$newscr/newscr/ if ($newscr);
|
||
|
$arg =~ s/$stdscr/stdscr/ if ($stdscr);
|
||
|
|
||
|
return $arg;
|
||
|
}
|
||
|
|
||
|
while (<STDIN>)
|
||
|
{
|
||
|
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/);
|
||
|
if ($awaiting && $_ =~ /newwin: returned window is 0x([0-9a-f]+)/)
|
||
|
{
|
||
|
$curscr = "0x$1" if ($awaiting eq "curscr");
|
||
|
$newscr = "0x$1" if ($awaiting eq "newscr");
|
||
|
$stdscr = "0x$1" if ($awaiting eq "stdscr");
|
||
|
$awaiting = "";
|
||
|
}
|
||
|
|
||
|
# Compactify runs of PutAttrChar calls (TR_CHARPUT)
|
||
|
if ($_ =~ /$putattr/)
|
||
|
{
|
||
|
$putattr_chars = $1;
|
||
|
$starty = $2;
|
||
|
$startx = $3;
|
||
|
while (<STDIN>)
|
||
|
{
|
||
|
if ($_ =~ /$putattr/) {
|
||
|
$putattr_chars .= $1;
|
||
|
} else {
|
||
|
last;
|
||
|
}
|
||
|
}
|
||
|
print "RUN of PutAttrChar()s: \"$putattr_chars\" from ${starty}, ${startx}\n";
|
||
|
redo CLASSIFY;
|
||
|
}
|
||
|
|
||
|
# Compactify runs of waddnstr calls (TR_CALLS)
|
||
|
if ($_ =~ /$waddnstr/)
|
||
|
{
|
||
|
$waddnstr_chars = $2;
|
||
|
$winaddr = $1;
|
||
|
while (<STDIN>)
|
||
|
{
|
||
|
if ($_ =~ /$waddnstr/ && $1 eq $winaddr) {
|
||
|
$waddnstr_chars .= $2;
|
||
|
} else {
|
||
|
last;
|
||
|
}
|
||
|
}
|
||
|
$winaddstr = &transaddr($winaddr);
|
||
|
print "RUN of waddnstr()s: $winaddr, \"$waddnstr_chars\"\n";
|
||
|
redo CLASSIFY;
|
||
|
}
|
||
|
|
||
|
# More transformations can go here
|
||
|
|
||
|
# Repeated runs of anything
|
||
|
$anyline = &transaddr($_);
|
||
|
$repeatcount = 1;
|
||
|
while (<STDIN>) {
|
||
|
if (&transaddr($_) eq $anyline) {
|
||
|
$repeatcount++;
|
||
|
} else {
|
||
|
last;
|
||
|
}
|
||
|
}
|
||
|
if ($repeatcount > 1) {
|
||
|
print "${repeatcount} REPEATS OF $anyline";
|
||
|
} else {
|
||
|
print $anyline
|
||
|
}
|
||
|
redo CLASSIFY if $_;
|
||
|
|
||
|
} # :CLASSIFY
|
||
|
}
|
||
|
|
||
|
# tracemunch ends here
|