[PATCH 09/25] Implement DAP setExceptionBreakpoints request

[Tom Tromey <tromey@adacore.com>]

This implements the DAP setExceptionBreakpoints request for Ada.  This
is a somewhat minimal implementation, in that "exceptionOptions" are
not implemented (or advertised) -- I wasn't completely sure how this
feature is supposed to work.

I haven't added C++ exception handling here, but it's easy to do if
needed.

This patch relies on the new MI command execution support to do its
work.
---
 gdb/python/lib/gdb/dap/breakpoint.py           | 65 ++++++++++++++++++++++++--
 gdb/python/lib/gdb/dap/server.py               |  4 +-
 gdb/testsuite/gdb.dap/catch-exception.exp      | 65 ++++++++++++++++++++++++++
 gdb/testsuite/gdb.dap/catch-exception/pck.ads  | 18 +++++++
 gdb/testsuite/gdb.dap/catch-exception/prog.adb | 44 +++++++++++++++++
 5 files changed, 189 insertions(+), 7 deletions(-)

diff --git a/gdb/python/lib/gdb/dap/breakpoint.py b/gdb/python/lib/gdb/dap/breakpoint.py
index f0e1f103d1b..877069f79a5 100644
--- a/gdb/python/lib/gdb/dap/breakpoint.py
+++ b/gdb/python/lib/gdb/dap/breakpoint.py
@@ -37,12 +37,11 @@ def breakpoint_descriptor(bp):
         # https://github.com/microsoft/debug-adapter-protocol/issues/13
         loc = bp.locations[0]
         (basename, line) = loc.source
-        return {
+        result = {
             "id": bp.number,
             "verified": True,
             "source": {
                 "name": os.path.basename(basename),
-                "path": loc.fullname,
                 # We probably don't need this but it doesn't hurt to
                 # be explicit.
                 "sourceReference": 0,
@@ -50,6 +49,10 @@ def breakpoint_descriptor(bp):
             "line": line,
             "instructionReference": hex(loc.address),
         }
+        path = loc.fullname
+        if path is not None:
+            result["source"]["path"] = path
+        return result
     else:
         return {
             "id": bp.number,
@@ -58,9 +61,10 @@ def breakpoint_descriptor(bp):
 
 
 # Helper function to set some breakpoints according to a list of
-# specifications.
+# specifications and a callback function to do the work of creating
+# the breakpoint.
 @in_gdb_thread
-def _set_breakpoints(kind, specs):
+def _set_breakpoints_callback(kind, specs, creator):
     global breakpoint_map
     # Try to reuse existing breakpoints if possible.
     if kind in breakpoint_map:
@@ -75,7 +79,7 @@ def _set_breakpoints(kind, specs):
             bp = saved_map.pop(keyspec)
         else:
             # FIXME handle exceptions here
-            bp = gdb.Breakpoint(**spec)
+            bp = creator(**spec)
         breakpoint_map[kind][keyspec] = bp
         result.append(breakpoint_descriptor(bp))
     # Delete any breakpoints that were not reused.
@@ -84,6 +88,13 @@ def _set_breakpoints(kind, specs):
     return result
 
 
+# Helper function to set odinary breakpoints according to a list of
+# specifications.
+@in_gdb_thread
+def _set_breakpoints(kind, specs):
+    return _set_breakpoints_callback(kind, specs, gdb.Breakpoint)
+
+
 @request("setBreakpoints")
 def set_breakpoint(*, source, breakpoints=[], **args):
     if "path" not in source:
@@ -141,3 +152,47 @@ def set_insn_breakpoints(*, breakpoints, offset=None, **args):
     return {
         "breakpoints": result,
     }
+
+
+@in_gdb_thread
+def _catch_exception(filterId, condition=None, **args):
+    if filterId == "assert":
+        args = ["-catch-assert"]
+    elif filterId == "exception":
+        args = ["-catch-exception"]
+    else:
+        raise Exception(f"Invalid exception filterID: {filterId}")
+    if condition is not None:
+        args.extend(["-c", condition])
+    result = gdb.execute_mi(*args)
+    # A little lame that there's no more direct way.
+    for bp in gdb.breakpoints():
+        if bp.number == result["bkptno"]:
+            return bp
+    raise Exception("Could not find catchpoint after creating")
+
+
+@in_gdb_thread
+def _set_exception_catchpoints(filter_options):
+    return _set_breakpoints_callback("exception", filter_options, _catch_exception)
+
+
+@request("setExceptionBreakpoints")
+@capability("supportsExceptionFilterOptions")
+@capability("exceptionBreakpointFilters", ({
+    "filter": "assert",
+    "label": "Ada assertions",
+    "supportsCondition": True,
+}, {
+    "filter": "exception",
+    "label": "Ada exceptions",
+    "supportsCondition": True,
+}))
+def set_exception_breakpoints(*, filters, filterOptions=[], **args):
+    # Convert the 'filters' to the filter-options style.
+    options = [{"filterId": filter} for filter in filters]
+    options.extend(filterOptions)
+    result = send_gdb_with_response(lambda: _set_exception_catchpoints(options))
+    return {
+        "breakpoints": result,
+    }
diff --git a/gdb/python/lib/gdb/dap/server.py b/gdb/python/lib/gdb/dap/server.py
index ff88282049f..f27fa9caa4f 100644
--- a/gdb/python/lib/gdb/dap/server.py
+++ b/gdb/python/lib/gdb/dap/server.py
@@ -171,13 +171,13 @@ def request(name):
     return wrap
 
 
-def capability(name):
+def capability(name, value=True):
     """A decorator that indicates that the wrapper function implements
     the DAP capability NAME."""
 
     def wrap(func):
         global _capabilities
-        _capabilities[name] = True
+        _capabilities[name] = value
         return func
 
     return wrap
diff --git a/gdb/testsuite/gdb.dap/catch-exception.exp b/gdb/testsuite/gdb.dap/catch-exception.exp
new file mode 100644
index 00000000000..6bfeb3ed87e
--- /dev/null
+++ b/gdb/testsuite/gdb.dap/catch-exception.exp
@@ -0,0 +1,65 @@
+# Copyright 2023 Free Software Foundation, Inc.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+load_lib ada.exp
+load_lib dap-support.exp
+
+require allow_ada_tests allow_dap_tests gnat_runtime_has_debug_info
+
+standard_ada_testfile prog
+
+if {[gdb_compile_ada "${srcfile}" "${binfile}" executable \
+	 {debug additional_flags=-gnata}] != ""} {
+    return -1
+}
+
+if {[dap_launch $binfile] == ""} {
+    return
+}
+
+set obj [dap_check_request_and_response "set exception catchpoints" \
+	     setExceptionBreakpoints \
+	     {o filters [a [s assert]] \
+		  filterOptions [a [o filterId [s exception] \
+					condition [s "Global_Var = 23"]]]}]
+
+set bps [dict get [lindex $obj 0] body breakpoints]
+gdb_assert {[llength $bps] == 2} "two breakpoints"
+
+# The "path" should never be "null".
+set i 1
+foreach spec $bps {
+    # If "path" does not exist, then that is fine as well.
+    if {![dict exists $spec source path]} {
+	pass "breakpoint $i path"
+    } else {
+	gdb_assert {[dict get $spec source path] != "null"} \
+	    "breakpoint $i path"
+    }
+    incr i
+}
+
+dap_check_request_and_response "start inferior" configurationDone
+
+dap_wait_for_event_and_check "stopped at first raise" stopped \
+    "body reason" breakpoint \
+    "body hitBreakpointIds" 2
+
+dap_check_request_and_response "continue to assert" continue
+dap_wait_for_event_and_check "stopped at assert" stopped \
+    "body reason" breakpoint \
+    "body hitBreakpointIds" 1
+
+dap_shutdown
diff --git a/gdb/testsuite/gdb.dap/catch-exception/pck.ads b/gdb/testsuite/gdb.dap/catch-exception/pck.ads
new file mode 100644
index 00000000000..e82a54fa60a
--- /dev/null
+++ b/gdb/testsuite/gdb.dap/catch-exception/pck.ads
@@ -0,0 +1,18 @@
+--  Copyright 2023 Free Software Foundation, Inc.
+--
+--  This program is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 3 of the License, or
+--  (at your option) any later version.
+--
+--  This program is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+package Pck is
+   Global_Var : Integer := 91;
+end Pck;
diff --git a/gdb/testsuite/gdb.dap/catch-exception/prog.adb b/gdb/testsuite/gdb.dap/catch-exception/prog.adb
new file mode 100644
index 00000000000..287eb2492f9
--- /dev/null
+++ b/gdb/testsuite/gdb.dap/catch-exception/prog.adb
@@ -0,0 +1,44 @@
+--  Copyright 2023 Free Software Foundation, Inc.
+--
+--  This program is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 3 of the License, or
+--  (at your option) any later version.
+--
+--  This program is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+with Pck; use Pck;
+
+procedure Prog is
+begin
+
+   begin
+      raise Program_Error;
+   exception
+      when others =>
+         null;
+   end;
+
+   begin
+      Global_Var := 23;
+      raise Program_Error;
+   exception
+      when others =>
+         null;
+   end;
+
+   begin
+      pragma Assert (False);
+      null;
+   exception
+      when others =>
+         null;
+   end;
+
+end Prog;

-- 
2.40.0