X-Git-Url: https://ncurses.scripts.mit.edu/?p=ncurses.git;a=blobdiff_plain;f=test%2Ftracemunch;h=9d15dd58fbcb3dcd80bb659b1734a3953b9dadf6;hp=4de41963f979fabb76a3c53f17205a80973728a0;hb=3e91848cbe3dad23fdb60962fa9b678592591c34;hpb=f79af94ad91dfe693eb9779caf71ea892fb1eff6

diff --git a/test/tracemunch b/test/tracemunch
index 4de41963..9d15dd58 100755
--- a/test/tracemunch
+++ b/test/tracemunch
@@ -1,5 +1,5 @@
 #!/usr/bin/env perl
-# $Id: tracemunch,v 1.28 2020/03/08 12:22:49 tom Exp $
+# $Id: tracemunch,v 1.29 2020/04/18 23:52:24 tom Exp $
 ##############################################################################
 # Copyright 2018-2019,2020 Thomas E. Dickey                                  #
 # Copyright 1998-2005,2017 Free Software Foundation, Inc.                    #
@@ -43,7 +43,27 @@ our $putattr =
     'PutAttrChar\(\{\{ ' . "'(.)'"
   . ' = 0[0-7]+ \}\}\) at \(([0-9]+), ([0-9]+)\)';
 our $waddnstr =
-  'waddnstr\(0x([[:xdigit:]]+),"([^\"]+)",[0-9]+\) called \{A_NORMAL\}';
+'^called \{waddnstr\((0x[[:xdigit:]]+|window\d+),"((\\.|[^\"]*))",[-]?[0-9]+\)';
+
+our %TR = qw(
+  DISABLE       0x0000
+  TIMES         0x0001
+  TPUTS         0x0002
+  UPDATE        0x0004
+  MOVE          0x0008
+  CHARPUT       0x0010
+  ORDINARY      0x001F
+  CALLS         0x0020
+  VIRTPUT       0x0040
+  IEVENT        0x0080
+  BITS          0x0100
+  ICALLS        0x0200
+  CCALLS        0x0400
+  DATABASE      0x0800
+  ATTRS         0x1000
+);
+
+our $tracelevel = 0;
 
 # If the trace is complete, we can infer addresses using the return value from
 # newwin, etc.  But if it is incomplete, we can still check for special cases
@@ -457,6 +477,14 @@ sub muncher($) {
             $_ =~ s/\r\n/\n/g;
             $_ =~ s/\r/\n/g;
 
+            if ( $_ =~
+                /^TRACING NCURSES version.*\(tracelevel=(0x[[:xdigit:]]+)\)/ )
+            {
+                $tracelevel = hex $1;
+                print;
+                next;
+            }
+
             my $thread = "";
             if ( $_ =~ /^(0x[[:xdigit:]]+):/ ) {
                 $thr_addr{$1} = ++$thr_nums unless defined $thr_addr{$1};
@@ -520,8 +548,9 @@ sub muncher($) {
                 }
             }
 
-            # Compactify runs of PutAttrChar calls (TR_CHARPUT)
-            if ( $_ =~ /$putattr/ ) {
+            # Compactify runs of PutAttrChar
+            if ( ( ( $tracelevel & $TR{CHARPUT} ) != 0 ) and $_ =~ /$putattr/ )
+            {
                 my $putattr_chars = $1;
                 my $starty        = $2;
                 my $startx        = $3;
@@ -530,19 +559,23 @@ sub muncher($) {
                         $putattr_chars .= $1;
                     }
                     else {
+                        next if ( $_ =~ /^PUTC 0x[[:xdigit:]]+.*/ );
+                        next if ( $_ =~ /^\.\.\.skip.*/ );
+                        next if ( $_ =~ /^forced to blank.*/ );
                         last;
                     }
                 }
-                print
-"RUN of PutAttrChar()s: \"$putattr_chars\" from ${starty}, ${startx}\n";
+                print "RUN of PutAttrChar()s:"
+                  . " \"$putattr_chars\" from ${starty}, ${startx}\n";
                 redo CLASSIFY;
             }
 
-            # Compactify runs of waddnstr calls (TR_CALLS)
-            if ( $_ =~ /$waddnstr/ ) {
+            # Compactify runs of waddnstr calls
+            if ( ( ( $tracelevel & $TR{CALLS} ) != 0 ) and $_ =~ /$waddnstr/ ) {
                 my $waddnstr_chars = $2;
                 my $winaddr        = $1;
                 while (<$STDIN>) {
+                    next if ( $_ =~ /^return \}0/ );
                     if ( $_ =~ /$waddnstr/ && $1 eq $winaddr ) {
                         $waddnstr_chars .= $2;
                     }
@@ -551,7 +584,8 @@ sub muncher($) {
                     }
                 }
                 my $winaddstr = &transaddr($winaddr);
-                print "RUN of waddnstr()s: $winaddr, \"$waddnstr_chars\"\n";
+                print "RUN of waddnstr()s:"
+                  . " $winaddstr, \"$waddnstr_chars\"\n";
                 redo CLASSIFY;
             }
 
@@ -580,6 +614,10 @@ sub muncher($) {
     }
 }
 
+for my $tr ( keys %TR ) {
+    $TR{$tr} = hex $TR{$tr};
+}
+
 if ( $#ARGV >= 0 ) {
     while ( $#ARGV >= 0 ) {
         my $file = shift @ARGV;