test/tracemunch

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