[RFC/Ada 1/2] Add command to list Ada exceptions

Joel Brobecker
2013-11-07T15:04:31Z

This patch adds a new command "info exceptions" whose purpose is to
provide the list of exceptions currently defined in the inferior.
The usage is:

(gdb) info exceptions [REGEXP]

Without argument, the command lists all exceptions. Otherwise,
only those whose name match REGEXP are listed.

For instance:

(gdb) info exceptions
All defined exceptions:
constraint_error: 0x613dc0
program_error: 0x613d40
storage_error: 0x613d00
tasking_error: 0x613cc0
global_exceptions.a_global_exception: 0x613a80
global_exceptions.a_private_exception: 0x613ac0

The name of the command, as well as its output is part of a legacy
I inherited long ago. It's output being parsed by frontends such as
GPS, I cannot easily change it. Same for the command name.

The implementation is mostly self-contained, and is written in a way
that should make it easy to implement the GDB/MI equivalent. The
careful reviewer will notice that the code added in ada-lang.h could
normally be made private inside ada-lang.c. But these will be used
by the GDB/MI implementation. Rather than making those private now,
only to move them later, I've made them public right away.

gdb/ChangeLog:

* ada-lang.h: #include "vec.h".
(struct ada_exc_info): New.
(ada_exc_info): New typedef.
(DEF_VEC_O(ada_exc_info): New vector.
(ada_exceptions_list): Add declaration.
* ada-lang.c (ada_is_exception_sym)
(ada_is_non_standard_exception_sym, compare_ada_exception_info)
(sort_remove_dups_ada_exceptions_list)
(ada_exc_search_name_matches, ada_add_standard_exceptions)
(ada_add_exceptions_from_frame, ada_add_global_exceptions)
(ada_exceptions_list, info_exceptions_command): New function.
(_initialize_ada_language): Add "info exception" command.

gdb/testsuite/ChangeLog:

* info_exc: New testcase.

Tested on x86_64-linux, no regression.
OK to commit?

Thank you!
--
Joel

---
gdb/ada-lang.c | 345 +++++++++++++++++++++++++++++++
gdb/ada-lang.h | 16 ++
gdb/testsuite/gdb.ada/info_exc.exp | 57 +++++
gdb/testsuite/gdb.ada/info_exc/const.ads | 18 ++
gdb/testsuite/gdb.ada/info_exc/foo.adb | 20 ++
5 files changed, 456 insertions(+)
create mode 100644 gdb/testsuite/gdb.ada/info_exc.exp
create mode 100644 gdb/testsuite/gdb.ada/info_exc/const.ads
create mode 100644 gdb/testsuite/gdb.ada/info_exc/foo.adb

diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index 3b1e196..63c9e054 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -12284,6 +12284,346 @@ catch_assert_command (char *arg, int from_tty,
tempflag, 1 /* enabled */,
from_tty);
}
+
+/* Return non-zero if the symbol SYM is an Ada exception object. */
+
+static int
+ada_is_exception_sym (struct symbol *sym)
+{
+ const char *type_name = type_name_no_tag (SYMBOL_TYPE (sym));
+
+ return (SYMBOL_CLASS (sym) != LOC_TYPEDEF
+ && SYMBOL_CLASS (sym) != LOC_BLOCK
+ && SYMBOL_CLASS (sym) != LOC_CONST
+ && SYMBOL_CLASS (sym) != LOC_UNRESOLVED
+ && type_name != NULL && strcmp (type_name, "exception") == 0);
+}
+
+/* Given a global symbol SYM, return non-zero iff SYM is a non-standard
+ Ada exception object. This matches all exceptions except the ones
+ defined by the Ada language. */
+
+static int
+ada_is_non_standard_exception_sym (struct symbol *sym)
+{
+ int i;
+
+ if (!ada_is_exception_sym (sym))
+ return 0;
+
+ for (i = 0; i < sizeof (standard_exc) / sizeof (char *); i++)
+ if (strcmp (SYMBOL_LINKAGE_NAME (sym), standard_exc[i]) == 0)
+ return 0; /* A standard exception. */
+
+ /* Numeric_Error is also a standard exception, so exclude it.
+ See the STANDARD_EXC description for more details as to why
+ this exception is not listed in that array. */
+ if (strcmp (SYMBOL_LINKAGE_NAME (sym), "numeric_error") == 0)
+ return 0;
+
+ return 1;
+}
+
+/* A helper function for qsort, comparing two struct ada_exc_info
+ objects.
+
+ The comparison is determined first by exception name, and then
+ by exception address. */
+
+static int
+compare_ada_exception_info (const void *a, const void *b)
+{
+ const struct ada_exc_info *exc_a = (struct ada_exc_info *) a;
+ const struct ada_exc_info *exc_b = (struct ada_exc_info *) b;
+ int result;
+
+ result = strcmp (exc_a->name, exc_b->name);
+ if (result != 0)
+ return result;
+
+ if (exc_a->addr < exc_b->addr)
+ return -1;
+ if (exc_a->addr > exc_b->addr)
+ return 1;
+
+ return 0;
+}
+
+/* Sort EXCEPTIONS using compare_ada_exception_info as the comparison
+ routine, but keeping the first SKIP elements untouched.
+
+ All duplicates are also removed. */
+
+static void
+sort_remove_dups_ada_exceptions_list (VEC(ada_exc_info) **exceptions,
+ int skip)
+{
+ struct ada_exc_info *to_sort
+ = VEC_address (ada_exc_info, *exceptions) + skip;
+ int to_sort_len
+ = VEC_length (ada_exc_info, *exceptions) - skip;
+ int i, j;
+
+ qsort (to_sort, to_sort_len, sizeof (struct ada_exc_info),
+ compare_ada_exception_info);
+
+ for (i = 1, j = 1; i < to_sort_len; i++)
+ if (compare_ada_exception_info (&to_sort[i], &to_sort[j - 1]) != 0)
+ to_sort[j++] = to_sort[i];
+ to_sort_len = j;
+ VEC_truncate(ada_exc_info, *exceptions, skip + to_sort_len);
+}
+
+/* A function intended as the "name_matcher" callback in the struct
+ quick_symbol_functions' expand_symtabs_matching method.
+
+ SEARCH_NAME is the symbol's search name.
+
+ If USER_DATA is not NULL, it is a pointer to a regext_t object
+ used to match the symbol (by natural name). Otherwise, when USER_DATA
+ is null, no filtering is performed, and all symbols are a positive
+ match. */
+
+static int
+ada_exc_search_name_matches (const char *search_name, void *user_data)
+{
+ regex_t *preg = user_data;
+
+ if (preg == NULL)
+ return 1;
+
+ /* In Ada, the symbol "search name" is a linkage name, whereas
+ the regular expression used to do the matching refers to
+ the natural name. So match against the decoded name. */
+ return (regexec (preg, ada_decode (search_name), 0, NULL, 0) == 0);
+}
+
+/* Add all exceptions defined by the Ada standard whose name match
+ a regular expression.
+
+ If PREG is not NULL, then this regexp_t object is used to
+ perform the symbol name matching. Otherwise, no name-based
+ filtering is performed.
+
+ EXCEPTIONS is a vector of exceptions to which matching exceptions
+ gets pushed. */
+
+static void
+ada_add_standard_exceptions (regex_t *preg, VEC(ada_exc_info) **exceptions)
+{
+ int i;
+
+ for (i = 0; i < ARRAY_SIZE (standard_exc); i++)
+ {
+ if (preg == NULL
+ || regexec (preg, standard_exc[i], 0, NULL, 0) == 0)
+ {
+ struct bound_minimal_symbol msymbol
+ = ada_lookup_simple_minsym (standard_exc[i]);
+
+ if (msymbol.minsym != NULL)
+ {
+ struct ada_exc_info info
+ = {standard_exc[i], SYMBOL_VALUE_ADDRESS (msymbol.minsym)};
+
+ VEC_safe_push (ada_exc_info, *exceptions, &info);
+ }
+ }
+ }
+}
+
+/* Add all Ada exceptions defined locally and accessible from the given
+ FRAME.
+
+ If PREG is not NULL, then this regexp_t object is used to
+ perform the symbol name matching. Otherwise, no name-based
+ filtering is performed.
+
+ EXCEPTIONS is a vector of exceptions to which matching exceptions
+ gets pushed. */
+
+static void
+ada_add_exceptions_from_frame (regex_t *preg, struct frame_info *frame,
+ VEC(ada_exc_info) **exceptions)
+{
+ struct block *block = get_frame_block (frame, 0);
+
+ while (block != 0)
+ {
+ struct block_iterator iter;
+ struct symbol *sym;
+
+ ALL_BLOCK_SYMBOLS (block, iter, sym)
+ {
+ switch (SYMBOL_CLASS (sym))
+ {
+ case LOC_TYPEDEF:
+ case LOC_BLOCK:
+ case LOC_CONST:
+ break;
+ default:
+ if (ada_is_exception_sym (sym))
+ {
+ struct ada_exc_info info = {SYMBOL_PRINT_NAME (sym),
+ SYMBOL_VALUE_ADDRESS (sym)};
+
+ VEC_safe_push (ada_exc_info, *exceptions, &info);
+ }
+ }
+ }
+ if (BLOCK_FUNCTION (block))
+ break;
+ block = BLOCK_SUPERBLOCK (block);
+ }
+}
+
+/* Add all exceptions defined globally whose name name match
+ a regular expression, excluding standard exceptions.
+
+ The reason we exclude standard exceptions is that they need
+ to be handled separately: Standard exceptions are defined inside
+ a runtime unit which is normally not compiled with debugging info,
+ and thus usually do not show up in our symbol search. However,
+ if the unit was in fact built with debugging info, we need to
+ exclude them because they would duplicate the entry we found
+ during the special loop that specifically searches for those
+ standard exceptions.
+
+ If PREG is not NULL, then this regexp_t object is used to
+ perform the symbol name matching. Otherwise, no name-based
+ filtering is performed.
+
+ EXCEPTIONS is a vector of exceptions to which matching exceptions
+ gets pushed. */
+
+static void
+ada_add_global_exceptions (regex_t *preg, VEC(ada_exc_info) **exceptions)
+{
+ struct objfile *objfile;
+ struct symtab *s;
+
+ ALL_OBJFILES (objfile)
+ if (objfile->sf)
+ objfile->sf->qf->expand_symtabs_matching
+ (objfile, NULL, ada_exc_search_name_matches,
+ VARIABLES_DOMAIN, preg);
+
+ ALL_PRIMARY_SYMTABS (objfile, s)
+ {
+ struct blockvector *bv = BLOCKVECTOR (s);
+ int i;
+
+ for (i = GLOBAL_BLOCK; i <= STATIC_BLOCK; i++)
+ {
+ struct block *b = BLOCKVECTOR_BLOCK (bv, i);
+ struct block_iterator iter;
+ struct symbol *sym;
+
+ ALL_BLOCK_SYMBOLS (b, iter, sym)
+ if (ada_is_non_standard_exception_sym (sym)
+ && (preg == NULL
+ || regexec (preg, SYMBOL_NATURAL_NAME (sym),
+ 0, NULL, 0) == 0))
+ {
+ struct ada_exc_info info
+ = {SYMBOL_PRINT_NAME (sym), SYMBOL_VALUE_ADDRESS (sym)};
+
+ VEC_safe_push (ada_exc_info, *exceptions, &info);
+ }
+ }
+ }
+}
+
+/* Return a vector of ada_exc_info.
+
+ If REGEXP is NULL, all exceptions are included in the result.
+ Otherwise, it should contain a valid regular expression,
+ and only the exceptions whose name match that regular expression
+ are included in the result.
+
+ The exceptions are sorted in the following order:
+ - Standard exceptions (defined by the Ada language), in
+ alphabetical order;
+ - Exceptions only visible from the current frame, in
+ alphabetical order;
+ - Exceptions whose scope is global, in alphabetical order. */
+
+VEC(ada_exc_info) *
+ada_exceptions_list (char *regexp)
+{
+ VEC(ada_exc_info) *result = NULL;
+ struct cleanup *old_chain
+ = make_cleanup (VEC_cleanup (ada_exc_info), &result);
+ regex_t *preg = NULL;
+ int prev_len;
+
+ if (regexp != NULL)
+ {
+ int status;
+
+ preg = alloca (sizeof (regex_t));
+ status = regcomp (preg, regexp, REG_NOSUB);
+ if (status != 0)
+ {
+ char *err = get_regcomp_error (status, preg);
+
+ make_cleanup (xfree, err);
+ error (_("Invalid regexp (%s): %s"), err, regexp);
+ }
+ make_regfree_cleanup (preg);
+ }
+
+ /* First, list the known standard exceptions. These exceptions
+ need to be handled separately, as they are usually defined in
+ runtime units that have been compiled without debugging info. */
+ ada_add_standard_exceptions (preg, &result);
+
+ /* Next, find all exceptions whose scope is local and accessible
+ from the currently selected frame. */
+
+ if (target_has_registers)
+ {
+ prev_len = VEC_length (ada_exc_info, result);
+ ada_add_exceptions_from_frame (preg, get_selected_frame (NULL),
+ &result);
+ if (VEC_length (ada_exc_info, result) > prev_len)
+ sort_remove_dups_ada_exceptions_list (&result, prev_len);
+ }
+
+ /* Add all exceptions whose scope is global. */
+
+ prev_len = VEC_length (ada_exc_info, result);
+ ada_add_global_exceptions (preg, &result);
+ if (VEC_length (ada_exc_info, result) > prev_len)
+ sort_remove_dups_ada_exceptions_list (&result, prev_len);
+
+ discard_cleanups (old_chain);
+ return result;
+}
+
+/* Implement the "info exceptions" command. */
+
+static void
+info_exceptions_command (char *regexp, int from_tty)
+{
+ VEC(ada_exc_info) *exceptions;
+ struct cleanup *cleanup;
+ struct gdbarch *gdbarch = get_current_arch ();
+ int ix;
+ struct ada_exc_info *info;
+
+ exceptions = ada_exceptions_list (regexp);
+ cleanup = make_cleanup (VEC_cleanup (ada_exc_info), &exceptions);
+
+ printf_filtered (regexp
+ ? "All exceptions matching regular expression \"%s\":\n"
+ : "All defined exceptions:\n", regexp);
+ for (ix = 0; VEC_iterate(ada_exc_info, exceptions, ix, info); ix++)
+ printf_filtered ("%s: %s\n", info->name, paddress (gdbarch, info->addr));
+
+ do_cleanups (cleanup);
+}
+
/* Operators */
/* Information about operators given special treatment in functions
below. */
@@ -12955,6 +13295,11 @@ With an argument, catch only exceptions with the given name."),

varsize_limit = 65536;

+ add_info ("exceptions", info_exceptions_command,
+ _("\
+List all Ada exception names. If a regexp is passed as an argument,\n\
+only those matching the regular expression are listed."));
+
obstack_init (&symbol_list_obstack);

decoded_names_store = htab_create_alloc
diff --git a/gdb/ada-lang.h b/gdb/ada-lang.h
index 151ced8..f38ddc8 100644
--- a/gdb/ada-lang.h
+++ b/gdb/ada-lang.h
@@ -27,6 +27,7 @@ struct type_print_options;
#include "value.h"
#include "gdbtypes.h"
#include "breakpoint.h"
+#include "vec.h"

/* Names of specific files known to be part of the runtime
system and that might consider (confusing) debugging information.
@@ -389,6 +390,21 @@ extern void create_ada_exception_catchpoint
char *excep_string, char *cond_string, int tempflag, int disabled,
int from_tty);

+/* Some information about a given Ada exception. */
+
+typedef struct ada_exc_info
+{
+ /* The name of the exception. */
+ const char *name;
+
+ /* The address of the symbol corresponding to that exception. */
+ CORE_ADDR addr;
+} ada_exc_info;
+
+DEF_VEC_O(ada_exc_info);
+
+extern VEC(ada_exc_info) *ada_exceptions_list (char *regexp);
+
/* Tasking-related: ada-tasks.c */

extern int valid_task_id (int);
diff --git a/gdb/testsuite/gdb.ada/info_exc.exp b/gdb/testsuite/gdb.ada/info_exc.exp
new file mode 100644
index 0000000..a95c4f9
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/info_exc.exp
@@ -0,0 +1,57 @@
+# Copyright 2013 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"
+
+standard_ada_testfile foo
+
+if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } {
+ return -1
+}
+
+# A convenience function that joins all the arguments together,
+# with a regexp that matches zero-or-more end of lines in between
+# each argument. This function is ideal to write the expected output
+# of a GDB command that generates more than a couple of lines, as
+# this allows us to write each line as a separate string, which is
+# easier to read by a human being.
+
+proc multi_line { args } {
+ return [join $args "\[\r\n\]*"]
+}
+
+clean_restart ${testfile}
+
+gdb_test "info exceptions" \
+ [multi_line "All defined exceptions:" \
+ "constraint_error: $hex" \
+ "program_error: $hex" \
+ "storage_error: $hex" \
+ "tasking_error: $hex" \
+ "const.aint_global_e: $hex"]
+
+gdb_test "info exceptions task" \
+ [multi_line "All exceptions matching regular expression \"task\":" \
+ "tasking_error: $hex"]
+
+gdb_test "info exceptions global" \
+ [multi_line "All exceptions matching regular expression \"global\":" \
+ "const.aint_global_e: $hex"]
+
+gdb_test "info exceptions const.aint" \
+ [multi_line "All exceptions matching regular expression \"const\\.aint\":" \
+ "constraint_error: $hex" \
+ "const.aint_global_e: $hex"]
+
diff --git a/gdb/testsuite/gdb.ada/info_exc/const.ads b/gdb/testsuite/gdb.ada/info_exc/const.ads
new file mode 100644
index 0000000..753241e
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/info_exc/const.ads
@@ -0,0 +1,18 @@
+-- Copyright 2013 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 Const is
+ Aint_Global_E : exception;
+end Const;
diff --git a/gdb/testsuite/gdb.ada/info_exc/foo.adb b/gdb/testsuite/gdb.ada/info_exc/foo.adb
new file mode 100644
index 0000000..e047db2
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/info_exc/foo.adb
@@ -0,0 +1,20 @@
+-- Copyright 2013 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 Const; use Const;
+procedure Foo is
+begin
+ raise Aint_Global_E;
+end Foo;
--
1.8.1.2