test/tracemunch

   1 #!/usr/bin/env perl
   2 # $Id: tracemunch,v 1.29 2020/04/18 23:52:24 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 our %known_p1 = qw(
  76   TransformLine           1
  77   _nc_freewin             2
  78   _nc_initscr             1
  79   _nc_makenew             1
  80   _nc_mingw_console_read  1
  81   _nc_reset_colors        1
  82   _nc_scroll_optimize     1
  83   _nc_tinfo               1
  84   _nc_tinfo_mvcur         1
  85   _nc_wgetch              2
  86   adjust_window           2
  87   assume_default_colors   1
  88   attr_get                2
  89   baudrate                1
  90   beep                    1
  91   border_set              2
  92   box                     2
  93   box_set                 2
  94   can_change_color        1
  95   cbreak                  1
  96   clearok                 2
  97   color_content           1
  98   copywin                 2
  99   curs_set                1
 100   decrease_size           1
 101   def_prog_mode           1
 102   def_shell_mode          1
 103   define_key              1
 104   del_curterm             1
 105   delay_output            1
 106   delscreen               1
 107   delwin                  2
 108   derwin                  2
 109   doupdate                1
 110   dupwin                  2
 111   echo                    1
 112   endwin                  1
 113   erasechar               1
 114   filter                  1
 115   flash                   1
 116   flushinp                1
 117   getattrs                2
 118   getbegx                 2
 119   getbegy                 2
 120   getbkgd                 2
 121   getcurx                 2
 122   getcury                 2
 123   getmaxx                 2
 124   getmaxy                 2
 125   getmouse                1
 126   getparx                 2
 127   getpary                 2
 128   halfdelay               1
 129   has_ic                  1
 130   has_il                  1
 131   has_key                 1
 132   idcok                   2
 133   idlok                   2
 134   immedok                 2
 135   increase_size           1
 136   init_color              1
 137   init_pair               1
 138   intrflush               1
 139   is_cleared              2
 140   is_idcok                2
 141   is_idlok                2
 142   is_immedok              2
 143   is_keypad               2
 144   is_leaveok              2
 145   is_linetouched          2
 146   is_nodelay              2
 147   is_notimeout            2
 148   is_pad                  2
 149   is_scrollok             2
 150   is_subwin               2
 151   is_syncok               2
 152   is_term_resized         1
 153   is_wintouched           2
 154   key_defined             1
 155   keybound                1
 156   keyok                   1
 157   keypad                  2
 158   killchar                1
 159   leaveok                 2
 160   longname                1
 161   meta                    2
 162   mouseinterval           1
 163   mousemask               1
 164   mvcur                   1
 165   mvderwin                2
 166   mvwadd_wch              2
 167   mvwadd_wchnstr          2
 168   mvwadd_wchstr           2
 169   mvwaddch                2
 170   mvwaddchnstr            2
 171   mvwaddchstr             2
 172   mvwaddnstr              2
 173   mvwaddnwstr             2
 174   mvwaddstr               2
 175   mvwaddwstr              2
 176   mvwchgat                2
 177   mvwdelch                2
 178   mvwget_wch              2
 179   mvwget_wstr             2
 180   mvwgetch                2
 181   mvwgetn_wstr            2
 182   mvwgetnstr              2
 183   mvwgetstr               2
 184   mvwhline                2
 185   mvwhline_set            2
 186   mvwin                   2
 187   mvwin_wch               2
 188   mvwin_wchnstr           2
 189   mvwin_wchstr            2
 190   mvwinch                 2
 191   mvwinchnstr             2
 192   mvwinchstr              2
 193   mvwins_nwstr            2
 194   mvwins_wch              2
 195   mvwins_wstr             2
 196   mvwinsch                2
 197   mvwinsnstr              2
 198   mvwinsstr               2
 199   mvwinstr                2
 200   mvwinwstr               2
 201   mvwvline                2
 202   mvwvline_set            2
 203   newpad                  1
 204   newterm                 1
 205   newwin                  1
 206   nl                      1
 207   nocbreak                1
 208   nodelay                 2
 209   noecho                  1
 210   nofilter                1
 211   nonl                    1
 212   noqiflush               1
 213   noraw                   1
 214   notimeout               2
 215   overlap                 2
 216   overlay                 2
 217   overwrite               2
 218   pair_content            1
 219   pecho_wchar             2
 220   pechochar               2
 221   pnoutrefresh            2
 222   putwin                  2
 223   qiflush                 1
 224   raw                     1
 225   redrawwin               2
 226   reset_prog_mode         1
 227   reset_shell_mode        1
 228   resetty                 1
 229   resize_term             1
 230   resizeterm              1
 231   restartterm             1
 232   ripoffline              1
 233   savetty                 1
 234   scr_init                1
 235   scr_restore             1
 236   scr_set                 1
 237   scroll                  2
 238   scrollok                2
 239   set_curterm             4
 240   set_term                1
 241   slk_attr                1
 242   slk_attr_set            1
 243   slk_attroff             1
 244   slk_attron              1
 245   slk_attrset             1
 246   slk_clear               1
 247   slk_color               1
 248   slk_init                1
 249   slk_label               1
 250   slk_noutrefresh         1
 251   slk_refresh             1
 252   slk_restore             1
 253   slk_set                 1
 254   slk_touch               1
 255   start_color             1
 256   subwin                  2
 257   syncok                  2
 258   termattrs               1
 259   termname                1
 260   tgetflag                1
 261   tgetnum                 1
 262   tigetflag               1
 263   tigetnum                1
 264   tigetstr                1
 265   tinfo                   1
 266   touchline               2
 267   touchwin                2
 268   typeahead               1
 269   unget_wch               1
 270   ungetch                 1
 271   ungetmouse              1
 272   untouchwin              2
 273   use_default_colors      1
 274   use_env                 1
 275   use_legacy_coding       1
 276   use_screen              1
 277   use_tioctl              1
 278   use_window              2
 279   vidattr                 1
 280   vidputs                 1
 281   vw_printw               2
 282   vwprintw                2
 283   wadd_wch                2
 284   wadd_wchnstr            2
 285   wadd_wchstr             2
 286   waddch                  2
 287   waddchnstr              2
 288   waddchstr               2
 289   waddnstr                2
 290   waddnwstr               2
 291   waddstr                 2
 292   waddwstr                2
 293   wattr_get               2
 294   wattr_off               2
 295   wattr_on                2
 296   wattr_set               2
 297   wattroff                2
 298   wattron                 2
 299   wattrset                2
 300   wbkgd                   2
 301   wbkgdset                2
 302   wborder                 2
 303   wborder_set             2
 304   wchgat                  2
 305   wclear                  2
 306   wclrtobot               2
 307   wclrtoeol               2
 308   wcolor_set              2
 309   wcursyncup              2
 310   wdelch                  2
 311   wdeleteln               2
 312   wechochar               2
 313   wenclose                2
 314   werase                  2
 315   wget_wch                2
 316   wget_wstr               2
 317   wgetbkgrnd              2
 318   wgetch                  2
 319   wgetch_events           2
 320   wgetdelay               2
 321   wgetn_wstr              2
 322   wgetnstr                2
 323   wgetparent              2
 324   wgetscrreg              2
 325   wgetstr                 2
 326   whline                  2
 327   whline_set              2
 328   win_wch                 2
 329   win_wchnstr             2
 330   win_wchstr              2
 331   winch                   2
 332   winchnstr               2
 333   winchstr                2
 334   winnstr                 2
 335   winnwstr                2
 336   wins_nwstr              2
 337   wins_wch                2
 338   wins_wstr               2
 339   winsch                  2
 340   winsdelln               2
 341   winsertln               2
 342   winsnstr                2
 343   winsstr                 2
 344   winstr                  2
 345   winwstr                 2
 346   wmouse_trafo            2
 347   wmove                   2
 348   wnoutrefresh            2
 349   wprintw                 2
 350   wredrawln               2
 351   wrefresh                2
 352   wresize                 2
 353   wscrl                   2
 354   wsetscrreg              2
 355   wstandend               2
 356   wstandout               2
 357   wsyncdown               2
 358   wsyncup                 2
 359   wtimeout                2
 360   wtouchln                2
 361   wvline                  2
 362 );
 363
 364 our $scr_nums = 0;
 365 our $thr_nums = 0;
 366 our $trm_nums = 0;
 367 our $try_nums = 0;
 368 our $win_nums = 0;
 369 our $curscr   = "";
 370 our $newscr   = "";
 371 our $stdscr   = "";
 372 our %scr_addr;
 373 our %thr_addr;
 374 our %trm_addr;
 375 our %try_addr;
 376 our %win_addr;
 377
 378 sub has_addr($) {
 379     my $value  = shift;
 380     my $result = 0;
 381     $result = 1 if ( $value =~ /\b0x[[:xdigit:]]+\b/i );
 382     return $result;
 383 }
 384
 385 sub transaddr($) {
 386     my $arg = shift;
 387     my $n;
 388
 389     $arg =~ s/\b$curscr\b/curscr/g if ($curscr);
 390     $arg =~ s/\b$newscr\b/newscr/g if ($newscr);
 391     $arg =~ s/\b$stdscr\b/stdscr/g if ($stdscr);
 392     if ( &has_addr($arg) ) {
 393         foreach my $addr ( keys %scr_addr ) {
 394             $n = $scr_addr{$addr};
 395             $arg =~ s/\b$addr\b/screen$n/g if ( defined $n );
 396         }
 397     }
 398     if ( &has_addr($arg) ) {
 399         foreach my $addr ( keys %thr_addr ) {
 400             $n = $thr_addr{$addr};
 401             $arg =~ s/\b$addr\b/thread$n/g if ( defined $n );
 402         }
 403     }
 404     if ( &has_addr($arg) ) {
 405         foreach my $addr ( keys %trm_addr ) {
 406             $n = $trm_addr{$addr};
 407             $arg =~ s/\b$addr\b/terminal$n/g if ( defined $n );
 408         }
 409     }
 410     if ( &has_addr($arg) ) {
 411         foreach my $addr ( keys %try_addr ) {
 412             $n = $try_addr{$addr};
 413             $arg =~ s/\b$addr\b/tries_$n/g if ( defined $n );
 414         }
 415     }
 416     if ( &has_addr($arg) ) {
 417         foreach my $addr ( keys %win_addr ) {
 418             $n = $win_addr{$addr};
 419             $arg =~ s/\b$addr\b/window$n/g if ( defined $n );
 420         }
 421     }
 422     if ( &has_addr($arg) ) {
 423         if ( $arg =~ /add_wch\((window\d+,)?0x[[:xdigit:]]+\)/i ) {
 424             $arg =~ s/(0x[[:xdigit:]]+)[)]/\&wch)/i;
 425         }
 426         elsif (
 427             $arg =~ /color_content\((screen\d+,)?\d+(,0x[[:xdigit:]]+){3}/i )
 428         {
 429             $arg =~ s/(,0x[[:xdigit:]]+){3}[)]/,\&r,\&g,\&b)/i;
 430         }
 431         elsif ( $arg =~ /pair_content\((screen\d+,)?\d+(,0x[[:xdigit:]]+){2}/i )
 432         {
 433             $arg =~ s/(,0x[[:xdigit:]]+){2}[)]/,\&fg,\&bg)/i;
 434         }
 435     }
 436     if ( &has_addr($arg) and $arg =~ /called\s+\{/ ) {
 437         my $func = $arg;
 438         chomp $func;
 439         $func =~ s/^.*called\s+\{([[:alnum:]_]+)\(.*$/$1/;
 440         if ( defined $known_p1{$func} ) {
 441             my $addr = $arg;
 442             my $type = $known_p1{$func};
 443             chomp $addr;
 444             $addr =~ s/^[^(]+\((0x[[:xdigit:]]+).*/$1/i;
 445             if ( $addr !~ /^0x[[:xdigit:]]+$/i ) {
 446                 printf "OOPS - expected type #$type, skipping\n>>$addr\n";
 447             }
 448             elsif ( $type == 1 ) {
 449                 $scr_addr{$addr} = ++$scr_nums;
 450                 $arg = &transaddr($arg);
 451             }
 452             elsif ( $type == 2 ) {
 453                 $win_addr{$addr} = ++$win_nums;
 454                 $arg = &transaddr($arg);
 455             }
 456             elsif ( $type == 4 ) {
 457                 $trm_addr{$addr} = ++$trm_nums;
 458                 $arg = &transaddr($arg);
 459             }
 460         }
 461     }
 462
 463     return $arg;
 464 }
 465
 466 sub muncher($) {
 467     my $STDIN = shift;
 468
 469     while (<$STDIN>) {
 470         my $addr;
 471         my $n;
 472         my $awaiting = "";
 473
 474       CLASSIFY: {
 475
 476             # just in case someone tries a file with cr/lf line-endings:
 477             $_ =~ s/\r\n/\n/g;
 478             $_ =~ s/\r/\n/g;
 479
 480             if ( $_ =~
 481                 /^TRACING NCURSES version.*\(tracelevel=(0x[[:xdigit:]]+)\)/ )
 482             {
 483                 $tracelevel = hex $1;
 484                 print;
 485                 next;
 486             }
 487
 488             my $thread = "";
 489             if ( $_ =~ /^(0x[[:xdigit:]]+):/ ) {
 490                 $thr_addr{$1} = ++$thr_nums unless defined $thr_addr{$1};
 491                 $thread = "thread" . $thr_addr{$1} . ":";
 492                 $_ =~ s/^[^:]*://;
 493             }
 494
 495             # Transform window pointer addresses so it's easier to compare logs
 496             $awaiting = "curscr" if ( $_ =~ /creating curscr/ );
 497             $awaiting = "newscr" if ( $_ =~ /creating newscr/ );
 498             $awaiting = "stdscr" if ( $_ =~ /creating stdscr/ );
 499             $awaiting = "screen" if ( $_ =~ /^(\+ )*called \{new_prescr\(\)/ );
 500             if ( $_ =~ /^create :window 0x([[:xdigit:]]+)/ ) {
 501                 $addr = "0x$1";
 502                 if ( $awaiting eq "curscr" ) {
 503                     $curscr = $addr;
 504                 }
 505                 elsif ( $awaiting eq "newscr" ) {
 506                     $newscr = $addr;
 507                 }
 508                 elsif ( $awaiting eq "stdscr" ) {
 509                     $stdscr = $addr;
 510                 }
 511                 else {
 512                     $win_addr{$addr} = $win_nums++;
 513                 }
 514                 $awaiting = "";
 515             }
 516             elsif ( $_ =~ /^(\+ )*called \{set_curterm\((0x[[:xdigit:]]+)\)/ ) {
 517                 $trm_addr{$2} = ++$trm_nums unless defined $trm_addr{$2};
 518             }
 519             elsif ( $_ =~ /^(\+ )*called \{_nc_add_to_try\((0x[[:xdigit:]]+),/ )
 520             {
 521                 $try_addr{$2} = ++$try_nums unless defined $try_addr{$2};
 522             }
 523             elsif ( $_ =~ /^(\+ )*_nc_alloc_screen_sp 0x([[:xdigit:]]+)/ ) {
 524                 $addr = "0x$2";
 525                 $scr_addr{$addr} = ++$scr_nums unless ( $scr_addr{$addr} );
 526                 $awaiting = "";
 527             }
 528             elsif ( $_ =~ /^(\+ )*return }0x([[:xdigit:]]+)/ ) {
 529                 $addr = "0x$2";
 530                 if ( $awaiting eq "screen" ) {
 531                     $scr_addr{$addr} = ++$scr_nums unless ( $scr_addr{$addr} );
 532                 }
 533             }
 534             elsif ( $_ =~ /^\.\.\.deleted win=0x([[:xdigit:]]+)/ ) {
 535                 $addr = "0x$1";
 536                 $_    = &transaddr($_);
 537                 if ( $addr eq $curscr ) {
 538                     $curscr = "";
 539                 }
 540                 elsif ( $addr eq $newscr ) {
 541                     $newscr = "";
 542                 }
 543                 elsif ( $addr eq $stdscr ) {
 544                     $stdscr = "";
 545                 }
 546                 else {
 547                     undef $win_addr{$addr};
 548                 }
 549             }
 550
 551             # Compactify runs of PutAttrChar
 552             if ( ( ( $tracelevel & $TR{CHARPUT} ) != 0 ) and $_ =~ /$putattr/ )
 553             {
 554                 my $putattr_chars = $1;
 555                 my $starty        = $2;
 556                 my $startx        = $3;
 557                 while (<$STDIN>) {
 558                     if ( $_ =~ /$putattr/ ) {
 559                         $putattr_chars .= $1;
 560                     }
 561                     else {
 562                         next if ( $_ =~ /^PUTC 0x[[:xdigit:]]+.*/ );
 563                         next if ( $_ =~ /^\.\.\.skip.*/ );
 564                         next if ( $_ =~ /^forced to blank.*/ );
 565                         last;
 566                     }
 567                 }
 568                 print "RUN of PutAttrChar()s:"
 569                   . " \"$putattr_chars\" from ${starty}, ${startx}\n";
 570                 redo CLASSIFY;
 571             }
 572
 573             # Compactify runs of waddnstr calls
 574             if ( ( ( $tracelevel & $TR{CALLS} ) != 0 ) and $_ =~ /$waddnstr/ ) {
 575                 my $waddnstr_chars = $2;
 576                 my $winaddr        = $1;
 577                 while (<$STDIN>) {
 578                     next if ( $_ =~ /^return \}0/ );
 579                     if ( $_ =~ /$waddnstr/ && $1 eq $winaddr ) {
 580                         $waddnstr_chars .= $2;
 581                     }
 582                     else {
 583                         last;
 584                     }
 585                 }
 586                 my $winaddstr = &transaddr($winaddr);
 587                 print "RUN of waddnstr()s:"
 588                   . " $winaddstr, \"$waddnstr_chars\"\n";
 589                 redo CLASSIFY;
 590             }
 591
 592             # More transformations can go here
 593
 594             # Repeated runs of anything
 595             my $anyline     = &transaddr($_);
 596             my $repeatcount = 1;
 597             while (<$STDIN>) {
 598                 if ( &transaddr($_) eq $anyline ) {
 599                     $repeatcount++;
 600                 }
 601                 else {
 602                     last;
 603                 }
 604             }
 605             if ( $repeatcount > 1 ) {
 606                 print "${repeatcount} REPEATS OF $anyline";
 607             }
 608             else {
 609                 print $thread . $anyline;
 610             }
 611             redo CLASSIFY if $_;
 612
 613         }    # :CLASSIFY
 614     }
 615 }
 616
 617 for my $tr ( keys %TR ) {
 618     $TR{$tr} = hex $TR{$tr};
 619 }
 620
 621 if ( $#ARGV >= 0 ) {
 622     while ( $#ARGV >= 0 ) {
 623         my $file = shift @ARGV;
 624         open my $ifh, "<", $file or die $!;
 625         &muncher($ifh);
 626     }
 627 }
 628 else {
 629     &muncher( \*STDIN );
 630 }
 631
 632 # tracemunch ends here