(Ada) provide the exception message when hitting an exception catchpoint

This patch enhances the debugger to print the exception message, when
available, as part of an exception catchpoint hit notification (both
GDB/CLI and GDB/MI). For instance, with the following code...

    procedure A is
    begin
       raise Constraint_Error with "hello world";
    end A;

... instead of printing...

    Catchpoint 1, CONSTRAINT_ERROR at 0x000000000040245c in a () at a.adb:3

... it now prints:

    Catchpoint 1, CONSTRAINT_ERROR (hello world) at 0x000000000040245c in a ()
                                   ^^^^^^^^^^^^^

This enhancement requires runtime support. If not present, the debugger
just behaves as before.

In GDB/MI mode, if the exception message is available, it is provided
as an extra field named "exception-message" in the catchpoint notification:

    *stopped,bkptno="1",[...],exception-name="CONSTRAINT_ERROR",
       exception-message="hello world",[...]

gdb/ChangeLog:

        * ada-lang.c (ada_exception_message_1, ada_exception_message):
        New functions.
        (print_it_exception): If available, display the exception
        message as well.
        * NEWS: Document new feature.

gdb/doc/ChangeLog:

        * gdb.texinfo (GDB/MI Ada Exception Information): Document
        new "exception-message" field.

gdb/testsuite/ChangeLog:

        * gdb.ada/catch_ex.exp, gdb.ada/mi_catch_ex.exp,
        gdb.ada/mi_ex_cond.exp: Accept optional exception message in
        when hitting an exception catchpoint.

9 files changed, 118 insertions, 12 deletions

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 48441bdae55..26d5cd3d46c 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,11 @@
+2017-11-24  Joel Brobecker  <brobecker@adacore.com>
+
+	* ada-lang.c (ada_exception_message_1, ada_exception_message):
+	New functions.
+	(print_it_exception): If available, display the exception
+	message as well.
+	* NEWS: Document new feature.
+
 2017-11-24  Ulrich Weigand  <uweigand@de.ibm.com>
 
 	* configure.nat <spu-linux>: Add fork-inferior.o to NATDEPFILES.
diff --git a/gdb/NEWS b/gdb/NEWS
index b2c96eef416..754ce103bd1 100644
--- a/gdb/NEWS
+++ b/gdb/NEWS
@@ -86,6 +86,11 @@
      variables that are to be set or unset from GDB.  These variables
      will affect the environment to be passed to the inferior.
 
+* When catching an Ada exception raised with a message, GDB now prints
+  the message in the catchpoint hit notification. In GDB/MI mode, that
+  information is provided as an extra field named "exception-message"
+  in the *stopped notification.
+
 * New remote packets
 
 QEnvironmentHexEncoded
diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index 33c4e8e2fa3..3265c211fba 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -12105,6 +12105,73 @@ ada_exception_name_addr_1 (enum ada_exception_catchpoint_kind ex,
   return 0; /* Should never be reached.  */
 }
 
+/* Assuming the inferior is stopped at an exception catchpoint,
+   return the message which was associated to the exception, if
+   available.  Return NULL if the message could not be retrieved.
+
+   The caller must xfree the string after use.
+
+   Note: The exception message can be associated to an exception
+   either through the use of the Raise_Exception function, or
+   more simply (Ada 2005 and later), via:
+
+       raise Exception_Name with "exception message";
+
+   */
+
+static char *
+ada_exception_message_1 (void)
+{
+  struct value *e_msg_val;
+  char *e_msg = NULL;
+  int e_msg_len;
+  struct cleanup *cleanups;
+
+  /* For runtimes that support this feature, the exception message
+     is passed as an unbounded string argument called "message".  */
+  e_msg_val = parse_and_eval ("message");
+  if (e_msg_val == NULL)
+    return NULL; /* Exception message not supported.  */
+
+  e_msg_val = ada_coerce_to_simple_array (e_msg_val);
+  gdb_assert (e_msg_val != NULL);
+  e_msg_len = TYPE_LENGTH (value_type (e_msg_val));
+
+  /* If the message string is empty, then treat it as if there was
+     no exception message.  */
+  if (e_msg_len <= 0)
+    return NULL;
+
+  e_msg = (char *) xmalloc (e_msg_len + 1);
+  cleanups = make_cleanup (xfree, e_msg);
+  read_memory_string (value_address (e_msg_val), e_msg, e_msg_len + 1);
+  e_msg[e_msg_len] = '\0';
+
+  discard_cleanups (cleanups);
+  return e_msg;
+}
+
+/* Same as ada_exception_message_1, except that all exceptions are
+   contained here (returning NULL instead).  */
+
+static char *
+ada_exception_message (void)
+{
+  char *e_msg = NULL;  /* Avoid a spurious uninitialized warning.  */
+
+  TRY
+    {
+      e_msg = ada_exception_message_1 ();
+    }
+  CATCH (e, RETURN_MASK_ERROR)
+    {
+      e_msg = NULL;
+    }
+  END_CATCH
+
+  return e_msg;
+}
+
 /* 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,
@@ -12340,6 +12407,7 @@ print_it_exception (enum ada_exception_catchpoint_kind ex, bpstat bs)
 {
   struct ui_out *uiout = current_uiout;
   struct breakpoint *b = bs->breakpoint_at;
+  char *exception_message;
 
   annotate_catchpoint (b->number);
 
@@ -12405,6 +12473,19 @@ print_it_exception (enum ada_exception_catchpoint_kind ex, bpstat bs)
 	uiout->text ("failed assertion");
 	break;
     }
+
+  exception_message = ada_exception_message ();
+  if (exception_message != NULL)
+    {
+      struct cleanup *cleanups = make_cleanup (xfree, exception_message);
+
+      uiout->text (" (");
+      uiout->field_string ("exception-message", exception_message);
+      uiout->text (")");
+
+      do_cleanups (cleanups);
+    }
+
   uiout->text (" at ");
   ada_find_printable_frame (get_current_frame ());
 
diff --git a/gdb/doc/ChangeLog b/gdb/doc/ChangeLog
index 79a4025ba34..988b7b8d872 100644
--- a/gdb/doc/ChangeLog
+++ b/gdb/doc/ChangeLog
@@ -1,3 +1,8 @@
+2017-11-24  Joel Brobecker  <brobecker@adacore.com>
+
+	* gdb.texinfo (GDB/MI Ada Exception Information): Document
+	new "exception-message" field.
+
 2017-11-24  Simon Marchi  <simon.marchi@ericsson.com>
 
 	* gdb.texinfo (Memory Map Format): Update gdb-memory-map.dtd.
@@ -12,7 +17,6 @@
 
 	* gdb.texinfo (Requirements): Document use of GNU MPFR.
 
-
 2017-11-16  Phil Muldoon  <pmuldoon@redhat.com>
 
 	* python.texi (Basic Python): Add rbreak documentation.
diff --git a/gdb/doc/gdb.texinfo b/gdb/doc/gdb.texinfo
index f7067464a8b..00451d243d5 100644
--- a/gdb/doc/gdb.texinfo
+++ b/gdb/doc/gdb.texinfo
@@ -27201,7 +27201,9 @@ thread was last seen on.  This field is optional.
 Whenever a @code{*stopped} record is emitted because the program
 stopped after hitting an exception catchpoint (@pxref{Set Catchpoints}),
 @value{GDBN} provides the name of the exception that was raised via
-the @code{exception-name} field.
+the @code{exception-name} field.  Also, for exceptions that were raised
+with an exception message, @value{GDBN} provides that message via
+the @code{exception-message} field.
 
 @c %%%%%%%%%%%%%%%%%%%%%%%%%%%% SECTION %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 @node GDB/MI Simple Examples
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index f3f11864b81..8f194c4fdee 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2017-11-24  Joel Brobecker  <brobecker@adacore.com>
+
+	* gdb.ada/catch_ex.exp, gdb.ada/mi_catch_ex.exp,
+	gdb.ada/mi_ex_cond.exp: Accept optional exception message in
+	when hitting an exception catchpoint.
+
 2017-11-22  Yao Qi  <yao.qi@linaro.org>
 
 	* gdb.base/macscp.exp: Append -g3 to additional_flags for clang.
diff --git a/gdb/testsuite/gdb.ada/catch_ex.exp b/gdb/testsuite/gdb.ada/catch_ex.exp
index 5313e77dd79..3797601d12c 100644
--- a/gdb/testsuite/gdb.ada/catch_ex.exp
+++ b/gdb/testsuite/gdb.ada/catch_ex.exp
@@ -62,13 +62,13 @@ gdb_test "info break" \
          "info break, catch all Ada exceptions"
 
 set catchpoint_msg \
-  "Catchpoint $any_nb, CONSTRAINT_ERROR at $any_addr in foo \\\(\\\).*at .*foo.adb:$any_nb"
+  "Catchpoint $any_nb, CONSTRAINT_ERROR (\\\(foo\\.adb:$decimal explicit raise\\\) )?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"
+  "Catchpoint $any_nb, PROGRAM_ERROR (\\\(foo\\.adb:$decimal explicit raise\\\) )?at $any_addr in foo \\\(\\\).*at .*foo.adb:$any_nb"
 gdb_test "continue" \
          "Continuing\.$eol$catchpoint_msg$eol.*SPOT2" \
          "continuing to second exception"
@@ -116,7 +116,7 @@ gdb_test "info break" \
          "info break, second run"
 
 set catchpoint_msg \
-  "Catchpoint $any_nb, PROGRAM_ERROR at $any_addr in foo \\\(\\\).*at .*foo.adb:$any_nb"
+  "Catchpoint $any_nb, PROGRAM_ERROR (\\\(foo.adb:$decimal explicit raise\\\) )?at $any_addr in foo \\\(\\\).*at .*foo.adb:$any_nb"
 gdb_test "continue" \
          "Continuing\.$eol$catchpoint_msg$eol.*SPOT2" \
          "continuing to Program_Error exception"
@@ -157,7 +157,7 @@ gdb_test "tcatch exception" \
          "Temporary catchpoint $any_nb: all Ada exceptions"
 
 set temp_catchpoint_msg \
-  "Temporary catchpoint $any_nb, CONSTRAINT_ERROR at $any_addr in foo \\\(\\\).*at .*foo.adb:$any_nb"
+  "Temporary catchpoint $any_nb, CONSTRAINT_ERROR (\\\(.*\\\) )?at $any_addr in foo \\\(\\\).*at .*foo.adb:$any_nb"
 gdb_test "continue" \
          "Continuing\.$eol$temp_catchpoint_msg$eol.*SPOT1" \
          "continuing to temporary catchpoint"
diff --git a/gdb/testsuite/gdb.ada/mi_catch_ex.exp b/gdb/testsuite/gdb.ada/mi_catch_ex.exp
index c9dd6161c31..2ca3b6c38fd 100644
--- a/gdb/testsuite/gdb.ada/mi_catch_ex.exp
+++ b/gdb/testsuite/gdb.ada/mi_catch_ex.exp
@@ -80,7 +80,7 @@ mi_gdb_test "-catch-exception" \
 
 # Continue to caught exception.
 
-proc continue_to_exception { exception_name test } {
+proc continue_to_exception { exception_name exception_message test } {
     global hex any_nb
 
     mi_send_resuming_command "exec-continue" "$test"
@@ -97,18 +97,18 @@ proc continue_to_exception { exception_name test } {
 
     # Now MI stream output.
     mi_expect_stop \
-	"breakpoint-hit\",disp=\"keep\",bkptno=\"$any_nb\",exception-name=\"$exception_name" \
+	"breakpoint-hit\",disp=\"keep\",bkptno=\"$any_nb\",exception-name=\"$exception_name(\",exception-message=\"$exception_message)?" \
 	"foo" "" ".*" ".*" \
 	".*" \
 	$test
 }
 
 continue_to_exception \
-    "CONSTRAINT_ERROR" \
+    "CONSTRAINT_ERROR" "foo\\.adb:$decimal explicit raise" \
     "continue until CE caught by all-exceptions catchpoint"
 
 continue_to_exception \
-    "PROGRAM_ERROR" \
+    "PROGRAM_ERROR" "foo\\.adb:$decimal explicit raise" \
     "continue until PE caught by all-exceptions catchpoint"
 
 ################################################
@@ -143,7 +143,7 @@ mi_gdb_test "-catch-exception -u" \
             "catch unhandled exceptions"
 
 mi_execute_to "exec-continue" \
-              "breakpoint-hit\",disp=\"keep\",bkptno=\"$any_nb\",exception-name=\"PROGRAM_ERROR" \
+              "breakpoint-hit\",disp=\"keep\",bkptno=\"$any_nb\",exception-name=\"PROGRAM_ERROR(\",exception-message=\"foo\\.adb:$decimal explicit raise)?" \
               "foo" "" ".*" ".*" \
               ".*" \
               "continue to exception catchpoint hit"
diff --git a/gdb/testsuite/gdb.ada/mi_ex_cond.exp b/gdb/testsuite/gdb.ada/mi_ex_cond.exp
index 78765be9011..369f155f8a7 100644
--- a/gdb/testsuite/gdb.ada/mi_ex_cond.exp
+++ b/gdb/testsuite/gdb.ada/mi_ex_cond.exp
@@ -81,7 +81,7 @@ mi_gdb_test "-catch-exception -c \"i = 2\" -e constraint_error" \
 mi_run_cmd
 
 mi_expect_stop \
-    "breakpoint-hit\",disp=\"keep\",bkptno=\"$any_nb\",exception-name=\"CONSTRAINT_ERROR" \
+    "breakpoint-hit\",disp=\"keep\",bkptno=\"$any_nb\",exception-name=\"CONSTRAINT_ERROR(\",exception-message=\"foo\\.adb:$decimal explicit raise)?" \
     "foo" "" ".*" ".*" \
     ".*" \
     "run to exception catchpoint hit"