ncurses 6.1 - patch 20191214
[ncurses.git] / test / tracemunch
index d6761cd0421940ffc9cb1d16938f5c67f6929ea0..c23607e9cdf67cdaca3fa04b39c7eb41b44f1f85 100755 (executable)
-#!/usr/bin/perl
-#
+#!/usr/bin/env perl
+# $Id: tracemunch,v 1.24 2018/12/29 22:20:06 tom Exp $
+##############################################################################
+# Copyright (c) 1998-2017,2018 Free Software Foundation, Inc.                #
+#                                                                            #
+# Permission is hereby granted, free of charge, to any person obtaining a    #
+# copy of this software and associated documentation files (the "Software"), #
+# to deal in the Software without restriction, including without limitation  #
+# the rights to use, copy, modify, merge, publish, distribute, distribute    #
+# with modifications, sublicense, and/or sell copies of the Software, and to #
+# permit persons to whom the Software is furnished to do so, subject to the  #
+# following conditions:                                                      #
+#                                                                            #
+# The above copyright notice and this permission notice shall be included in #
+# all copies or substantial portions of the Software.                        #
+#                                                                            #
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR #
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,   #
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL    #
+# THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER      #
+# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING    #
+# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER        #
+# DEALINGS IN THE SOFTWARE.                                                  #
+#                                                                            #
+# Except as contained in this notice, the name(s) of the above copyright     #
+# holders shall not be used in advertising or otherwise to promote the sale, #
+# use or other dealings in this Software without prior written               #
+# authorization.                                                             #
+##############################################################################
 # tracemunch -- compactify ncurses trace logs
 #
 # The error logs produced by ncurses with tracing enabled can be very tedious
 # to wade through.  This script helps by compacting runs of log lines that
 # can be conveniently expressed as higher-level operations.
-#
-# ($Id: tracemunch,v 1.2 1995/10/06 15:02:37 esr Exp $)
 
-$putattr="PutAttrChar\\('(.)' = 0x.., {A_NORMAL}\\) at \\(([0-9]+), ([0-9]+)\\)";
-$waddnstr="waddnstr\\(0x([0-9a-f]+),\"([^\"]+)\",[0-9]+\\) called {A_NORMAL}";
+use strict;
+use warnings;
+
+our $putattr =
+    'PutAttrChar\(\{\{ ' . "'(.)'"
+  . ' = 0[0-7]+ \}\}\) at \(([0-9]+), ([0-9]+)\)';
+our $waddnstr =
+  'waddnstr\(0x([[:xdigit:]]+),"([^\"]+)",[0-9]+\) called \{A_NORMAL\}';
 
-sub transaddr
-{
-    $arg = $_[0];
+our $scr_nums = 0;
+our $thr_nums = 0;
+our $try_nums = 0;
+our $win_nums = 0;
+our $curscr   = "";
+our $newscr   = "";
+our $stdscr   = "";
+our %scr_addr;
+our %thr_addr;
+our %try_addr;
+our %win_addr;
 
-    $arg =~ s/$curscr/curscr/ if ($curscr);
-    $arg =~ s/$newscr/newscr/ if ($newscr);
-    $arg =~ s/$stdscr/stdscr/ if ($stdscr);
+sub transaddr {
+    my $n;
+    my $arg = $_[0];
+
+    $arg =~ s/\b$curscr\b/curscr/g if ($curscr);
+    $arg =~ s/\b$newscr\b/newscr/g if ($newscr);
+    $arg =~ s/\b$stdscr\b/stdscr/g if ($stdscr);
+    foreach my $addr ( keys %scr_addr ) {
+        $n = $scr_addr{$addr};
+        $arg =~ s/\b$addr\b/screen$n/g if ( defined $n );
+    }
+    foreach my $addr ( keys %thr_addr ) {
+        $n = $thr_addr{$addr};
+        $arg =~ s/\b$addr\b/thread$n/g if ( defined $n );
+    }
+    foreach my $addr ( keys %try_addr ) {
+        $n = $try_addr{$addr};
+        $arg =~ s/\b$addr\b/tries_$n/g if ( defined $n );
+    }
+    foreach my $addr ( keys %win_addr ) {
+        $n = $win_addr{$addr};
+        $arg =~ s/\b$addr\b/window$n/g if ( defined $n );
+    }
+    if ( $arg =~ /add_wch\((window\d+,)?0x[[:xdigit:]]+\)/i ) {
+        $arg =~ s/(0x[[:xdigit:]]+)[)]/\&wch)/i;
+    }
+    elsif ( $arg =~ /color_content\((screen\d+,)?\d+(,0x[[:xdigit:]]+){3}/i ) {
+        $arg =~ s/(,0x[[:xdigit:]]+){3}[)]/,\&r,\&g,\&b)/i;
+    }
+    elsif ( $arg =~ /pair_content\((screen\d+,)?\d+(,0x[[:xdigit:]]+){2}/i ) {
+        $arg =~ s/(,0x[[:xdigit:]]+){2}[)]/,\&fg,\&bg)/i;
+    }
 
     return $arg;
 }
 
-while (<STDIN>)
-{
-CLASSIFY: {
-       # Transform window pointer addresses so it's easier to compare logs
-       $awaiting = "curscr" if ($_ =~ /creating curscr/);
-       $awaiting = "newscr" if ($_ =~ /creating newscr/);
-       $awaiting = "stdscr" if ($_ =~ /creating stdscr/);
-       if ($awaiting && $_ =~ /newwin: returned window is 0x([0-9a-f]+)/)
-       {
-           $curscr = "0x$1" if ($awaiting eq "curscr");
-           $newscr = "0x$1" if ($awaiting eq "newscr");
-           $stdscr = "0x$1" if ($awaiting eq "stdscr");
-           $awaiting = "";
-       }
-
-       # Compactify runs of PutAttrChar calls (TR_CHARPUT)
-       if ($_ =~ /$putattr/)
-       {
-               $putattr_chars = $1;
-               $starty = $2;
-               $startx = $3;
-               while (<STDIN>)
-               {
-                       if ($_ =~ /$putattr/) {
-                               $putattr_chars .= $1;
-                       } else {
-                               last;
-                       }
-               }
-               print "RUN of PutAttrChar()s: \"$putattr_chars\" from ${starty}, ${startx}\n";
-               redo CLASSIFY;
-       }
-
-       # Compactify runs of waddnstr calls (TR_CALLS)
-       if ($_ =~ /$waddnstr/)
-       {
-               $waddnstr_chars = $2;
-               $winaddr = $1;
-               while (<STDIN>)
-               {
-                       if ($_ =~ /$waddnstr/ && $1 eq $winaddr) {
-                               $waddnstr_chars .= $2;
-                       } else {
-                               last;
-                       }
-               }
-               $winaddstr = &transaddr($winaddr);
-               print "RUN of waddnstr()s: $winaddr, \"$waddnstr_chars\"\n";
-               redo CLASSIFY;
-       }
-
-       # More transformations can go here
-
-       # Repeated runs of anything
-       $anyline = &transaddr($_);
-       $repeatcount = 1;
-       while (<STDIN>) {
-           if (&transaddr($_) eq $anyline) {
-               $repeatcount++;
-           } else {
-               last;
-           }
-       }
-       if ($repeatcount > 1) {
-               print "${repeatcount} REPEATS OF $anyline";
-       } else {
-               print $anyline
-       }
-       redo CLASSIFY if $_;
-
-       } # :CLASSIFY
+sub muncher($) {
+    my $STDIN = shift;
+
+    while (<$STDIN>) {
+        my $addr;
+        my $n;
+        my $awaiting = "";
+
+      CLASSIFY: {
+
+            # just in case someone tries a file with cr/lf line-endings:
+            $_ =~ s/\r\n/\n/g;
+            $_ =~ s/\r/\n/g;
+
+            my $thread = "";
+            if ( $_ =~ /^(0x[[:xdigit:]]+):/ ) {
+                $thr_addr{$1} = ++$thr_nums unless defined $thr_addr{$1};
+                $thread = "thread" . $thr_addr{$1} . ":";
+                $_ =~ s/^[^:]*://;
+            }
+
+            # Transform window pointer addresses so it's easier to compare logs
+            $awaiting = "curscr" if ( $_ =~ /creating curscr/ );
+            $awaiting = "newscr" if ( $_ =~ /creating newscr/ );
+            $awaiting = "stdscr" if ( $_ =~ /creating stdscr/ );
+            $awaiting = "screen" if ( $_ =~ /^(\+ )*called \{new_prescr\(\)/ );
+            if ( $_ =~ /^create :window 0x([[:xdigit:]]+)/ ) {
+                $addr = "0x$1";
+                if ( $awaiting eq "curscr" ) {
+                    $curscr = $addr;
+                }
+                elsif ( $awaiting eq "newscr" ) {
+                    $newscr = $addr;
+                }
+                elsif ( $awaiting eq "stdscr" ) {
+                    $stdscr = $addr;
+                }
+                else {
+                    $win_addr{$addr} = $win_nums++;
+                }
+                $awaiting = "";
+            }
+            elsif ( $_ =~ /^(\+ )*called \{_nc_add_to_try\((0x[[:xdigit:]]+),/ )
+            {
+                $try_addr{$2} = ++$try_nums unless defined $try_addr{$2};
+            }
+            elsif ( $_ =~ /^(\+ )*_nc_alloc_screen_sp 0x([[:xdigit:]]+)/ ) {
+                $addr = "0x$2";
+                $scr_addr{$addr} = ++$scr_nums unless ( $scr_addr{$addr} );
+                $awaiting = "";
+            }
+            elsif ( $_ =~ /^(\+ )*return }0x([[:xdigit:]]+)/ ) {
+                $addr = "0x$2";
+                if ( $awaiting eq "screen" ) {
+                    $scr_addr{$addr} = ++$scr_nums unless ( $scr_addr{$addr} );
+                }
+            }
+            elsif ( $_ =~ /^\.\.\.deleted win=0x([[:xdigit:]]+)/ ) {
+                $addr = "0x$1";
+                $_    = &transaddr($_);
+                if ( $addr eq $curscr ) {
+                    $curscr = "";
+                }
+                elsif ( $addr eq $newscr ) {
+                    $newscr = "";
+                }
+                elsif ( $addr eq $stdscr ) {
+                    $stdscr = "";
+                }
+                else {
+                    undef $win_addr{$addr};
+                }
+            }
+
+            # Compactify runs of PutAttrChar calls (TR_CHARPUT)
+            if ( $_ =~ /$putattr/ ) {
+                my $putattr_chars = $1;
+                my $starty        = $2;
+                my $startx        = $3;
+                while (<$STDIN>) {
+                    if ( $_ =~ /$putattr/ ) {
+                        $putattr_chars .= $1;
+                    }
+                    else {
+                        last;
+                    }
+                }
+                print
+"RUN of PutAttrChar()s: \"$putattr_chars\" from ${starty}, ${startx}\n";
+                redo CLASSIFY;
+            }
+
+            # Compactify runs of waddnstr calls (TR_CALLS)
+            if ( $_ =~ /$waddnstr/ ) {
+                my $waddnstr_chars = $2;
+                my $winaddr        = $1;
+                while (<$STDIN>) {
+                    if ( $_ =~ /$waddnstr/ && $1 eq $winaddr ) {
+                        $waddnstr_chars .= $2;
+                    }
+                    else {
+                        last;
+                    }
+                }
+                my $winaddstr = &transaddr($winaddr);
+                print "RUN of waddnstr()s: $winaddr, \"$waddnstr_chars\"\n";
+                redo CLASSIFY;
+            }
+
+            # More transformations can go here
+
+            # Repeated runs of anything
+            my $anyline     = &transaddr($_);
+            my $repeatcount = 1;
+            while (<$STDIN>) {
+                if ( &transaddr($_) eq $anyline ) {
+                    $repeatcount++;
+                }
+                else {
+                    last;
+                }
+            }
+            if ( $repeatcount > 1 ) {
+                print "${repeatcount} REPEATS OF $anyline";
+            }
+            else {
+                print $thread . $anyline;
+            }
+            redo CLASSIFY if $_;
+
+        }    # :CLASSIFY
+    }
+}
+
+if ( $#ARGV >= 0 ) {
+    while ( $#ARGV >= 0 ) {
+        my $file = shift @ARGV;
+        open my $ifh, "<", $file or die $!;
+        &muncher($ifh);
+    }
+}
+else {
+    &muncher( \*STDIN );
 }
 
 # tracemunch ends here