test/tracemunch

   1 #!/usr/bin/env perl
   2 # $Id: tracemunch,v 1.32 2020/09/26 19:40:55 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             # just in case someone tries a file with cr/lf line-endings:
 515             $_ =~ s/\r\n/\n/g;
 516             $_ =~ s/\r/\n/g;
 517
 518             if ( $_ =~
 519                 /^TRACING NCURSES version.*\(tracelevel=(0x[[:xdigit:]]+)\)/ )
 520             {
 521                 $tracelevel = hex $1;
 522                 print;
 523                 next;
 524             }
 525
 526             my $thread = "";
 527             if ( $_ =~ /^(0x[[:xdigit:]]+):/ ) {
 528                 $thr_addr{$1} = ++$thr_nums unless defined $thr_addr{$1};
 529                 $thread = "thread" . $thr_addr{$1} . ":";
 530                 $_ =~ s/^[^:]*://;
 531             }
 532
 533             # Transform window pointer addresses so it's easier to compare logs
 534             $awaiting = "curscr" if ( $_ =~ /creating curscr/ );
 535             $awaiting = "newscr" if ( $_ =~ /creating newscr/ );
 536             $awaiting = "stdscr" if ( $_ =~ /creating stdscr/ );
 537             $awaiting = "screen" if ( $_ =~ /^(\+ )*called \{new_prescr\(\)/ );
 538             if ( $_ =~ /^create :window 0x([[:xdigit:]]+)/ ) {
 539                 $addr = "0x$1";
 540                 if ( $awaiting eq "curscr" ) {
 541                     $curscr = $addr;
 542                 }
 543                 elsif ( $awaiting eq "newscr" ) {
 544                     $newscr = $addr;
 545                 }
 546                 elsif ( $awaiting eq "stdscr" ) {
 547                     $stdscr = $addr;
 548                 }
 549                 else {
 550                     $win_addr{$addr} = $win_nums++;
 551                 }
 552                 $awaiting = "";
 553             }
 554             elsif ( $_ =~ /^create :(root|new)_panel 0x([[:xdigit:]]+)/ ) {
 555                 $addr            = "0x$2";
 556                 $pan_addr{$addr} = $pan_nums++;
 557                 $_               = &transaddr($_);
 558             }
 559             elsif ( $_ =~ /^create :user_ptr 0x([[:xdigit:]]+)/ ) {
 560                 $addr            = "0x$1";
 561                 $usr_addr{$addr} = $usr_nums++;
 562                 $_               = &transaddr($_);
 563             }
 564             elsif ( $_ =~ /^(\+ )*called \{set_curterm\((0x[[:xdigit:]]+)\)/ ) {
 565                 $trm_addr{$2} = ++$trm_nums unless defined $trm_addr{$2};
 566             }
 567             elsif ( $_ =~ /^(\+ )*called \{_nc_add_to_try\((0x[[:xdigit:]]+),/ )
 568             {
 569                 $try_addr{$2} = ++$try_nums unless defined $try_addr{$2};
 570             }
 571             elsif ( $_ =~ /^(\+ )*_nc_alloc_screen_sp 0x([[:xdigit:]]+)/ ) {
 572                 $addr = "0x$2";
 573                 $scr_addr{$addr} = ++$scr_nums unless ( $scr_addr{$addr} );
 574                 $awaiting = "";
 575             }
 576             elsif ( $_ =~ /^(\+ )*return }0x([[:xdigit:]]+)/ ) {
 577                 $addr = "0x$2";
 578                 if ( $awaiting eq "screen" ) {
 579                     $scr_addr{$addr} = ++$scr_nums unless ( $scr_addr{$addr} );
 580                 }
 581             }
 582             elsif ( $_ =~ /^\.\.\.deleted win=0x([[:xdigit:]]+)/ ) {
 583                 $addr = "0x$1";
 584                 $_    = &transaddr($_);
 585                 if ( $addr eq $curscr ) {
 586                     $curscr = "";
 587                 }
 588                 elsif ( $addr eq $newscr ) {
 589                     $newscr = "";
 590                 }
 591                 elsif ( $addr eq $stdscr ) {
 592                     $stdscr = "";
 593                 }
 594                 else {
 595                     undef $win_addr{$addr};
 596                 }
 597             }
 598             elsif ( $_ =~ /^\.\.\.deleted pan=\"0x([[:xdigit:]]+)\"/ ) {
 599                 $addr = "0x$1";
 600                 $_    = &transaddr($_);
 601                 undef $pan_addr{$addr};
 602             }
 603
 604             # Compactify runs of PutAttrChar
 605             if ( ( ( $tracelevel & $TR{CHARPUT} ) != 0 ) and $_ =~ /$putattr/ )
 606             {
 607                 my $putattr_chars = $1;
 608                 my $starty        = $2;
 609                 my $startx        = $3;
 610                 while (<$STDIN>) {
 611                     if ( $_ =~ /$putattr/ ) {
 612                         $putattr_chars .= $1;
 613                     }
 614                     else {
 615                         next if ( $_ =~ /^PUTC 0x[[:xdigit:]]+.*/ );
 616                         next if ( $_ =~ /^\.\.\.skip.*/ );
 617                         next if ( $_ =~ /^forced to blank.*/ );
 618                         last;
 619                     }
 620                 }
 621                 print "RUN of PutAttrChar()s:"
 622                   . " \"$putattr_chars\" from ${starty}, ${startx}\n";
 623                 redo CLASSIFY;
 624             }
 625
 626             # Compactify runs of waddnstr calls
 627             if ( ( ( $tracelevel & $TR{CALLS} ) != 0 ) and $_ =~ /$waddnstr/ ) {
 628                 my $waddnstr_chars = $2;
 629                 my $winaddr        = $1;
 630                 while (<$STDIN>) {
 631                     next if ( $_ =~ /^return \}0/ );
 632                     if ( $_ =~ /$waddnstr/ && $1 eq $winaddr ) {
 633                         $waddnstr_chars .= $2;
 634                     }
 635                     else {
 636                         last;
 637                     }
 638                 }
 639                 my $winaddstr = &transaddr($winaddr);
 640                 print "RUN of waddnstr()s:"
 641                   . " $winaddstr, \"$waddnstr_chars\"\n";
 642                 redo CLASSIFY;
 643             }
 644
 645             # More transformations can go here
 646
 647             # Repeated runs of anything
 648             my $anyline     = &transaddr($_);
 649             my $repeatcount = 1;
 650             while (<$STDIN>) {
 651                 if ( &transaddr($_) eq $anyline ) {
 652                     $repeatcount++;
 653                 }
 654                 else {
 655                     last;
 656                 }
 657             }
 658             if ( $repeatcount > 1 ) {
 659                 print "${repeatcount} REPEATS OF $anyline";
 660             }
 661             else {
 662                 print $thread . $anyline;
 663             }
 664             redo CLASSIFY if $_;
 665
 666         }    # :CLASSIFY
 667     }
 668 }
 669
 670 for my $tr ( keys %TR ) {
 671     $TR{$tr} = hex $TR{$tr};
 672 }
 673
 674 if ( $#ARGV >= 0 ) {
 675     while ( $#ARGV >= 0 ) {
 676         my $file = shift @ARGV;
 677         open my $ifh, "<", $file or die $!;
 678         &muncher($ifh);
 679     }
 680 }
 681 else {
 682     &muncher( \*STDIN );
 683 }
 684
 685 # tracemunch ends here