[binutils-gdb] [gdb/testsuite] Fix gdb.cp/nested-types.exp with check-read1

[Tom de Vries]

https://sourceware.org/git/gitweb.cgi?p=binutils-gdb.git;h=36695cf8ffe4b93cb55564f5eabd6a549a0b5cbb

commit 36695cf8ffe4b93cb55564f5eabd6a549a0b5cbb
Author: Tom de Vries <tdevries@suse.de>
Date:   Thu Jun 10 07:36:19 2021 +0200

    [gdb/testsuite] Fix gdb.cp/nested-types.exp with check-read1
    
    With check-read1 I occasionally run into:
    ...
    FAIL: gdb.cp/nested-types.exp: ptype S10 (limit = 7) \
      // parse failed (timeout)
    ...
    I can trigger this reliably by running check-read1 in conjunction with
    stress -c 5.
    
    Fix this by breaking up the regexp in cp_test_ptype_class.
    
    Tested on x86_64-linux.
    
    gdb/testsuite/ChangeLog:
    
    2021-06-10  Tom de Vries  <tdevries@suse.de>
    
            * lib/cp-support.exp (cp_test_ptype_class): Break up regexp.
            * gdb.cp/nested-types.exp: Remove usage of read1 timeout factor.

Diff:
---
 gdb/testsuite/ChangeLog               |  5 +++++
 gdb/testsuite/gdb.cp/nested-types.exp | 11 ++---------
 gdb/testsuite/lib/cp-support.exp      | 36 ++++++++++++++++++++++++++---------
 3 files changed, 34 insertions(+), 18 deletions(-)

diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index 5e74a6a9bb4..2f922f4990e 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2021-06-10  Tom de Vries  <tdevries@suse.de>
+
+	* lib/cp-support.exp (cp_test_ptype_class): Break up regexp.
+	* gdb.cp/nested-types.exp: Remove usage of read1 timeout factor.
+
 2021-06-10  Tom de Vries  <tdevries@suse.de>
 
 	* gdb.cp/cplusfuncs.exp (info_func_regexp): Use gdb_test_lines.
diff --git a/gdb/testsuite/gdb.cp/nested-types.exp b/gdb/testsuite/gdb.cp/nested-types.exp
index 155d915d574..a71339b233f 100644
--- a/gdb/testsuite/gdb.cp/nested-types.exp
+++ b/gdb/testsuite/gdb.cp/nested-types.exp
@@ -278,20 +278,13 @@ proc test_nested_limit {limit log} {
     node_result result 10 $limit {} 0 $log
 
     if {!$log} {
-	if {$limit < 0 || $limit >= 8 } {
-	    set read1_timeout_factor 10
-	} else {
-	    set read1_timeout_factor 1
-	}
 	# The only output we check for is the contents of the struct,
 	# ignoring the leading "type = struct S10 {" and trailing "}" of
 	# the outermost node.
 	set result [lindex $result 0]
 	lassign $result type access key name children
-	with_read1_timeout_factor $read1_timeout_factor {
-	    cp_test_ptype_class $name "ptype $name (limit = $limit)" $key \
-		$name $children
-	}
+	cp_test_ptype_class $name "ptype $name (limit = $limit)" $key \
+	    $name $children
     }
 }
 
diff --git a/gdb/testsuite/lib/cp-support.exp b/gdb/testsuite/lib/cp-support.exp
index b188c904710..479ef079360 100644
--- a/gdb/testsuite/lib/cp-support.exp
+++ b/gdb/testsuite/lib/cp-support.exp
@@ -245,6 +245,7 @@ proc cp_test_ptype_class { in_exp in_testname in_key in_tag in_class_table
 			   { in_ptype_arg /r } { recursive_qid 0 } } {
     global gdb_prompt
     set wsopt "\[\r\n\t \]*"
+    set hwsopt "\[\t \]*"
 
     if {$recursive_qid == 0} {
 	# The test name defaults to the command, but without the
@@ -306,23 +307,40 @@ proc cp_test_ptype_class { in_exp in_testname in_key in_tag in_class_table
 			    "$in_tag\\((int|void|)\\);"]
 
     # Partial regexp for parsing the struct/class header.
-    set regexp_header "(struct|class)${wsopt}(\[^ \t\]*)${wsopt}"
-    append regexp_header "(\\\[with .*\\\]${wsopt})?((:\[^\{\]*)?)${wsopt}\{"
+    set regexp_header "(struct|class)${hwsopt}(\[^ \t\]*)${hwsopt}"
+    append regexp_header "(\\\[with .*\\\]${hwsopt})?((:\[^\{\]*)?)${hwsopt}\{"
     if {$recursive_qid == 0} {
 	# Actually do the ptype.
-
 	# For processing the output of ptype, we must get to the prompt.
-	set the_regexp "type = ${regexp_header}"
-	append the_regexp "(.*)\}${wsopt}(\[^\r\n\]*)\[\r\n\]+$gdb_prompt $"
 	set parse_okay 0
+	set state 0
+	set actual_body ""
 	gdb_test_multiple "$in_command" "$in_testname // parse failed" {
-	    -re $the_regexp {
-		set parse_okay          1
+	    -re "type = ${regexp_header}" {
+		if { $state == 0 } { set state 1 } else { set state -1 }
 		set actual_key          $expect_out(1,string)
 		set actual_tag          $expect_out(2,string)
 		set actual_base_string  $expect_out(4,string)
-		set actual_body         $expect_out(6,string)
-		set actual_tail         $expect_out(7,string)
+		exp_continue
+	    }
+	    -re "^\r\n\}${hwsopt}(\[^\r\n\]*)(?=\r\n)" {
+		if { $state == 1 } { set state 2 } else { set state -2 }
+		set actual_tail $expect_out(1,string)
+		exp_continue
+	    }
+	    -re "^\r\n(\[^\r\n\]*)(?=\r\n)" {
+		if { $state != 1 } { set $state -3 }
+		if { $actual_body == "" } {
+		    set actual_body $expect_out(1,string)
+		} else {
+		    append actual_body "\n$expect_out(1,string)"
+		}
+		exp_continue
+	    }
+	    -re -wrap "" {
+		if { $state == 2 } {
+		    set parse_okay 1
+		}
 	    }
 	}
     } else {