ncurses 6.2 - patch 20210227
[ncurses.git] / test / tracemunch
1 #!/usr/bin/env perl
2 # $Id: tracemunch,v 1.33 2020/12/26 23:56:50 tom Exp $
3 ##############################################################################
4 # Copyright 2018-2019,2020 Thomas E. Dickey                                  #
5 # Copyright 1998-2005,2017 Free Software Foundation, Inc.                    #
6 #                                                                            #
7 # Permission is hereby granted, free of charge, to any person obtaining a    #
8 # copy of this software and associated documentation files (the "Software"), #
9 # to deal in the Software without restriction, including without limitation  #
10 # the rights to use, copy, modify, merge, publish, distribute, distribute    #
11 # with modifications, sublicense, and/or sell copies of the Software, and to #
12 # permit persons to whom the Software is furnished to do so, subject to the  #
13 # following conditions:                                                      #
14 #                                                                            #
15 # The above copyright notice and this permission notice shall be included in #
16 # all copies or substantial portions of the Software.                        #
17 #                                                                            #
18 # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR #
19 # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,   #
20 # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL    #
21 # THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER      #
22 # LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING    #
23 # FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER        #
24 # DEALINGS IN THE SOFTWARE.                                                  #
25 #                                                                            #
26 # Except as contained in this notice, the name(s) of the above copyright     #
27 # holders shall not be used in advertising or otherwise to promote the sale, #
28 # use or other dealings in this Software without prior written               #
29 # authorization.                                                             #
30 ##############################################################################
31 # tracemunch -- compactify ncurses trace logs
32 #
33 # The error logs produced by ncurses with tracing enabled can be very tedious
34 # to wade through.  This script helps by compacting runs of log lines that
35 # can be conveniently expressed as higher-level operations.
36
37 use strict;
38 use warnings;
39
40 $| = 1;
41
42 our $putattr =
43     'PutAttrChar\(\{\{ ' . "'(.)'"
44   . ' = 0[0-7]+ \}\}\) at \(([0-9]+), ([0-9]+)\)';
45 our $waddnstr =
46 '^called \{waddnstr\((0x[[:xdigit:]]+|window\d+),"((\\.|[^\"]*))",[-]?[0-9]+\)';
47
48 our %TR = qw(
49   DISABLE       0x0000
50   TIMES         0x0001
51   TPUTS         0x0002
52   UPDATE        0x0004
53   MOVE          0x0008
54   CHARPUT       0x0010
55   ORDINARY      0x001F
56   CALLS         0x0020
57   VIRTPUT       0x0040
58   IEVENT        0x0080
59   BITS          0x0100
60   ICALLS        0x0200
61   CCALLS        0x0400
62   DATABASE      0x0800
63   ATTRS         0x1000
64 );
65
66 our $tracelevel = 0;
67
68 # If the trace is complete, we can infer addresses using the return value from
69 # newwin, etc.  But if it is incomplete, we can still check for special cases
70 # such as SCREEN* and WINDOW* parameters.  In this table, the type for the
71 # first parameter is encoded, relying upon an ncurses programming convention:
72 # 1 = SCREEN*
73 # 2 = WINDOW*
74 # 4 = TERMINAL*
75 # 8 = PANEL*
76 our %known_p1 = qw(
77   TransformLine           1
78   _nc_console_read        1
79   _nc_freewin             2
80   _nc_initscr             1
81   _nc_makenew             1
82   _nc_mingw_console_read  1
83   _nc_reset_colors        1
84   _nc_scroll_optimize     1
85   _nc_tinfo               1
86   _nc_tinfo_mvcur         1
87   _nc_wgetch              2
88   adjust_window           2
89   assume_default_colors   1
90   attr_get                2
91   baudrate                1
92   beep                    1
93   border_set              2
94   bottom_panel            8
95   box                     2
96   box_set                 2
97   can_change_color        1
98   cbreak                  1
99   clearok                 2
100   color_content           1
101   copywin                 2
102   curs_set                1
103   decrease_size           1
104   def_prog_mode           1
105   def_shell_mode          1
106   define_key              1
107   del_curterm             1
108   del_panel               8
109   delay_output            1
110   delscreen               1
111   delwin                  2
112   derwin                  2
113   doupdate                1
114   dupwin                  2
115   echo                    1
116   endwin                  1
117   erasechar               1
118   filter                  1
119   flash                   1
120   flushinp                1
121   getattrs                2
122   getbegx                 2
123   getbegy                 2
124   getbkgd                 2
125   getcurx                 2
126   getcury                 2
127   getmaxx                 2
128   getmaxy                 2
129   getmouse                1
130   getparx                 2
131   getpary                 2
132   halfdelay               1
133   has_ic                  1
134   has_il                  1
135   has_key                 1
136   hide_panel              8
137   idcok                   2
138   idlok                   2
139   immedok                 2
140   increase_size           1
141   init_color              1
142   init_pair               1
143   intrflush               1
144   is_cleared              2
145   is_idcok                2
146   is_idlok                2
147   is_immedok              2
148   is_keypad               2
149   is_leaveok              2
150   is_linetouched          2
151   is_nodelay              2
152   is_notimeout            2
153   is_pad                  2
154   is_scrollok             2
155   is_subwin               2
156   is_syncok               2
157   is_term_resized         1
158   is_wintouched           2
159   key_defined             1
160   keybound                1
161   keyok                   1
162   keypad                  2
163   killchar                1
164   leaveok                 2
165   longname                1
166   meta                    2
167   mouseinterval           1
168   mousemask               1
169   move_panel              8
170   mvcur                   1
171   mvderwin                2
172   mvwadd_wch              2
173   mvwadd_wchnstr          2
174   mvwadd_wchstr           2
175   mvwaddch                2
176   mvwaddchnstr            2
177   mvwaddchstr             2
178   mvwaddnstr              2
179   mvwaddnwstr             2
180   mvwaddstr               2
181   mvwaddwstr              2
182   mvwchgat                2
183   mvwdelch                2
184   mvwget_wch              2
185   mvwget_wstr             2
186   mvwgetch                2
187   mvwgetn_wstr            2
188   mvwgetnstr              2
189   mvwgetstr               2
190   mvwhline                2
191   mvwhline_set            2
192   mvwin                   2
193   mvwin_wch               2
194   mvwin_wchnstr           2
195   mvwin_wchstr            2
196   mvwinch                 2
197   mvwinchnstr             2
198   mvwinchstr              2
199   mvwins_nwstr            2
200   mvwins_wch              2
201   mvwins_wstr             2
202   mvwinsch                2
203   mvwinsnstr              2
204   mvwinsstr               2
205   mvwinstr                2
206   mvwinwstr               2
207   mvwvline                2
208   mvwvline_set            2
209   new_panel               2
210   newpad                  1
211   newterm                 1
212   newwin                  1
213   nl                      1
214   nocbreak                1
215   nodelay                 2
216   noecho                  1
217   nofilter                1
218   nonl                    1
219   noqiflush               1
220   noraw                   1
221   notimeout               2
222   overlap                 2
223   overlay                 2
224   overwrite               2
225   pair_content            1
226   panel_above             8
227   panel_below             8
228   panel_hidden            8
229   panel_userptr           8
230   panel_window            8
231   pecho_wchar             2
232   pechochar               2
233   pnoutrefresh            2
234   putwin                  2
235   qiflush                 1
236   raw                     1
237   redrawwin               2
238   replace_panel           8
239   reset_prog_mode         1
240   reset_shell_mode        1
241   resetty                 1
242   resize_term             1
243   resizeterm              1
244   restartterm             1
245   ripoffline              1
246   savetty                 1
247   scr_init                1
248   scr_restore             1
249   scr_set                 1
250   scroll                  2
251   scrollok                2
252   set_curterm             4
253   set_panel_userptr       8
254   set_term                1
255   show_panel              8
256   slk_attr                1
257   slk_attr_set            1
258   slk_attroff             1
259   slk_attron              1
260   slk_attrset             1
261   slk_clear               1
262   slk_color               1
263   slk_init                1
264   slk_label               1
265   slk_noutrefresh         1
266   slk_refresh             1
267   slk_restore             1
268   slk_set                 1
269   slk_touch               1
270   start_color             1
271   subwin                  2
272   syncok                  2
273   termattrs               1
274   termname                1
275   tgetflag                1
276   tgetnum                 1
277   tigetflag               1
278   tigetnum                1
279   tigetstr                1
280   tinfo                   1
281   top_panel               8
282   touchline               2
283   touchwin                2
284   typeahead               1
285   unget_wch               1
286   ungetch                 1
287   ungetmouse              1
288   untouchwin              2
289   use_default_colors      1
290   use_env                 1
291   use_legacy_coding       1
292   use_screen              1
293   use_tioctl              1
294   use_window              2
295   vidattr                 1
296   vidputs                 1
297   vw_printw               2
298   vwprintw                2
299   wadd_wch                2
300   wadd_wchnstr            2
301   wadd_wchstr             2
302   waddch                  2
303   waddchnstr              2
304   waddchstr               2
305   waddnstr                2
306   waddnwstr               2
307   waddstr                 2
308   waddwstr                2
309   wattr_get               2
310   wattr_off               2
311   wattr_on                2
312   wattr_set               2
313   wattroff                2
314   wattron                 2
315   wattrset                2
316   wbkgd                   2
317   wbkgdset                2
318   wborder                 2
319   wborder_set             2
320   wchgat                  2
321   wclear                  2
322   wclrtobot               2
323   wclrtoeol               2
324   wcolor_set              2
325   wcursyncup              2
326   wdelch                  2
327   wdeleteln               2
328   wechochar               2
329   wenclose                2
330   werase                  2
331   wget_wch                2
332   wget_wstr               2
333   wgetbkgrnd              2
334   wgetch                  2
335   wgetch_events           2
336   wgetdelay               2
337   wgetn_wstr              2
338   wgetnstr                2
339   wgetparent              2
340   wgetscrreg              2
341   wgetstr                 2
342   whline                  2
343   whline_set              2
344   win_wch                 2
345   win_wchnstr             2
346   win_wchstr              2
347   winch                   2
348   winchnstr               2
349   winchstr                2
350   winnstr                 2
351   winnwstr                2
352   wins_nwstr              2
353   wins_wch                2
354   wins_wstr               2
355   winsch                  2
356   winsdelln               2
357   winsertln               2
358   winsnstr                2
359   winsstr                 2
360   winstr                  2
361   winwstr                 2
362   wmouse_trafo            2
363   wmove                   2
364   wnoutrefresh            2
365   wprintw                 2
366   wredrawln               2
367   wrefresh                2
368   wresize                 2
369   wscrl                   2
370   wsetscrreg              2
371   wstandend               2
372   wstandout               2
373   wsyncdown               2
374   wsyncup                 2
375   wtimeout                2
376   wtouchln                2
377   wvline                  2
378 );
379
380 our $pan_nums = 0;
381 our $scr_nums = 0;
382 our $thr_nums = 0;
383 our $trm_nums = 0;
384 our $try_nums = 0;
385 our $usr_nums = 0;
386 our $win_nums = 0;
387
388 our $curscr = "";
389 our $newscr = "";
390 our $stdscr = "";
391
392 our %pan_addr;
393 our %scr_addr;
394 our %thr_addr;
395 our %trm_addr;
396 our %try_addr;
397 our %usr_addr;
398 our %win_addr;
399
400 sub has_addr($) {
401     my $value  = shift;
402     my $result = 0;
403     $result = 1 if ( $value =~ /\b0x[[:xdigit:]]+\b/i );
404     return $result;
405 }
406
407 sub transaddr($) {
408     my $arg = shift;
409     my $n;
410
411     $arg =~ s/\b$curscr\b/curscr/g if ($curscr);
412     $arg =~ s/\b$newscr\b/newscr/g if ($newscr);
413     $arg =~ s/\b$stdscr\b/stdscr/g if ($stdscr);
414     if ( &has_addr($arg) ) {
415         foreach my $addr ( keys %pan_addr ) {
416             $n = $pan_addr{$addr};
417             $arg =~ s/\b$addr\b/panel$n/g if ( defined $n );
418         }
419     }
420     if ( &has_addr($arg) ) {
421         foreach my $addr ( keys %scr_addr ) {
422             $n = $scr_addr{$addr};
423             $arg =~ s/\b$addr\b/screen$n/g if ( defined $n );
424         }
425     }
426     if ( &has_addr($arg) ) {
427         foreach my $addr ( keys %thr_addr ) {
428             $n = $thr_addr{$addr};
429             $arg =~ s/\b$addr\b/thread$n/g if ( defined $n );
430         }
431     }
432     if ( &has_addr($arg) ) {
433         foreach my $addr ( keys %trm_addr ) {
434             $n = $trm_addr{$addr};
435             $arg =~ s/\b$addr\b/terminal$n/g if ( defined $n );
436         }
437     }
438     if ( &has_addr($arg) ) {
439         foreach my $addr ( keys %try_addr ) {
440             $n = $try_addr{$addr};
441             $arg =~ s/\b$addr\b/tries_$n/g if ( defined $n );
442         }
443     }
444     if ( &has_addr($arg) ) {
445         foreach my $addr ( keys %usr_addr ) {
446             $n = $usr_addr{$addr};
447             $arg =~ s/\b$addr\b/user_ptr$n/g if ( defined $n );
448         }
449     }
450     if ( &has_addr($arg) ) {
451         foreach my $addr ( keys %win_addr ) {
452             $n = $win_addr{$addr};
453             $arg =~ s/\b$addr\b/window$n/g if ( defined $n );
454         }
455     }
456     if ( &has_addr($arg) ) {
457         if ( $arg =~ /add_wch\((window\d+,)?0x[[:xdigit:]]+\)/i ) {
458             $arg =~ s/(0x[[:xdigit:]]+)[)]/\&wch)/i;
459         }
460         elsif (
461             $arg =~ /color_content\((screen\d+,)?\d+(,0x[[:xdigit:]]+){3}/i )
462         {
463             $arg =~ s/(,0x[[:xdigit:]]+){3}[)]/,\&r,\&g,\&b)/i;
464         }
465         elsif ( $arg =~ /pair_content\((screen\d+,)?\d+(,0x[[:xdigit:]]+){2}/i )
466         {
467             $arg =~ s/(,0x[[:xdigit:]]+){2}[)]/,\&fg,\&bg)/i;
468         }
469     }
470     if ( &has_addr($arg) and $arg =~ /called\s+\{/ ) {
471         my $func = $arg;
472         chomp $func;
473         $func =~ s/^.*called\s+\{([[:alnum:]_]+)\(.*$/$1/;
474         if ( defined $known_p1{$func} ) {
475             my $addr = $arg;
476             my $type = $known_p1{$func};
477             chomp $addr;
478             $addr =~ s/^[^(]+\((0x[[:xdigit:]]+).*/$1/i;
479             if ( $addr !~ /^0x[[:xdigit:]]+$/i ) {
480                 printf "OOPS - expected type #$type, skipping\n>>$addr\n";
481             }
482             elsif ( $type == 1 ) {
483                 $scr_addr{$addr} = ++$scr_nums;
484                 $arg = &transaddr($arg);
485             }
486             elsif ( $type == 2 ) {
487                 $win_addr{$addr} = ++$win_nums;
488                 $arg = &transaddr($arg);
489             }
490             elsif ( $type == 4 ) {
491                 $trm_addr{$addr} = ++$trm_nums;
492                 $arg = &transaddr($arg);
493             }
494             elsif ( $type == 8 ) {
495                 $pan_addr{$addr} = ++$pan_nums;
496                 $arg = &transaddr($arg);
497             }
498         }
499     }
500
501     return $arg;
502 }
503
504 sub muncher($) {
505     my $STDIN = shift;
506
507     while (<$STDIN>) {
508         my $addr;
509         my $n;
510         my $awaiting = "";
511
512       CLASSIFY: {
513
514             next unless $_;
515
516             # just in case someone tries a file with cr/lf line-endings:
517             $_ =~ s/\r\n/\n/g;
518             $_ =~ s/\r/\n/g;
519
520             if ( $_ =~
521                 /^TRACING NCURSES version.*\(tracelevel=(0x[[:xdigit:]]+)\)/ )
522             {
523                 $tracelevel = hex $1;
524                 print;
525                 next;
526             }
527
528             my $thread = "";
529             if ( $_ =~ /^(0x[[:xdigit:]]+):/ ) {
530                 $thr_addr{$1} = ++$thr_nums unless defined $thr_addr{$1};
531                 $thread = "thread" . $thr_addr{$1} . ":";
532                 $_ =~ s/^[^:]*://;
533             }
534
535             # Transform window pointer addresses so it's easier to compare logs
536             $awaiting = "curscr" if ( $_ =~ /creating curscr/ );
537             $awaiting = "newscr" if ( $_ =~ /creating newscr/ );
538             $awaiting = "stdscr" if ( $_ =~ /creating stdscr/ );
539             $awaiting = "screen" if ( $_ =~ /^(\+ )*called \{new_prescr\(\)/ );
540             if ( $_ =~ /^create :window 0x([[:xdigit:]]+)/ ) {
541                 $addr = "0x$1";
542                 if ( $awaiting eq "curscr" ) {
543                     $curscr = $addr;
544                 }
545                 elsif ( $awaiting eq "newscr" ) {
546                     $newscr = $addr;
547                 }
548                 elsif ( $awaiting eq "stdscr" ) {
549                     $stdscr = $addr;
550                 }
551                 else {
552                     $win_addr{$addr} = $win_nums++;
553                 }
554                 $awaiting = "";
555             }
556             elsif ( $_ =~ /^create :(root|new)_panel 0x([[:xdigit:]]+)/ ) {
557                 $addr            = "0x$2";
558                 $pan_addr{$addr} = $pan_nums++;
559                 $_               = &transaddr($_);
560             }
561             elsif ( $_ =~ /^create :user_ptr 0x([[:xdigit:]]+)/ ) {
562                 $addr            = "0x$1";
563                 $usr_addr{$addr} = $usr_nums++;
564                 $_               = &transaddr($_);
565             }
566             elsif ( $_ =~ /^(\+ )*called \{set_curterm\((0x[[:xdigit:]]+)\)/ ) {
567                 $trm_addr{$2} = ++$trm_nums unless defined $trm_addr{$2};
568             }
569             elsif ( $_ =~ /^(\+ )*called \{_nc_add_to_try\((0x[[:xdigit:]]+),/ )
570             {
571                 $try_addr{$2} = ++$try_nums unless defined $try_addr{$2};
572             }
573             elsif ( $_ =~ /^(\+ )*_nc_alloc_screen_sp 0x([[:xdigit:]]+)/ ) {
574                 $addr = "0x$2";
575                 $scr_addr{$addr} = ++$scr_nums unless ( $scr_addr{$addr} );
576                 $awaiting = "";
577             }
578             elsif ( $_ =~ /^(\+ )*return }0x([[:xdigit:]]+)/ ) {
579                 $addr = "0x$2";
580                 if ( $awaiting eq "screen" ) {
581                     $scr_addr{$addr} = ++$scr_nums unless ( $scr_addr{$addr} );
582                 }
583             }
584             elsif ( $_ =~ /^\.\.\.deleted win=0x([[:xdigit:]]+)/ ) {
585                 $addr = "0x$1";
586                 $_    = &transaddr($_);
587                 if ( $addr eq $curscr ) {
588                     $curscr = "";
589                 }
590                 elsif ( $addr eq $newscr ) {
591                     $newscr = "";
592                 }
593                 elsif ( $addr eq $stdscr ) {
594                     $stdscr = "";
595                 }
596                 else {
597                     undef $win_addr{$addr};
598                 }
599             }
600             elsif ( $_ =~ /^\.\.\.deleted pan=\"0x([[:xdigit:]]+)\"/ ) {
601                 $addr = "0x$1";
602                 $_    = &transaddr($_);
603                 undef $pan_addr{$addr};
604             }
605
606             # Compactify runs of PutAttrChar
607             if ( ( ( $tracelevel & $TR{CHARPUT} ) != 0 ) and $_ =~ /$putattr/ )
608             {
609                 my $putattr_chars = $1;
610                 my $starty        = $2;
611                 my $startx        = $3;
612                 while (<$STDIN>) {
613                     if ( $_ =~ /$putattr/ ) {
614                         $putattr_chars .= $1;
615                     }
616                     else {
617                         next if ( $_ =~ /^PUTC 0x[[:xdigit:]]+.*/ );
618                         next if ( $_ =~ /^\.\.\.skip.*/ );
619                         next if ( $_ =~ /^forced to blank.*/ );
620                         last;
621                     }
622                 }
623                 print "RUN of PutAttrChar()s:"
624                   . " \"$putattr_chars\" from ${starty}, ${startx}\n";
625                 redo CLASSIFY;
626             }
627
628             # Compactify runs of waddnstr calls
629             if ( ( ( $tracelevel & $TR{CALLS} ) != 0 ) and $_ =~ /$waddnstr/ ) {
630                 my $waddnstr_chars = $2;
631                 my $winaddr        = $1;
632                 while (<$STDIN>) {
633                     next if ( $_ =~ /^return \}0/ );
634                     if ( $_ =~ /$waddnstr/ && $1 eq $winaddr ) {
635                         $waddnstr_chars .= $2;
636                     }
637                     else {
638                         last;
639                     }
640                 }
641                 my $winaddstr = &transaddr($winaddr);
642                 print "RUN of waddnstr()s:"
643                   . " $winaddstr, \"$waddnstr_chars\"\n";
644                 redo CLASSIFY;
645             }
646
647             # More transformations can go here
648
649             # Repeated runs of anything
650             my $anyline     = &transaddr($_);
651             my $repeatcount = 1;
652             while (<$STDIN>) {
653                 if ( &transaddr($_) eq $anyline ) {
654                     $repeatcount++;
655                 }
656                 else {
657                     last;
658                 }
659             }
660             if ( $repeatcount > 1 ) {
661                 print "${repeatcount} REPEATS OF $anyline";
662             }
663             else {
664                 print $thread . $anyline;
665             }
666             redo CLASSIFY if $_;
667
668         }    # :CLASSIFY
669     }
670 }
671
672 for my $tr ( keys %TR ) {
673     $TR{$tr} = hex $TR{$tr};
674 }
675
676 if ( $#ARGV >= 0 ) {
677     while ( $#ARGV >= 0 ) {
678         my $file = shift @ARGV;
679         open my $ifh, "<", $file or die $!;
680         &muncher($ifh);
681     }
682 }
683 else {
684     &muncher( \*STDIN );
685 }
686
687 # tracemunch ends here