ncurses 6.1 - patch 20191214
[ncurses.git] / test / tracemunch
index 10ed5317e1b71617a5b7cce2dcea08d715a47ce3..c23607e9cdf67cdaca3fa04b39c7eb41b44f1f85 100755 (executable)
@@ -1,7 +1,7 @@
 #!/usr/bin/env perl
-# $Id: tracemunch,v 1.12 2017/06/29 09:23:58 tom Exp $
+# $Id: tracemunch,v 1.24 2018/12/29 22:20:06 tom Exp $
 ##############################################################################
-# Copyright (c) 1998-2005,2017 Free Software Foundation, Inc.                #
+# 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"), #
@@ -37,9 +37,10 @@ use strict;
 use warnings;
 
 our $putattr =
-  "PutAttrChar\\({{ '(.)' = 0[0-7]+ }}\\) at \\(([0-9]+), ([0-9]+)\\)";
+    'PutAttrChar\(\{\{ ' . "'(.)'"
+  . ' = 0[0-7]+ \}\}\) at \(([0-9]+), ([0-9]+)\)';
 our $waddnstr =
-  "waddnstr\\(0x([[:xdigit:]]+),\"([^\"]+)\",[0-9]+\\) called {A_NORMAL}";
+  'waddnstr\(0x([[:xdigit:]]+),"([^\"]+)",[0-9]+\) called \{A_NORMAL\}';
 
 our $scr_nums = 0;
 our $thr_nums = 0;
@@ -62,147 +63,176 @@ sub transaddr {
     $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;
+        $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;
+        $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;
+        $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;
+        $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>) {
-    my $addr;
-    my $n;
-    my $awaiting;
-
-  CLASSIFY: {
-
-        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;
+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/^[^:]*://;
             }
-            elsif ( $awaiting eq "stdscr" ) {
-                $stdscr = $addr;
+
+            # 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 = "";
             }
-            else {
-                $win_addr{$addr} = $win_nums++;
+            elsif ( $_ =~ /^(\+ )*called \{_nc_add_to_try\((0x[[:xdigit:]]+),/ )
+            {
+                $try_addr{$2} = ++$try_nums unless defined $try_addr{$2};
             }
-            $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" ) {
+            elsif ( $_ =~ /^(\+ )*_nc_alloc_screen_sp 0x([[:xdigit:]]+)/ ) {
+                $addr = "0x$2";
                 $scr_addr{$addr} = ++$scr_nums unless ( $scr_addr{$addr} );
+                $awaiting = "";
             }
-        }
-        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};
+            elsif ( $_ =~ /^(\+ )*return }0x([[:xdigit:]]+)/ ) {
+                $addr = "0x$2";
+                if ( $awaiting eq "screen" ) {
+                    $scr_addr{$addr} = ++$scr_nums unless ( $scr_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;
+            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 {
-                    last;
+                    undef $win_addr{$addr};
                 }
             }
-            print
+
+            # 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;
+                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;
                 }
             }
-            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++;
+            if ( $repeatcount > 1 ) {
+                print "${repeatcount} REPEATS OF $anyline";
             }
             else {
-                last;
+                print $thread . $anyline;
             }
-        }
-        if ( $repeatcount > 1 ) {
-            print "${repeatcount} REPEATS OF $anyline";
-        }
-        else {
-            print $thread . $anyline;
-        }
-        redo CLASSIFY if $_;
-
-    }    # :CLASSIFY
+            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