[RFC/RFA] Add support for catch Ada exceptions

Joel Brobecker
2006-12-30T03:20:45Z

[-- Attachment #1: Type: text/plain, Size: 5913 bytes --]

Hello,

Here is a patch that adds support for "catch"-ing Ada exceptions.
There are 3 different kinds of commands I am introducing:

- catch exception [exception name]
If the exception name is omitted, then all Ada exception are caught.

- catch exception unhandled
This catchpoint will stop if the program raises an exception
that is not handled (and eventually causes the task or program death)

- catch exception assert
This catchpoint stops the program when assertions in the program
fail. With GNAT, they are inserted like this:

[code]
pragma Assert (boolean_EXPRESSION);
[code]

They are activated only if the unit was compiled with assertions
enabled.

Here is a typical GDB session debugging a program that does the
following:

1. Raise exception Constraint_Error (and contain it)
2. Raise exception Program_Error (and contain it)
3. Fails an assertion (and contain it)
4. Raise Constraint_Error (unhandled exception, program death)

We'll first catch all exceptions, and see how it catches them for
the first two exceptions:

(gdb) catch exception
Catchpoint 1 on all Ada exceptions at 0x804b7c0
(gdb) info break
Num Type Disp Enb Address What
1 catch exception keep y 0x0804b7c0 on all Ada exceptions
(gdb) run
Starting program: /[...]/foo

Catchpoint 1, CONSTRAINT_ERROR at 0x08049813 in foo () at foo.adb:5
5 raise Constraint_Error; -- SPOT1
(gdb) c
Continuing.

Catchpoint 1, PROGRAM_ERROR at 0x08049882 in foo () at foo.adb:12
12 raise Program_Error; -- SPOT2

As you see, the catchpoint notification message prints the catchpoint
number that was hit, displays the name of the exception that was raised,
and then the user location where the exception was raised.

In terms of implementation, these catchpoints are implemented using
breakpoints inside known functions of the GNAT runtime. However,
when we stop at these breakpoints, it would be confusing to the user
to leave them there. This is why, after the catchpoint hit, we go up
the stack automatically, and find the first "printable" frame, that
is a frame that is not part of the GNAT runtime and that has debugging
info (see ada_find_printable_frame).

For our last example, we'll catch only Program_Error, but also
failed assertions and unhandled exceptions:

(gdb) catch exception program_error
Catchpoint 1 on `program_error' Ada exception at 0x804b7c0
(gdb) catch assert
Catchpoint 2 on failed Ada assertions at 0x804c437
(gdb) catch exception unhandled
Catchpoint 3 on unhandled Ada exceptions at 0x804ad2d
(gdb) run
Starting program: /[...]/foo

Catchpoint 1, PROGRAM_ERROR at 0x08049882 in foo () at foo.adb:12
12 raise Program_Error; -- SPOT2
(gdb) c
Continuing.

Catchpoint 2, failed assertion at 0x080498f3 in foo () at foo.adb:19
19 pragma Assert (False); -- SPOT3
(gdb) c
Continuing.

Catchpoint 3, unhandled CONSTRAINT_ERROR at 0x08049963 in foo () at foo.adb:26
26 raise Constraint_Error; -- SPOT4

The "info break" output looks like this:

(gdb) info break
Num Type Disp Enb Address What
1 catch exception keep y 0x0804b7c0 on `program_error' Ada exception
2 catch failed assertion keep y 0x0804c437 on failed Ada assertions
3 catch unhandled exception keep y 0x0804ad2d on unhandled Ada exceptions

I already have a small testcase that tests the general functioning
of these catchpoins. I will also write some documentation, but I want
to make sure that at least the user-interface is agreed on before
I start this work.

2006-12-29 Joel Brobecker <brobecker@adacore.com>

* breakpoint.h (enum bptype): Add bp_catch_exception,
bp_catch_unhandled_exception, and bp_catch_failed_assertion.
* ada-lang.h (ada_find_printable_frame): Remove declaration.
(ada_exception_sal): Add declaration.
(ada_decode_exception_location): Likewise.
* ada-lang.c: Add include of annotate.h and valprint.h.
(function_name_from_pc): New function.
(is_known_support_routine): New function.
(ada_find_printable_frame): New function.
(ada_unhandled_exception_name_addr): New function.
(ada_exception_name_addr_1): New function.
(ada_exception_name_addr): New function.
(print_exception_catchpoint): New function.
(print_one_exception_catchpoint): New function.
(print_mention_exception_catchpoint): New function.
(ada_exception_catchpoint_ops): New static variable.
(error_breakpoint_runtime_sym_not_found): New function.
(ada_get_next_arg): New function.
(catch_ada_exception_command_split): New function.
(ada_exception_catchpoint_cond_string): New function.
(ada_parse_catchpoint_condition): New function.
(ada_exception_sal): New function.
(ada_decode_exception_location): New function.
* breakpoint.c: Include ada-lang.h. Add support for Ada exception
catchpoints throughout.
(ep_is_ada_exception_catchpoint): New function.
(create_ada_exception_breakpoint): New function.
(catch_ada_exception_command): New function.
(catch_assert_command): New function.
(catch_command_1): Add handling for "exception" and "assert"
subcommands.
(_initialize_breakpoint): Update the documentation of "catch".
* Makefile.in (ada-lang.o): Add dependency on annotate.h and
valprint.h.
(breakpoint.o): Add dependency on ada-lang.h.

2006-12-29 Joel Brobecker <brobecker@adacore.com>

* gdb.ada/catch_ex/foo.adb: New file.
* gdb.ada/catch_ex.exp: New testcase.

Tested on x86-linux, no regressions.

Thank you!
--
Joel

[-- Attachment #2: catch-except.diff --]
[-- Type: text/plain, Size: 40424 bytes --]

Index: breakpoint.h
===================================================================
RCS file: /cvs/src/src/gdb/breakpoint.h,v
retrieving revision 1.37
diff -u -p -r1.37 breakpoint.h
--- breakpoint.h 18 Apr 2006 19:20:06 -0000 1.37
+++ breakpoint.h 29 Dec 2006 11:34:01 -0000
@@ -138,9 +138,13 @@ enum bptype
/* These are catchpoints to implement "catch catch" and "catch throw"
commands for C++ exception handling. */
bp_catch_catch,
- bp_catch_throw
-
+ bp_catch_throw,

+ /* The following breakpoint types are used to represent catchpoints
+ on Ada exceptions. */
+ bp_catch_exception,
+ bp_catch_unhandled_exception,
+ bp_catch_failed_assertion
};

/* States of enablement of breakpoint. */
Index: ada-lang.h
===================================================================
RCS file: /cvs/src/src/gdb/ada-lang.h,v
retrieving revision 1.23
diff -u -p -r1.23 ada-lang.h
--- ada-lang.h 12 Jan 2006 08:36:29 -0000 1.23
+++ ada-lang.h 29 Dec 2006 11:33:53 -0000
@@ -470,8 +470,6 @@ extern int ada_print_exception_breakpoin

extern void ada_print_exception_breakpoint_task (struct breakpoint *);

-extern void ada_find_printable_frame (struct frame_info *fi);
-
extern void ada_reset_thread_registers (void);

extern int ada_build_task_list (void);
@@ -486,4 +484,15 @@ extern struct symbol *lookup_symbol_in_l
enum language,
int *,
struct symtab **);
+
+extern struct symtab_and_line
+ ada_exception_sal (enum bptype type, char *addr_string, char **cond_string,
+ struct expression **cond, struct breakpoint_ops **ops);
+
+extern struct symtab_and_line
+ ada_decode_exception_location (char *args, enum bptype *type,
+ char **addr_string,
+ char **cond_string, struct expression **cond,
+ struct breakpoint_ops **ops);
+
#endif
Index: ada-lang.c
===================================================================
RCS file: /cvs/src/src/gdb/ada-lang.c,v
retrieving revision 1.85
diff -u -p -r1.85 ada-lang.c
--- ada-lang.c 1 Dec 2006 00:32:29 -0000 1.85
+++ ada-lang.c 29 Dec 2006 11:35:26 -0000
@@ -53,6 +53,8 @@ Boston, MA 02110-1301, USA. */
#include "infcall.h"
#include "dictionary.h"
#include "exceptions.h"
+#include "annotate.h"
+#include "valprint.h"

#ifndef ADA_RETAIN_DOTS
#define ADA_RETAIN_DOTS 0
@@ -8973,7 +8975,648 @@ ada_modulus (struct type * type)
return (ULONGEST) TYPE_HIGH_BOUND (type) + 1;
}
\f
- /* Operators */
+
+/* Ada exception catchpoint support:
+ ---------------------------------
+
+ We support 3 kinds of exception catchpoints:
+ . catchpoints on Ada exceptions
+ . catchpoints on unhandled Ada exceptions
+ . catchpoints on failed assertions
+
+ Exceptions raised during failed assertions, or unhandled exceptions
+ could perfectly be caught with the general catchpoint on Ada exceptions.
+ However, we can easily differentiate these two special cases, and having
+ the option to distinguish these two cases from the rest can be useful
+ to zero-in on certain situations.
+
+ Exception catchpoints are a specialized form of breakpoint,
+ since they rely on inserting breakpoints inside known routines
+ of the GNAT runtime. The implementation is therefore almost
+ a form of breakpoint, with its own set of breakpoint_ops.
+ Each type of catchpoint has its own enum bptype kind.
+
+ We do not need to store the location where to insert the physical
+ breakpoint in the associated breakpoint struct, since this location
+ can be directly deduced from the bptype kind. The ADDR_STRING field
+ of struct breakpoint is therefore set to NULL (most of the time, see
+ below).
+
+ At this time, we do not support the use of conditions on Ada exception
+ catchpoints. The COND and COND_STRING fields are therefore also set
+ to NULL (most of the time, see below).
+
+ Conditions where ADDR_STRING, COND, and COND_STRING are used:
+
+ When a user specifies the name of a specific exception in the case
+ of catchpoints on Ada exceptions, we store the name of that exception
+ in the ADDR_STRING. We then translate this request into an actual
+ condition stored in COND_STRING, and then parse it into an expression
+ stored in COND. */
+
+/* Return the name of the function at PC, NULL if could not find it.
+ This function only checks the debugging information, not the symbol
+ table. */
+
+static char *
+function_name_from_pc (CORE_ADDR pc)
+{
+ char *func_name;
+
+ if (!find_pc_partial_function (pc, &func_name, NULL, NULL))
+ return NULL;
+
+ return func_name;
+}
+
+/* True iff FRAME is very likely to be that of a function that is
+ part of the runtime system. This is all very heuristic, but is
+ intended to be used as advice as to what frames are uninteresting
+ to most users. */
+
+static int
+is_known_support_routine (struct frame_info *frame)
+{
+ struct frame_info *next_frame = get_next_frame (frame);
+ /* If frame is not innermost, that normally means that frame->pc
+ points to *after* the call instruction, and we want to get the line
+ containing the call, never the next line. But if the next frame is
+ a signal_handler_caller or a dummy frame, then the next frame was
+ not entered as the result of a call, and we want to get the line
+ containing frame->pc. */
+ const int pc_is_after_call =
+ next_frame != NULL
+ && get_frame_type (next_frame) != SIGTRAMP_FRAME
+ && get_frame_type (next_frame) != DUMMY_FRAME;
+ struct symtab_and_line sal
+ = find_pc_line (get_frame_pc (frame), pc_is_after_call);
+ char *func_name;
+ int i;
+ struct stat st;
+
+ /* The heuristic:
+ 1. The symtab is null (indicating no debugging symbols)
+ 2. The symtab's filename does not exist.
+ 3. The object file's name is one of the standard libraries.
+ 4. The symtab's file name has the form of an Ada library source file.
+ 5. The function at frame's PC has a GNAT-compiler-generated name. */
+
+ if (sal.symtab == NULL)
+ return 1;
+
+ /* On some systems (e.g. VxWorks), the kernel contains debugging
+ symbols; in this case, the filename referenced by these symbols
+ does not exists. */
+
+ if (stat (sal.symtab->filename, &st))
+ return 1;
+
+ for (i = 0; known_runtime_file_name_patterns[i] != NULL; i += 1)
+ {
+ re_comp (known_runtime_file_name_patterns[i]);
+ if (re_exec (sal.symtab->filename))
+ return 1;
+ }
+ if (sal.symtab->objfile != NULL)
+ {
+ for (i = 0; known_runtime_file_name_patterns[i] != NULL; i += 1)
+ {
+ re_comp (known_runtime_file_name_patterns[i]);
+ if (re_exec (sal.symtab->objfile->name))
+ return 1;
+ }
+ }
+
+ /* If the frame PC points after the call instruction, then we need to
+ decrement it in order to search for the function associated to this
+ PC. Otherwise, if the associated call was the last instruction of
+ the function, we might either find the wrong function or even fail
+ during the function name lookup. */
+ if (pc_is_after_call)
+ func_name = function_name_from_pc (get_frame_pc (frame) - 1);
+ else
+ func_name = function_name_from_pc (get_frame_pc (frame));
+
+ if (func_name == NULL)
+ return 1;
+
+ for (i = 0; known_auxiliary_function_name_patterns[i] != NULL; i += 1)
+ {
+ re_comp (known_auxiliary_function_name_patterns[i]);
+ if (re_exec (func_name))
+ return 1;
+ }
+
+ return 0;
+}
+
+/* Find the first frame that contains debugging information and that is not
+ part of the Ada run-time, starting from FI and moving upward. */
+
+static void
+ada_find_printable_frame (struct frame_info *fi)
+{
+ for (; fi != NULL; fi = get_prev_frame (fi))
+ {
+ if (!is_known_support_routine (fi))
+ {
+ select_frame (fi);
+ break;
+ }
+ }
+
+}
+
+/* Assuming that the inferior just triggered an unhandled exception
+ catchpoint, return the address in inferior memory where the name
+ of the exception is stored.
+
+ Return zero if the address could not be computed. */
+
+static CORE_ADDR
+ada_unhandled_exception_name_addr (void)
+{
+ int frame_level;
+ struct frame_info *fi;
+
+ /* To determine the name of this exception, we need to select
+ the frame corresponding to RAISE_SYM_NAME. This frame is
+ at least 3 levels up, so we simply skip the first 3 frames
+ without checking the name of their associated function. */
+ fi = get_current_frame ();
+ for (frame_level = 0; frame_level < 3; frame_level += 1)
+ if (fi != NULL)
+ fi = get_prev_frame (fi);
+
+ while (fi != NULL)
+ {
+ const char *func_name =
+ function_name_from_pc (get_frame_address_in_block (fi));
+ if (func_name != NULL
+ && strcmp (func_name, raise_sym_name) == 0)
+ break; /* We found the frame we were looking for... */
+ fi = get_prev_frame (fi);
+ }
+
+ if (fi == NULL)
+ return 0;
+
+ select_frame (fi);
+ return parse_and_eval_address ("id.full_name");
+}
+
+/* Assuming the inferior just triggered an Ada exception catchpoint
+ (of any type), return the address in inferior memory where the name
+ of the exception is stored, if applicable.
+
+ Return zero if the address could not be computed, or if not relevant. */
+
+static CORE_ADDR
+ada_exception_name_addr_1 (struct breakpoint *b)
+{
+ switch (b->type)
+ {
+ case bp_catch_exception:
+ return (parse_and_eval_address ("e.full_name"));
+ break;
+
+ case bp_catch_unhandled_exception:
+ return ada_unhandled_exception_name_addr ();
+ break;
+
+ case bp_catch_failed_assertion:
+ return 0; /* Exception name is not relevant in this case. */
+ break;
+
+ default:
+ internal_error (__FILE__, __LINE__, _("unexpected breakpoint type"));
+ break;
+ }
+
+ return 0; /* Should never be reached. */
+}
+
+/* Same as ada_exception_name_addr_1, except that it intercepts and contains
+ any error that ada_exception_name_addr_1 might cause to be thrown.
+ When an error is intercepted, a warning with the error message is printed,
+ and zero is returned. */
+
+static CORE_ADDR
+ada_exception_name_addr (struct breakpoint *b)
+{
+ struct gdb_exception e;
+ CORE_ADDR result = 0;
+
+ TRY_CATCH (e, RETURN_MASK_ERROR)
+ {
+ result = ada_exception_name_addr_1 (b);
+ }
+
+ if (e.reason < 0)
+ {
+ warning (_("failed to get exception name: %s"), e.message);
+ return 0;
+ }
+
+ return result;
+}
+
+/* Implement the PRINT_IT method in the breakpoint_ops structure
+ of all exception catchpoint kinds. */
+
+static enum print_stop_action
+print_exception_catchpoint (struct breakpoint *b)
+{
+ const CORE_ADDR addr = ada_exception_name_addr (b);
+ char exception_name[256];
+
+ if (addr != 0)
+ {
+ read_memory (addr, exception_name, sizeof (exception_name) - 1);
+ exception_name [sizeof (exception_name) - 1] = '\0';
+ }
+
+ ada_find_printable_frame (get_current_frame ());
+
+ annotate_catchpoint (b->number);
+ switch (b->type)
+ {
+ case bp_catch_exception:
+ if (addr != 0)
+ printf_filtered (_("\nCatchpoint %d, %s at "),
+ b->number, exception_name);
+ else
+ printf_filtered (_("\nCatchpoint %d, exception at "), b->number);
+ break;
+ case bp_catch_unhandled_exception:
+ if (addr != 0)
+ printf_filtered (_("\nCatchpoint %d, unhandled %s at "),
+ b->number, exception_name);
+ else
+ printf_filtered (_("\nCatchpoint %d, unhandled exception at "),
+ b->number);
+ break;
+ case bp_catch_failed_assertion:
+ printf_filtered (_("\nCatchpoint %d, failed assertion at "),
+ b->number);
+ break;
+ }
+
+ return PRINT_SRC_AND_LOC;
+}
+
+/* Implement the PRINT_ONE method in the breakpoint_ops structure
+ of all exception catchpoint kinds. */
+
+static void
+print_one_exception_catchpoint (struct breakpoint *b, CORE_ADDR *last_addr)
+{
+ if (addressprint)
+ {
+ annotate_field (4);
+ ui_out_field_core_addr (uiout, "addr", b->loc->address);
+ }
+
+ annotate_field (5);
+ *last_addr = b->loc->address;
+ switch (b->type)
+ {
+ case bp_catch_exception:
+ if (b->addr_string != NULL)
+ {
+ const char *template = _("on `%s' Ada exception");
+ char *msg = alloca (strlen (template) + strlen (b->addr_string));
+
+ sprintf (msg, _("on `%s' Ada exception"), b->addr_string);
+ ui_out_field_string (uiout, "what", msg);
+ }
+ else
+ ui_out_field_string (uiout, "what", "on all Ada exceptions");
+
+ break;
+
+ case bp_catch_unhandled_exception:
+ ui_out_field_string (uiout, "what", "on unhandled Ada exceptions");
+ break;
+
+ case bp_catch_failed_assertion:
+ ui_out_field_string (uiout, "what", "on failed Ada assertions");
+ break;
+
+ default:
+ internal_error (__FILE__, __LINE__, _("unexpected breakpoint type"));
+ break;
+ }
+}
+
+/* Implement the PRINT_MENTION method in the breakpoint_ops structure
+ of all exception catchpoint kinds. */
+
+static void
+print_mention_exception_catchpoint (struct breakpoint *b)
+{
+ switch (b->type)
+ {
+ case bp_catch_exception:
+ if (b->addr_string != NULL)
+ printf_filtered (_("Catchpoint %d on `%s' Ada exception at %s"),
+ b->number, b->addr_string,
+ paddress (b->loc->address));
+ else
+ printf_filtered (_("Catchpoint %d on all Ada exceptions at %s"),
+ b->number, paddress (b->loc->address));
+
+ break;
+
+ case bp_catch_unhandled_exception:
+ printf_filtered (_("Catchpoint %d on unhandled Ada exceptions at %s"),
+ b->number, paddress (b->loc->address));
+ break;
+
+ case bp_catch_failed_assertion:
+ printf_filtered (_("Catchpoint %d on failed Ada assertions at %s"),
+ b->number, paddress (b->loc->address));
+ break;
+
+ default:
+ internal_error (__FILE__, __LINE__, _("unexpected breakpoint type"));
+ break;
+ }
+}
+
+/* The struct breakpoint_ops used in all exception catchpoint kinds. */
+
+static struct breakpoint_ops ada_exception_catchpoint_ops = {
+ print_exception_catchpoint,
+ print_one_exception_catchpoint,
+ print_mention_exception_catchpoint
+};
+
+/* Cause the appropriate error if no appropriate runtime symbol is
+ found to set a breakpoint, using ERR_DESC to describe the
+ breakpoint. */
+
+static void
+error_breakpoint_runtime_sym_not_found (const char *err_desc)
+{
+ /* If we are not debugging an Ada program, we cannot put exception
+ catchpoints! */
+
+ if (ada_update_initial_language (language_unknown, NULL) != language_ada)
+ error ("Unable to break on %s. Is this an Ada main program?", err_desc);
+
+ /* If the symbol does not exist, then check that the program is
+ already started, to make sure that shared libraries have been
+ loaded. If it is not started, this may mean that the symbol is
+ in a shared library. */
+
+ if (ptid_get_pid (inferior_ptid) == 0)
+ error ("Unable to break on %s. Try to start the program first.",
+ err_desc);
+
+ /* At this point, we know that we are debugging an Ada program and
+ that the inferior has been started, but we still are not able to
+ find the run-time symbols. That can mean that we are in
+ configurable run time mode, or that a-except as been optimized
+ out by the linker... In any case, at this point it is not worth
+ supporting this feature. */
+
+ error ("Cannot break on %s in this configuration.", err_desc);
+}
+
+/* Return a newly allocated copy of the first space-separated token
+ in ARGSP, and then adjust ARGSP to point immediately after that
+ token.
+
+ Return NULL if ARGPS does not contain any more tokens. */
+
+static char *
+ada_get_next_arg (char **argsp)
+{
+ char *args = *argsp;
+ char *end;
+ char *result;
+
+ /* Skip any leading white space. */
+
+ while (isspace (*args))
+ args++;
+
+ if (args[0] == '\0')
+ return NULL; /* No more arguments. */
+
+ /* Find the end of the current argument. */
+
+ end = args;
+ while (*end != '\0' && !isspace (*end))
+ end++;
+
+ /* Adjust ARGSP to point to the start of the next argument. */
+
+ *argsp = end;
+
+ /* Make a copy of the current argument and return it. */
+
+ result = xmalloc (end - args + 1);
+ strncpy (result, args, end - args);
+ result[end - args] = '\0';
+
+ return result;
+}
+
+/* Split the arguments specified in a "catch exception" command.
+ Set TYPE to the appropriate catchpoint type.
+ Set ADDR_STRING to the name of the specific exception if
+ specified by the user. */
+
+static void
+catch_ada_exception_command_split (char *args, enum bptype *type,
+ char **addr_string)
+{
+ struct cleanup *old_chain = make_cleanup (null_cleanup, NULL);
+ char *exception_name;
+
+ exception_name = ada_get_next_arg (&args);
+ make_cleanup (xfree, exception_name);
+
+ /* Check that we do not have any more arguments. Anything else
+ is unexpected. */
+
+ while (isspace (*args))
+ args++;
+
+ if (args[0] != '\0')
+ error (_("Junk at end of expression"));
+
+ discard_cleanups (old_chain);
+
+ if (exception_name == NULL)
+ {
+ /* Catch all exceptions. */
+ *type = bp_catch_exception;
+ *addr_string = NULL;
+ }
+ else if (strcmp (exception_name, "unhandled") == 0)
+ {
+ /* Catch unhandled exceptions. */
+ *type = bp_catch_unhandled_exception;
+ *addr_string = NULL;
+ }
+ else
+ {
+ /* Catch a specific exception. */
+ *type = bp_catch_exception;
+ *addr_string = exception_name;
+ }
+}
+
+/* Return the condition that will be used to match the current exception
+ being raised with the exception that the user wants to catch. This
+ assumes that this condition is used when the inferior just triggered
+ an exception catchpoint. */
+
+static char *
+ada_exception_catchpoint_cond_string (const char *addr_string)
+{
+ const char cond_prefix[] = "long_integer (e) = long_integer (&";
+ const char cond_postfix[] = ")";
+ char *cond_string = xmalloc (sizeof (cond_prefix) + strlen (addr_string)
+ + sizeof (cond_prefix) + 1);
+
+ sprintf (cond_string, "%s%s%s", cond_prefix, addr_string, cond_postfix);
+
+ return cond_string;
+}
+
+/* Return the expression corresponding to COND_STRING evaluated at SAL. */
+
+static struct expression *
+ada_parse_catchpoint_condition (char *cond_string,
+ struct symtab_and_line sal)
+{
+ return (parse_exp_1 (&cond_string, block_for_pc (sal.pc), 0));
+}
+
+/* Return the symtab_and_line that should be used to insert an exception
+ catchpoint of the TYPE kind.
+
+ ADDR_STRING should contain the name of a specific exception
+ that the catchpoint should catch, or NULL otherwise.
+
+ The idea behind all the remaining parameters is that their name match
+ the name of certain fields in the breakpoint structure that are
+ used to handle exception catchpoints. This function also returns
+ the value to which these fields should be set, depending on the
+ situation. All these parameters may be set to NULL if they are
+ not needed.
+
+ COND_STRING and COND go as a pair. Both must be non-NULL for this
+ function to set them. */
+
+struct symtab_and_line
+ada_exception_sal (enum bptype type, char *addr_string, char **cond_string,
+ struct expression **cond, struct breakpoint_ops **ops)
+{
+ const char *exception_fun;
+ struct symbol *sym;
+ struct symtab_and_line sal;
+
+ /* First lookup the function on which we will break in order to catch
+ the Ada exceptions requested by the user. */
+
+ switch (type)
+ {
+ case bp_catch_exception:
+ exception_fun = raise_sym_name;
+ break;
+ case bp_catch_unhandled_exception:
+ exception_fun = raise_unhandled_sym_name;
+ break;
+ case bp_catch_failed_assertion:
+ exception_fun = raise_assert_sym_name;
+ break;
+ default:
+ internal_error (__FILE__, __LINE__,
+ "unexpected breakpoint type (%d)", type);
+ }
+
+ sym = standard_lookup (exception_fun, NULL, VAR_DOMAIN);
+
+ /* The symbol we're looking up is provided by a unit in the GNAT runtime
+ that should be compiled with debugging information. As a result, we
+ expect to find that symbol in the symtabs. If we don't find it, then
+ the target most likely does not support Ada exceptions, or we cannot
+ insert exception breakpoints yet, because the GNAT runtime hasn't been
+ loaded yet. */
+
+ /* brobecker/2006-12-26: It is conceivable that the runtime was compiled
+ in such a way that no debugging information is produced for the symbol
+ we are looking for. In this case, we could search the minimal symbols
+ as a fall-back mechanism. This would still be operating in degraded
+ mode, however, as we would still be missing the debugging information
+ that is needed in order to extract the name of the exception being
+ raised (this name is printed in the catchpoint message, and is also
+ used when trying to catch a specific exception). We do not handle
+ this case for now. */
+
+ if (sym == NULL)
+ error_breakpoint_runtime_sym_not_found (exception_fun);
+
+ /* Make sure that the symbol we found corresponds to a function. */
+ if (SYMBOL_CLASS (sym) != LOC_BLOCK)
+ error (_("Symbol \"%s\" is not a function (class = %d)"),
+ exception_fun, SYMBOL_CLASS (sym));
+
+ sal = find_function_start_sal (sym, 1);
+
+ /* Set the catchpoint breakpoint ops. */
+
+ if (ops != NULL)
+ *ops = &ada_exception_catchpoint_ops;
+
+ /* Set the COND and COND_STRING (if not NULL). */
+
+ if (cond_string != NULL && cond != NULL)
+ {
+ if (*cond_string != NULL)
+ {
+ xfree (*cond_string);
+ *cond_string = NULL;
+ }
+ if (*cond != NULL)
+ {
+ xfree (*cond);
+ *cond = NULL;
+ }
+ if (addr_string != NULL)
+ {
+ *cond_string = ada_exception_catchpoint_cond_string (addr_string);
+ *cond = ada_parse_catchpoint_condition (*cond_string, sal);
+ }
+ }
+
+ return sal;
+}
+
+/* Parse the arguments (ARGS) of the "catch exception" command.
+
+ Set TYPE to the appropriate exception catchpoint type.
+ If the user asked the catchpoint to catch only a specific
+ exception, then save the exception name in ADDR_STRING.
+
+ See ada_exception_sal for a description of all the remaining
+ function arguments of this function. */
+
+struct symtab_and_line
+ada_decode_exception_location (char *args, enum bptype *type,
+ char **addr_string,
+ char **cond_string, struct expression **cond,
+ struct breakpoint_ops **ops)
+{
+ catch_ada_exception_command_split (args, type, addr_string);
+ return ada_exception_sal (*type, *addr_string, cond_string, cond, ops);
+}
+
/* Information about operators given special treatment in functions
below. */
/* Format: OP_DEFN (<operator>, <operator length>, <# args>, <binop>). */
Index: breakpoint.c
===================================================================
RCS file: /cvs/src/src/gdb/breakpoint.c,v
retrieving revision 1.234
diff -u -p -r1.234 breakpoint.c
--- breakpoint.c 18 Dec 2006 22:10:13 -0000 1.234
+++ breakpoint.c 29 Dec 2006 17:08:15 -0000
@@ -54,6 +54,7 @@
#include "observer.h"
#include "exceptions.h"
#include "memattr.h"
+#include "ada-lang.h"

#include "gdb-events.h"
#include "mi/mi-common.h"
@@ -200,6 +201,7 @@ static void catch_exception_command_1 (e
static void tcatch_command (char *arg, int from_tty);

static void ep_skip_leading_whitespace (char **s);
+static int ep_is_ada_exception_catchpoint (const struct breakpoint *ep);

/* Prototypes for exported functions. */

@@ -673,7 +675,8 @@ read_memory_nobpt (CORE_ADDR memaddr, gd
warning (_("reading through apparently deleted breakpoint #%d?"),
b->owner->number);

- if (b->loc_type != bp_loc_software_breakpoint)
+ if (b->loc_type != bp_loc_software_breakpoint
+ && !ep_is_ada_exception_catchpoint (b->owner))
continue;
if (!b->inserted)
continue;
@@ -1155,6 +1158,28 @@ in which its expression is valid.\n"),
return val;
}

+ else if (ep_is_ada_exception_catchpoint (bpt->owner))
+ {
+ val = target_insert_breakpoint (&bpt->target_info);
+ if (val)
+ {
+ /* Couldn't set breakpoint for some reason. Notify the user
+ but keep the breakpoint enabled. Chances are we can't
+ insert it just yet because the GNAT runtime hasn't been
+ loaded yet. We'll probably succeed later. */
+ fprintf_unfiltered (tmp_error_stream,
+ "Cannot insert catchpoint %d; disabling it.\n",
+ bpt->owner->number);
+ fprintf_filtered (tmp_error_stream,
+ "Error accessing memory address ");
+ deprecated_print_address_numeric (bpt->address, 1, tmp_error_stream);
+ fprintf_filtered (tmp_error_stream, ": %s.\n",
+ safe_strerror (val));
+ }
+ else
+ bpt->inserted = 1;
+ }
+
else if (bpt->owner->type == bp_catch_fork
|| bpt->owner->type == bp_catch_vfork
|| bpt->owner->type == bp_catch_exec)
@@ -1366,7 +1391,8 @@ update_breakpoints_after_exec (void)
}

/* Ditto the exception-handling catchpoints. */
- if ((b->type == bp_catch_catch) || (b->type == bp_catch_throw))
+ if (b->type == bp_catch_catch || b->type == bp_catch_throw
+ || ep_is_ada_exception_catchpoint (b))
{
delete_breakpoint (b);
continue;
@@ -1627,8 +1653,9 @@ remove_breakpoint (struct bp_location *b
return val;
b->inserted = (is == mark_inserted);
}
- else if ((b->owner->type == bp_catch_catch ||
- b->owner->type == bp_catch_throw)
+ else if ((b->owner->type == bp_catch_catch
+ || b->owner->type == bp_catch_throw
+ || ep_is_ada_exception_catchpoint (b->owner))
&& breakpoint_enabled (b->owner)
&& !b->duplicate)
{
@@ -1637,7 +1664,8 @@ remove_breakpoint (struct bp_location *b
return val;
b->inserted = (is == mark_inserted);
}
- else if (ep_is_exception_catchpoint (b->owner)
+ else if ((ep_is_exception_catchpoint (b->owner)
+ || ep_is_ada_exception_catchpoint (b->owner))
&& b->inserted /* sometimes previous insert doesn't happen */
&& breakpoint_enabled (b->owner)
&& !b->duplicate)
@@ -1761,7 +1789,8 @@ breakpoint_here_p (CORE_ADDR pc)
ALL_BP_LOCATIONS (bpt)
{
if (bpt->loc_type != bp_loc_software_breakpoint
- && bpt->loc_type != bp_loc_hardware_breakpoint)
+ && bpt->loc_type != bp_loc_hardware_breakpoint
+ && !ep_is_ada_exception_catchpoint (bpt->owner))
continue;

if ((breakpoint_enabled (bpt->owner)
@@ -1795,7 +1824,8 @@ breakpoint_inserted_here_p (CORE_ADDR pc
ALL_BP_LOCATIONS (bpt)
{
if (bpt->loc_type != bp_loc_software_breakpoint
- && bpt->loc_type != bp_loc_hardware_breakpoint)
+ && bpt->loc_type != bp_loc_hardware_breakpoint
+ && !ep_is_ada_exception_catchpoint (bpt->owner))
continue;

if (bpt->inserted
@@ -1824,7 +1854,8 @@ software_breakpoint_inserted_here_p (COR

ALL_BP_LOCATIONS (bpt)
{
- if (bpt->loc_type != bp_loc_software_breakpoint)
+ if (bpt->loc_type != bp_loc_software_breakpoint
+ && !ep_is_ada_exception_catchpoint (bpt->owner))
continue;

if ((breakpoint_enabled (bpt->owner)
@@ -1858,7 +1889,8 @@ breakpoint_thread_match (CORE_ADDR pc, p
ALL_BP_LOCATIONS (bpt)
{
if (bpt->loc_type != bp_loc_software_breakpoint
- && bpt->loc_type != bp_loc_hardware_breakpoint)
+ && bpt->loc_type != bp_loc_hardware_breakpoint
+ && !ep_is_ada_exception_catchpoint (bpt->owner))
continue;

if ((breakpoint_enabled (bpt->owner)
@@ -1886,13 +1918,14 @@ int
ep_is_catchpoint (struct breakpoint *ep)
{
return
- (ep->type == bp_catch_load)
- || (ep->type == bp_catch_unload)
- || (ep->type == bp_catch_fork)
- || (ep->type == bp_catch_vfork)
- || (ep->type == bp_catch_exec)
- || (ep->type == bp_catch_catch)
- || (ep->type == bp_catch_throw);
+ (ep->type == bp_catch_load
+ || ep->type == bp_catch_unload
+ || ep->type == bp_catch_fork
+ || ep->type == bp_catch_vfork
+ || ep->type == bp_catch_exec
+ || ep->type == bp_catch_catch
+ || ep->type == bp_catch_throw
+ || ep_is_ada_exception_catchpoint (ep));

/* ??rehrauer: Add more kinds here, as are implemented... */
}
@@ -1913,6 +1946,17 @@ ep_is_exception_catchpoint (struct break
|| (ep->type == bp_catch_throw);
}

+/* Return non-zero if EP is an Ada exception catchpoint. */
+
+static int
+ep_is_ada_exception_catchpoint (const struct breakpoint *ep)
+{
+ return
+ (ep->type == bp_catch_exception
+ || ep->type == bp_catch_unhandled_exception
+ || ep->type == bp_catch_failed_assertion);
+}
+
/* Clear a bpstat so that it says we are not at any breakpoint.
Also free any storage that is part of a bpstat. */

@@ -3254,6 +3298,14 @@ bpstat_what (bpstat bs)
else if (bs->stop)
bs_class = bs->print ? bp_noisy : bp_silent;
break;
+ case bp_catch_exception:
+ case bp_catch_unhandled_exception:
+ case bp_catch_failed_assertion:
+ if (!bs->stop)
+ bs_class = bp_nostop;
+ else if (bs->stop)
+ bs_class = bs->print ? bp_noisy : bp_silent;
+ break;
case bp_call_dummy:
/* Make sure the action is stop (silent or noisy),
so infrun.c pops the dummy frame. */
@@ -3315,10 +3367,11 @@ bpstat_get_triggered_catchpoints (bpstat
ep = ep_list->breakpoint_at;
if (ep == NULL)
break;
- if ((ep->type != bp_catch_load) &&
- (ep->type != bp_catch_unload) &&
- (ep->type != bp_catch_catch) &&
- (ep->type != bp_catch_throw))
+ if (ep->type != bp_catch_load
+ && ep->type != bp_catch_unload
+ && ep->type != bp_catch_catch
+ && ep->type != bp_catch_throw
+ && !ep_is_ada_exception_catchpoint (ep))
/* pai: (temp) ADD fork/vfork here!! */
continue;

@@ -3396,7 +3449,10 @@ print_one_breakpoint (struct breakpoint
{bp_catch_vfork, "catch vfork"},
{bp_catch_exec, "catch exec"},
{bp_catch_catch, "catch catch"},
- {bp_catch_throw, "catch throw"}
+ {bp_catch_throw, "catch throw"},
+ {bp_catch_exception, "catch exception"},
+ {bp_catch_unhandled_exception, "catch unhandled exception"},
+ {bp_catch_failed_assertion, "catch failed assertion"}
};

static char *bpdisps[] =
@@ -3620,8 +3676,11 @@ print_one_breakpoint (struct breakpoint
ui_out_text (uiout, "\n");
}

- if (b->cond)
+ if (b->cond && !ep_is_ada_exception_catchpoint (b))
{
+ /* We do not print the condition for Ada exception catchpoints
+ because the condition is an internal implementation detail
+ that we do not want to expose to the user. */
annotate_field (7);
ui_out_text (uiout, "\tstop only if ");
print_expression (b->cond, stb->stream);
@@ -3734,6 +3793,7 @@ user_settable_breakpoint (const struct b
|| b->type == bp_catch_exec
|| b->type == bp_catch_catch
|| b->type == bp_catch_throw
+ || ep_is_ada_exception_catchpoint (b)
|| b->type == bp_hardware_breakpoint
|| b->type == bp_watchpoint
|| b->type == bp_read_watchpoint
@@ -4110,6 +4170,9 @@ allocate_bp_location (struct breakpoint
case bp_overlay_event:
case bp_catch_load:
case bp_catch_unload:
+ case bp_catch_exception:
+ case bp_catch_unhandled_exception:
+ case bp_catch_failed_assertion:
loc->loc_type = bp_loc_software_breakpoint;
break;
case bp_hardware_breakpoint:
@@ -4796,7 +4859,8 @@ disable_watchpoints_before_interactive_c
|| (b->type == bp_hardware_watchpoint)
|| (b->type == bp_read_watchpoint)
|| (b->type == bp_access_watchpoint)
- || ep_is_exception_catchpoint (b))
+ || ep_is_exception_catchpoint (b)
+ || ep_is_ada_exception_catchpoint (b))
&& breakpoint_enabled (b))
{
b->enable_state = bp_call_disabled;
@@ -4816,7 +4880,8 @@ enable_watchpoints_after_interactive_cal
|| (b->type == bp_hardware_watchpoint)
|| (b->type == bp_read_watchpoint)
|| (b->type == bp_access_watchpoint)
- || ep_is_exception_catchpoint (b))
+ || ep_is_exception_catchpoint (b)
+ || ep_is_ada_exception_catchpoint (b))
&& (b->enable_state == bp_call_disabled))
{
b->enable_state = bp_enabled;
@@ -6518,6 +6583,92 @@ catch_exception_command_1 (enum exceptio
warning (_("Unsupported with this platform/compiler combination."));
}

+/* Create a breakpoint struct for Ada exception catchpoints. */
+
+static void
+create_ada_exception_breakpoint (struct symtab_and_line sal,
+ enum bptype type,
+ char *addr_string,
+ char *cond_string,
+ struct expression *cond,
+ struct breakpoint_ops *ops,
+ int tempflag,
+ int from_tty)
+{
+ struct breakpoint *b;
+
+ if (from_tty)
+ {
+ describe_other_breakpoints (sal.pc, sal.section, -1);
+ /* FIXME: brobecker/2006-12-28: Actually, re-implement a special
+ version for exception catchpoints, because two catchpoints
+ used for different exception names will use the same address.
+ In this case, a "breakpoint ... also set at..." warning is
+ unproductive. Besides. the warning phrasing is also a bit
+ inapropriate, we should use the word catchpoint, and tell
+ the user what type of catchpoint it is. The above is good
+ enough for now, though. */
+ }
+
+ b = set_raw_breakpoint (sal, type);
+ set_breakpoint_count (breakpoint_count + 1);
+
+ b->type = type;
+ b->enable_state = bp_enabled;
+ b->disposition = tempflag ? disp_del : disp_donttouch;
+ b->number = breakpoint_count;
+ b->ignore_count = 0;
+ b->cond = cond;
+ b->addr_string = addr_string;
+ b->language = language_ada;
+ b->cond_string = cond_string;
+ b->thread = -1;
+ b->ops = ops;
+ b->from_tty = from_tty;
+
+ mention (b);
+}
+
+/* Implement the "catch exception" command. */
+
+static void
+catch_ada_exception_command (char *arg, int tempflag, int from_tty)
+{
+ struct symtab_and_line sal;
+ enum bptype type;
+ char *addr_string = NULL;
+ char *cond_string = NULL;
+ struct expression *cond = NULL;
+ struct breakpoint_ops *ops = NULL;
+
+ sal = ada_decode_exception_location (arg, &type, &addr_string,
+ &cond_string, &cond, &ops);
+ create_ada_exception_breakpoint (sal, type, addr_string, cond_string, cond,
+ ops, tempflag, from_tty);
+}
+
+/* Implement the "catch assert" command. */
+
+static void
+catch_assert_command (char *arg, int tempflag, int from_tty)
+{
+ struct symtab_and_line sal;
+ struct breakpoint_ops *ops = NULL;
+
+ /* Check that no argument where provided at the end of the command. */
+
+ if (arg != NULL)
+ {
+ ep_skip_leading_whitespace (&arg);
+ if (*arg != '\0')
+ error (_("Junk at end of arguments."));
+ }
+
+ sal = ada_exception_sal (bp_catch_failed_assertion, NULL, NULL, NULL, &ops);
+ create_ada_exception_breakpoint (sal, bp_catch_failed_assertion, NULL,
+ NULL, NULL, ops, tempflag, from_tty);
+}
+
/* Cover routine to allow wrapping target_enable_exception_catchpoints
inside a catch_errors */

@@ -6622,6 +6773,15 @@ catch_command_1 (char *arg, int tempflag
{
error (_("Catch of stop not yet implemented"));
}
+ else if (strncmp (arg1_start, "exception", arg1_length) == 0)
+ {
+ catch_ada_exception_command (arg1_end + 1, tempflag, from_tty);
+ }
+
+ else if (strncmp (arg1_start, "assert", arg1_length) == 0)
+ {
+ catch_assert_command (arg1_end + 1, tempflag, from_tty);
+ }

/* This doesn't appear to be an event name */

@@ -7268,6 +7428,21 @@ breakpoint_re_set_one (void *bint)
/* We needn't really do anything to reset these, since the mask
that requests them is unaffected by e.g., new libraries being
loaded. */
+ case bp_catch_exception:
+ case bp_catch_unhandled_exception:
+ case bp_catch_failed_assertion:
+ {
+ struct symtab_and_line sal =
+ ada_exception_sal (b->type, b->addr_string, &b->cond_string,
+ &b->cond, NULL);
+
+ if (sal.pc != b->loc->address)
+ {
+ b->loc->address = sal.pc;
+ mention (b);
+ }
+ }
+ break;
case bp_catch_fork:
case bp_catch_vfork:
case bp_catch_exec:
@@ -7515,6 +7690,9 @@ disable_command (char *args, int from_tt
case bp_catch_exec:
case bp_catch_catch:
case bp_catch_throw:
+ case bp_catch_exception:
+ case bp_catch_unhandled_exception:
+ case bp_catch_failed_assertion:
case bp_hardware_breakpoint:
case bp_watchpoint:
case bp_hardware_watchpoint:
@@ -7666,6 +7844,9 @@ enable_command (char *args, int from_tty
case bp_catch_exec:
case bp_catch_catch:
case bp_catch_throw:
+ case bp_catch_exception:
+ case bp_catch_unhandled_exception:
+ case bp_catch_failed_assertion:
case bp_hardware_breakpoint:
case bp_watchpoint:
case bp_hardware_watchpoint:
@@ -8128,6 +8309,11 @@ The act of your program's execution stop
C++ exceptions may be caught:\n\
\tcatch throw - all exceptions, when thrown\n\
\tcatch catch - all exceptions, when caught\n\
+Ada exceptions may be caught:\n\
+\tcatch exception - all exceptions, when raised\n\
+\tcatch exception <name> - a particular exception, when raised\n\
+\tcatch exception unhandled - all unhandled exceptions, when raised\n\
+\tcatch assert - all failed assertions, when raised\n\
\n\
Do \"help set follow-fork-mode\" for info on debugging your program\n\
after a fork or vfork is caught.\n\n\
Index: Makefile.in
===================================================================
RCS file: /cvs/src/src/gdb/Makefile.in,v
retrieving revision 1.861
diff -u -p -r1.861 Makefile.in
--- Makefile.in 17 Dec 2006 13:30:43 -0000 1.861
+++ Makefile.in 29 Dec 2006 11:47:45 -0000
@@ -1701,7 +1701,7 @@ ada-lang.o: ada-lang.c $(defs_h) $(gdb_s
$(inferior_h) $(symfile_h) $(objfiles_h) $(breakpoint_h) \
$(gdbcore_h) $(hashtab_h) $(gdb_obstack_h) $(ada_lang_h) \
$(completer_h) $(gdb_stat_h) $(ui_out_h) $(block_h) $(infcall_h) \
- $(dictionary_h) $(exceptions_h)
+ $(dictionary_h) $(exceptions_h) $(annotate_h) $(valprint_h)
ada-typeprint.o: ada-typeprint.c $(defs_h) $(gdb_obstack_h) $(bfd_h) \
$(symtab_h) $(gdbtypes_h) $(expression_h) $(value_h) $(gdbcore_h) \
$(target_h) $(command_h) $(gdbcmd_h) $(language_h) $(demangle_h) \
@@ -1841,7 +1841,7 @@ breakpoint.o: breakpoint.c $(defs_h) $(s
$(objfiles_h) $(source_h) $(linespec_h) $(completer_h) $(gdb_h) \
$(ui_out_h) $(cli_script_h) $(gdb_assert_h) $(block_h) $(solib_h) \
$(solist_h) $(observer_h) $(exceptions_h) $(gdb_events_h) $(mi_common_h) \
- $(memattr_h)
+ $(memattr_h) $(ada_lang_h)
bsd-kvm.o: bsd-kvm.c $(defs_h) $(cli_cmds_h) $(command_h) $(frame_h) \
$(regcache_h) $(target_h) $(value_h) $(gdbcore_h) $(gdb_assert_h) \
$(readline_h) $(bsd_kvm_h)

[-- Attachment #3: foo.adb --]
[-- Type: text/plain, Size: 1186 bytes --]

-- Copyright 2007 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 2 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, write to the Free Software
-- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
-- MA 02110-1301, USA

procedure Foo is
begin

begin
raise Constraint_Error; -- SPOT1
exception
when others =>
null;
end;

begin
raise Program_Error; -- SPOT2
exception
when others =>
null;
end;

begin
pragma Assert (False); -- SPOT3
null;
exception
when others =>
null;
end;

raise Constraint_Error; -- SPOT4

end Foo;

[-- Attachment #4: catch_ex.exp --]
[-- Type: text/plain, Size: 4959 bytes --]

# Copyright 2007 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 2 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, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
# MA 02110-1301, USA

if $tracelevel then {
strace $tracelevel
}

load_lib "ada.exp"

set testdir "catch_ex"
set testfile "${testdir}/foo"
set srcfile ${srcdir}/${subdir}/${testfile}.adb
set binfile ${objdir}/${subdir}/${testfile}

file mkdir ${objdir}/${subdir}/${testdir}
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug additional_flags=-gnata ]] != "" } {
return -1
}

gdb_exit
gdb_start
gdb_reinitialize_dir $srcdir/$subdir
gdb_load ${binfile}

# Some global variables used to simplify the maintenance of some of
# the regular expressions below.
set any_nb "\[0-9\]+"
set any_addr "0x\[0-9a-zA-Z\]+"
set eol "\[\r\n\]+"

set info_break_header "Num.+Type.+Disp.+Enb.+Address.+What"
set catch_exception_info \
"$any_nb.*catch exception.*keep.*y.*$any_addr.*on all Ada exceptions"

####################################
# 1. Try catching all exceptions. #
####################################

if ![runto_main] then {
fail "Cannot run to main, testcase aborted"
return 0
}

gdb_test "catch exception" \
"Catchpoint $any_nb on all Ada exceptions at $any_addr" \
"insert catchpoint on all Ada exceptions"

gdb_test "info break" \
"$info_break_header$eol$catch_exception_info" \
"info break, catch all Ada exceptions"

set catchpoint_msg \
"Catchpoint $any_nb, CONSTRAINT_ERROR at $any_addr in foo \\\(\\\).*at .*foo.adb:$any_nb"
gdb_test "continue" \
"Continuing\.$eol$catchpoint_msg$eol.*SPOT1" \
"continuing to first exception"

set catchpoint_msg \
"Catchpoint $any_nb, PROGRAM_ERROR at $any_addr in foo \\\(\\\).*at .*foo.adb:$any_nb"
gdb_test "continue" \
"Continuing\.$eol$catchpoint_msg$eol.*SPOT2" \
"continuing to second exception"

################################################
# 2. Try catching only some of the exceptions. #
################################################

# Here is the scenario:
# - Restart the debugger from scratch, runto_main
# - We'll catch only "Program_Error"
# We'll catch assertions
# We'll catch unhandled exceptions
# - continue, we should see the first Program_Error exception
# - continue, we should see the failed assertion
# - continue, we should see the unhandled Constrait_Error exception
# - continue, the program exits.

if ![runto_main] then {
fail "Cannot run to main, testcase aborted"
return 0
}

gdb_test "catch exception Program_Error" \
"Catchpoint $any_nb on \`Program_Error' Ada exception at $any_addr" \
"insert catchpoint on Program_Error"

gdb_test "catch assert" \
"Catchpoint $any_nb on failed Ada assertions at $any_addr" \
"insert catchpoint on failed assertions"

gdb_test "catch exception unhandled" \
"Catchpoint $any_nb on unhandled Ada exceptions at $any_addr" \
"insert catchpoint on unhandled exceptions"

set catch_exception_entry \
"$any_nb.*catch exception.*keep.*y.*$any_addr.* \`Program_Error' Ada exception"
set catch_assert_entry \
"$any_nb.*catch failed assertion.*keep.*y.*$any_addr.*on failed Ada assertions"
set catch_unhandled_entry \
"$any_nb.*catch unhandled exception.*keep.*y.*$any_addr.*on unhandled Ada exceptions"

gdb_test "info break" \
"$info_break_header$eol.*$catch_exception_entry$eol$catch_assert_entry$eol$catch_unhandled_entry" \
"info break, catch all Ada exceptions"

set catchpoint_msg \
"Catchpoint $any_nb, PROGRAM_ERROR at $any_addr in foo \\\(\\\).*at .*foo.adb:$any_nb"
gdb_test "continue" \
"Continuing\.$eol$catchpoint_msg$eol.*SPOT2" \
"continuing to Program_Error exception"

set catchpoint_msg \
"Catchpoint $any_nb, failed assertion at $any_addr in foo \\\(\\\).*at .*foo.adb:$any_nb"
gdb_test "continue" \
"Continuing\.$eol$catchpoint_msg$eol.*SPOT3" \
"continuing to Program_Error exception"

set catchpoint_msg \
"Catchpoint $any_nb, unhandled CONSTRAINT_ERROR at $any_addr in foo \\\(\\\).*at .*foo.adb:$any_nb"
gdb_test "continue" \
"Continuing\.$eol$catchpoint_msg$eol.*SPOT4" \
"continuing to Program_Error exception"

gdb_test "continue" \
"Continuing\..*Program exited.*" \
"continuing to program completion"