Browse Source

[gdb/testsuite] Fix error handling in _dap_read_json

In _dap_read_json we have a gdb_expect with clauses that generate errors:
...
        timeout {
            error "timeout reading json header"
        }
        eof {
            error "eof reading json header"
        }
...

Proc gdb_expect uses dejagnu's remote_expect, which has some peculiar
semantics related to errors:
...
 # remote_expect works basically the same as standard expect, but it
 # also takes care of getting the file descriptor from the specified
 # host and also calling the timeout/eof/default section if there is an
 # error on the expect call.
.....

When a timeout triggers, it generates a timeout error, which is reported by
gdb_expect, after which it runs the timeout/eof/default clauses, which
generates an eof error, which is reported by runtest.

I think the intention here is to generate just a one error, a timeout error.

Fix this by postponing generating the error until after gdb_expect.

Tested on x86_64-linux, by:
- running all the DAP test-cases and observing no regressions, and
- modifying the gdb.dap/eof.exp test-case to trigger a timeout error, and
  observing only a timeout error.

PR testsuite/31382
Bug: https://sourceware.org/bugzilla/show_bug.cgi?id=31382
master
Tom de Vries 2 years ago
parent
commit
99eeecc8d2
  1. 27
      gdb/testsuite/lib/dap-support.exp

27
gdb/testsuite/lib/dap-support.exp

@ -147,6 +147,8 @@ proc dap_send_request {command {obj {}}} {
# "last_ton" will be set to the TON form of the result. # "last_ton" will be set to the TON form of the result.
proc _dap_read_json {} { proc _dap_read_json {} {
set length "" set length ""
set seen_timeout 0
set seen_eof 0
gdb_expect { gdb_expect {
-re "^Content-Length: (\[0-9\]+)\r\n" { -re "^Content-Length: (\[0-9\]+)\r\n" {
set length $expect_out(1,string) set length $expect_out(1,string)
@ -160,13 +162,20 @@ proc _dap_read_json {} {
# Done. # Done.
} }
timeout { timeout {
error "timeout reading json header" set seen_timeout 1
} }
eof { eof {
error "eof reading json header" set seen_eof 1
} }
} }
if {$seen_timeout} {
error "timeout reading json header"
}
if {$seen_eof} {
error "eof reading json header"
}
if {$length == ""} { if {$length == ""} {
error "didn't find content-length" error "didn't find content-length"
} }
@ -176,17 +185,27 @@ proc _dap_read_json {} {
# Tcl only allows up to 255 characters in a {} expression in a # Tcl only allows up to 255 characters in a {} expression in a
# regexp, so we may need to read in chunks. # regexp, so we may need to read in chunks.
set this_len [expr {min ($length, 255)}] set this_len [expr {min ($length, 255)}]
set seen_timeout 0
set seen_eof 0
gdb_expect { gdb_expect {
-re "^.{$this_len}" { -re "^.{$this_len}" {
append json $expect_out(0,string) append json $expect_out(0,string)
} }
timeout { timeout {
error "timeout reading json body" set seen_timeout 1
} }
eof { eof {
error "eof reading json body" set seen_eof 1
} }
} }
if {$seen_timeout} {
error "timeout reading json header"
}
if {$seen_eof} {
error "eof reading json header"
}
incr length -$this_len incr length -$this_len
} }

Loading…
Cancel
Save