From 57c699398c1a61f1a57574a5ed64654cbadd2a50 Mon Sep 17 00:00:00 2001
From: Tom Tromey <tromey@adacore.com>
Date: Thu, 21 Sep 2023 08:49:44 -0600
Subject: [PATCH] Add regression test for instructionReference change

Yesterday I pushed a patch to fix a small oversight in the DAP code
that caused an instructionReference to be an array instead of a
string.

This patch adds a test case for that regression.  This required
exposing the TON form of the response -- something I mentioned might
be necessary when this code was changed to return just the Tcl form.

I tested this by backing out yesterday's bug fix and verifying that a
failure is seen.
---
 gdb/testsuite/gdb.dap/bt-nodebug.exp | 15 ++++++++++++++-
 gdb/testsuite/lib/dap-support.exp    | 14 +++++++++-----
 2 files changed, 23 insertions(+), 6 deletions(-)

diff --git a/gdb/testsuite/gdb.dap/bt-nodebug.exp b/gdb/testsuite/gdb.dap/bt-nodebug.exp
index abd394adbff..62cc0d16a11 100644
--- a/gdb/testsuite/gdb.dap/bt-nodebug.exp
+++ b/gdb/testsuite/gdb.dap/bt-nodebug.exp
@@ -58,6 +58,19 @@ set obj [dap_check_request_and_response "set breakpoint on no_debug_info" \
 	    setFunctionBreakpoints \
 	    {o breakpoints [a [o name [s no_debug_info]]]}]
 set breakpoints [dict get [lindex $obj 0] body breakpoints]
-gdb_assert {[dict exists [lindex $breakpoints 0] instructionReference]} "breakpoint has instructionReference"
+gdb_assert {[dict exists [lindex $breakpoints 0] instructionReference]} \
+    "breakpoint has instructionReference"
+
+# instructionReference is specified as a string, but it's form is not
+# otherwise given in the spec.  gdb always emits it as hex.  A bug
+# slipped in that caused this to be incorrect, so we test both parts
+# here; to test whether a string was given, we have to reach into the
+# TON form.
+set list_form [namespace eval ton::2list $last_ton]
+set ref [namespace eval ton::2list {
+    get $list_form body breakpoints 0 instructionReference
+}]
+gdb_assert {[regexp "^$hex\$" $ref]} \
+    "instructionReference is a hex string"
 
 dap_shutdown
diff --git a/gdb/testsuite/lib/dap-support.exp b/gdb/testsuite/lib/dap-support.exp
index 2a0cb886528..82d83d95b9f 100644
--- a/gdb/testsuite/lib/dap-support.exp
+++ b/gdb/testsuite/lib/dap-support.exp
@@ -125,7 +125,8 @@ proc _dap_send_request {command {obj {}}} {
 }
 
 # Read a JSON response from gdb.  This will return a dict on
-# success, or throw an exception on error.
+# success, or throw an exception on error.  On success, the global
+# "last_ton" will be set to the TON form of the result.
 proc _dap_read_json {} {
     set length ""
     gdb_expect {
@@ -171,16 +172,19 @@ proc _dap_read_json {} {
 	incr length -$this_len
     }
 
-    set ton [ton::json2ton $json]
-    return [namespace eval ton::2dict $ton]
+    global last_ton
+    set last_ton [ton::json2ton $json]
+    return [namespace eval ton::2dict $last_ton]
 }
 
 # Read a sequence of JSON objects from gdb, until a response object is
 # seen.  If the response object has the request sequence number NUM,
 # and is for command CMD, return a list of two elements: the response
 # object and a list of any preceding events, in the order they were
-# emitted.  The objects are dicts.  If a response object is seen but has
-# the wrong sequence number or command, throw an exception
+# emitted.  The objects are dicts.  If a response object is seen but
+# has the wrong sequence number or command, throw an exception If a
+# response is seen, this leaves the global "last_ton" set to the TON
+# for the response.
 
 proc _dap_read_response {cmd num} {
     set result {}
-- 
2.30.2