ncurses 5.9 - patch 20130112
[ncurses.git] / test / tracemunch
1 #!/usr/bin/perl -w
2 # $Id: tracemunch,v 1.6 2005/03/12 21:48:23 tom Exp $
3 ##############################################################################
4 # Copyright (c) 1998-2002,2005 Free Software Foundation, Inc.                #
5 #                                                                            #
6 # Permission is hereby granted, free of charge, to any person obtaining a    #
7 # copy of this software and associated documentation files (the "Software"), #
8 # to deal in the Software without restriction, including without limitation  #
9 # the rights to use, copy, modify, merge, publish, distribute, distribute    #
10 # with modifications, sublicense, and/or sell copies of the Software, and to #
11 # permit persons to whom the Software is furnished to do so, subject to the  #
12 # following conditions:                                                      #
13 #                                                                            #
14 # The above copyright notice and this permission notice shall be included in #
15 # all copies or substantial portions of the Software.                        #
16 #                                                                            #
17 # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR #
18 # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,   #
19 # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL    #
20 # THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER      #
21 # LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING    #
22 # FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER        #
23 # DEALINGS IN THE SOFTWARE.                                                  #
24 #                                                                            #
25 # Except as contained in this notice, the name(s) of the above copyright     #
26 # holders shall not be used in advertising or otherwise to promote the sale, #
27 # use or other dealings in this Software without prior written               #
28 # authorization.                                                             #
29 ##############################################################################
30 # tracemunch -- compactify ncurses trace logs
31 #
32 # The error logs produced by ncurses with tracing enabled can be very tedious
33 # to wade through.  This script helps by compacting runs of log lines that
34 # can be conveniently expressed as higher-level operations.
35 use strict;
36
37 our $putattr="PutAttrChar\\({{ '(.)' = 0[0-7]+ }}\\) at \\(([0-9]+), ([0-9]+)\\)";
38 our $waddnstr="waddnstr\\(0x([0-9a-f]+),\"([^\"]+)\",[0-9]+\\) called {A_NORMAL}";
39
40 our $win_nums=0;
41 our $curscr="";
42 our $newscr="";
43 our $stdscr="";
44 our @win_addr;
45
46 sub transaddr
47 {
48     my $n;
49     my $arg = $_[0];
50
51     $arg =~ s/$curscr/curscr/g if ($curscr);
52     $arg =~ s/$newscr/newscr/g if ($newscr);
53     $arg =~ s/$stdscr/stdscr/g if ($stdscr);
54     for $n (0..$#win_addr) {
55         $arg =~ s/$win_addr[$n]/window$n/g if $win_addr[$n];
56     }
57
58     return $arg;
59 }
60
61 while (<STDIN>)
62 {
63         my $addr;
64         my $n;
65         my $awaiting;
66
67 CLASSIFY: {
68         # Transform window pointer addresses so it's easier to compare logs
69         $awaiting = "curscr" if ($_ =~ /creating curscr/);
70         $awaiting = "newscr" if ($_ =~ /creating newscr/);
71         $awaiting = "stdscr" if ($_ =~ /creating stdscr/);
72         if ($_ =~ /^create :window 0x([0-9a-f]+)/) {
73             $addr = "0x$1";
74             if ($awaiting eq "curscr") {
75                 $curscr = $addr;
76             } elsif ($awaiting eq "newscr") {
77                 $newscr = $addr;
78             } elsif ($awaiting eq "stdscr") {
79                 $stdscr = $addr;
80             } else {
81                 $win_addr[$win_nums] = $addr;
82                 $win_nums = $win_nums + 1;
83             }
84             $awaiting = "";
85         } elsif ($_ =~ /^\.\.\.deleted win=0x([0-9a-f]+)/) {
86             $addr = "0x$1";
87             $_ = &transaddr($_);
88             if ($addr eq $curscr) {
89                 $curscr = "";
90             } elsif ($addr eq $newscr) {
91                 $newscr = "";
92             } elsif ($addr eq $stdscr) {
93                 $stdscr = "";
94             } else {
95                 for $n (0..$#win_addr) {
96                     if ($win_addr[$n] eq $addr) {
97                         $win_addr[$n] = "";
98                     }
99                 }
100             }
101         }
102
103         # Compactify runs of PutAttrChar calls (TR_CHARPUT)
104         if ($_ =~ /$putattr/)
105         {
106                 my $putattr_chars = $1;
107                 my $starty = $2;
108                 my $startx = $3;
109                 while (<STDIN>)
110                 {
111                         if ($_ =~ /$putattr/) {
112                                 $putattr_chars .= $1;
113                         } else {
114                                 last;
115                         }
116                 }
117                 print "RUN of PutAttrChar()s: \"$putattr_chars\" from ${starty}, ${startx}\n";
118                 redo CLASSIFY;
119         }
120
121         # Compactify runs of waddnstr calls (TR_CALLS)
122         if ($_ =~ /$waddnstr/)
123         {
124                 my $waddnstr_chars = $2;
125                 my $winaddr = $1;
126                 while (<STDIN>)
127                 {
128                         if ($_ =~ /$waddnstr/ && $1 eq $winaddr) {
129                                 $waddnstr_chars .= $2;
130                         } else {
131                                 last;
132                         }
133                 }
134                 my $winaddstr = &transaddr($winaddr);
135                 print "RUN of waddnstr()s: $winaddr, \"$waddnstr_chars\"\n";
136                 redo CLASSIFY;
137         }
138
139         # More transformations can go here
140
141         # Repeated runs of anything
142         my $anyline = &transaddr($_);
143         my $repeatcount = 1;
144         while (<STDIN>) {
145             if (&transaddr($_) eq $anyline) {
146                 $repeatcount++;
147             } else {
148                 last;
149             }
150         }
151         if ($repeatcount > 1) {
152                 print "${repeatcount} REPEATS OF $anyline";
153         } else {
154                 print $anyline
155         }
156         redo CLASSIFY if $_;
157
158         } # :CLASSIFY
159 }
160
161 # tracemunch ends here