gdb_test_multiple: Anchor prompt match if -lbl

I wrote a test like this:

    gdb_test_multiple "command" "" -lbl {
       -re "^\r\nprefix foo(?=\r\n)" {
           exp_continue
       }
       -re "^\r\nprefix bar(?=\r\n)" {
           exp_continue
       }
       -re "^\r\prefix (?=\r\n)" {
           exp_continue
       }
       -re "^\r\n$::gdb_prompt $" {
       	   pass $gdb_test_name
       }
    }

Anchors are needed in my case to avoid too-eager matching due to the
common prefix.

The intent is for the prompt match above to override the built-in
prompt match.  However, it doesn't and the test fails with output like
this:

  (gdb) command
  prefix foo
  prefix bar
  meant-to-be-matched-by-lbl
  (gdb)

That's because the built-in match for the prompt matches before the
-lbl pattern for this expect buffer:

  \r\nmeant-to-be-matched-by-lbl\r\n(gdb)

This this by anchoring the built-in prompt match if -lbl was
requested.

Change-Id: Ic2571ec793d856a89ee0d533ec363e2ac6036ea2

diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index c51cea86a9d699bdf33763a120c24dc5d50a7cc0..6d64344bc0aa58b9a554756252ea6a4c787a3678 100644 (file)
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -1124,6 +1124,7 @@ proc gdb_test_multiple { command message args } {
     global any_spawn_id
 
     set line_by_line 0
+    set lbl_anchor_re ""
     set prompt_regexp ""
     set prompt_anchor 1
     for {set i 0} {$i < [llength $args]} {incr i} {
@@ -1133,6 +1134,7 @@ proc gdb_test_multiple { command message args } {
            set prompt_regexp [lindex $args $i]
        } elseif { $arg == "-lbl" } {
            set line_by_line 1
+           set lbl_anchor_re "^"
        } elseif { $arg == "-no-prompt-anchor" } {
            set prompt_anchor 0
        } else {
@@ -1391,7 +1393,7 @@ proc gdb_test_multiple { command message args } {
            fail "$errmsg"
            set result -1
        }
-       -re "\r\n$prompt_regexp" {
+       -re "${lbl_anchor_re}\r\n$prompt_regexp" {
            if {![string match "" $message]} {
                fail "$message"
            }