ncurses 6.2 - patch 20200627

[ncurses.git] / test / tracemunch

diff --git a/test/tracemunch b/test/tracemunch
index cc33852dc5ccf13968cf61cecccaa44b550b236e..9d15dd58fbcb3dcd80bb659b1734a3953b9dadf6 100755 (executable)
--- a/test/tracemunch
+++ b/test/tracemunch
@@ -1,7 +1,8 @@
 #!/usr/bin/env perl
-# $Id: tracemunch,v 1.26 2019/12/21 22:33:35 tom Exp $
+# $Id: tracemunch,v 1.29 2020/04/18 23:52:24 tom Exp $
 ##############################################################################
-# Copyright (c) 1998-2018,2019 Free Software Foundation, Inc.                #
+# Copyright 2018-2019,2020 Thomas E. Dickey                                  #
+# Copyright 1998-2005,2017 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"), #
@@ -36,11 +37,33 @@
 use strict;
 use warnings;
 
+$| = 1;
+
 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
@@ -419,7 +442,10 @@ sub transaddr($) {
             my $type = $known_p1{$func};
             chomp $addr;
             $addr =~ s/^[^(]+\((0x[[:xdigit:]]+).*/$1/i;
-            if ( $type == 1 ) {
+            if ( $addr !~ /^0x[[:xdigit:]]+$/i ) {
+                printf "OOPS - expected type #$type, skipping\n>>$addr\n";
+            }
+            elsif ( $type == 1 ) {
                 $scr_addr{$addr} = ++$scr_nums;
                 $arg = &transaddr($arg);
             }
@@ -451,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};
@@ -514,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;
@@ -524,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;
                     }
@@ -545,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;
             }
 
@@ -574,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;