[RFA/doco] (Ada) provide the exception message when hitting an exception catchpoint

[RFA/doco] (Ada) provide the exception message when hitting an exception catchpoint

[Joel Brobecker]

Hello,

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.

Tested on x86_64-linux, no regression.

Are the NEWS and doc/gdb.texinfo changes OK to commit?

Thank you,
-- 
Joel

---
 gdb/NEWS                              |  5 +++
 gdb/ada-lang.c                        | 81 +++++++++++++++++++++++++++++++++++
 gdb/doc/gdb.texinfo                   |  4 +-
 gdb/testsuite/gdb.ada/catch_ex.exp    |  8 ++--
 gdb/testsuite/gdb.ada/mi_catch_ex.exp | 10 ++---
 gdb/testsuite/gdb.ada/mi_ex_cond.exp  |  2 +-
 6 files changed, 99 insertions(+), 11 deletions(-)

diff --git a/gdb/NEWS b/gdb/NEWS
index dc070fa..5928bd6 100644
--- a/gdb/NEWS
+++ b/gdb/NEWS
@@ -52,6 +52,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 33c4e8e..3265c21 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/gdb.texinfo b/gdb/doc/gdb.texinfo
index 29d4789..430db0f 100644
--- a/gdb/doc/gdb.texinfo
+++ b/gdb/doc/gdb.texinfo
@@ -27183,7 +27183,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/gdb.ada/catch_ex.exp b/gdb/testsuite/gdb.ada/catch_ex.exp
index 5313e77..3797601 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 c9dd616..2ca3b6c 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 78765be..369f155 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"
-- 
2.1.4

Re: [RFA/doco] (Ada) provide the exception message when hitting an exception catchpoint

[Joel Brobecker]

Hi Eli,

Would you have some time to review the doc changes in the patches
below?

Thanks!

On Fri, Nov 17, 2017 at 04:20:46PM -0500, Joel Brobecker wrote:
> Hello,
> 
> 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.
> 
> Tested on x86_64-linux, no regression.
> 
> Are the NEWS and doc/gdb.texinfo changes OK to commit?
> 
> Thank you,
> -- 
> Joel
> 
> ---
>  gdb/NEWS                              |  5 +++
>  gdb/ada-lang.c                        | 81 +++++++++++++++++++++++++++++++++++
>  gdb/doc/gdb.texinfo                   |  4 +-
>  gdb/testsuite/gdb.ada/catch_ex.exp    |  8 ++--
>  gdb/testsuite/gdb.ada/mi_catch_ex.exp | 10 ++---
>  gdb/testsuite/gdb.ada/mi_ex_cond.exp  |  2 +-
>  6 files changed, 99 insertions(+), 11 deletions(-)
> 
> diff --git a/gdb/NEWS b/gdb/NEWS
> index dc070fa..5928bd6 100644
> --- a/gdb/NEWS
> +++ b/gdb/NEWS
> @@ -52,6 +52,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 33c4e8e..3265c21 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/gdb.texinfo b/gdb/doc/gdb.texinfo
> index 29d4789..430db0f 100644
> --- a/gdb/doc/gdb.texinfo
> +++ b/gdb/doc/gdb.texinfo
> @@ -27183,7 +27183,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/gdb.ada/catch_ex.exp b/gdb/testsuite/gdb.ada/catch_ex.exp
> index 5313e77..3797601 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 c9dd616..2ca3b6c 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 78765be..369f155 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"
> -- 
> 2.1.4

-- 
Joel

Re: [RFA/doco] (Ada) provide the exception message when hitting an exception catchpoint

[Eli Zaretskii]

> Date: Fri, 24 Nov 2017 13:32:21 -0800
> From: Joel Brobecker <brobecker@adacore.com>
> Cc: Xavier Roirand <roirand@adacore.com>, gdb-patches@sourceware.org
> 
> > diff --git a/gdb/doc/gdb.texinfo b/gdb/doc/gdb.texinfo
> > index 29d4789..430db0f 100644
> > --- a/gdb/doc/gdb.texinfo
> > +++ b/gdb/doc/gdb.texinfo
> > @@ -27183,7 +27183,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

Two spaces, please.

> > +with an exception message, @value{GDBN} provides that message via
> > +the @code{exception-message} field.

Otherwise, the documentation part is OK.

Thanks.

Re: [RFA/doco] (Ada) provide the exception message when hitting an exception catchpoint

[Joel Brobecker]

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

> > > diff --git a/gdb/doc/gdb.texinfo b/gdb/doc/gdb.texinfo
> > > index 29d4789..430db0f 100644
> > > --- a/gdb/doc/gdb.texinfo
> > > +++ b/gdb/doc/gdb.texinfo
> > > @@ -27183,7 +27183,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
> 
> Two spaces, please.
> 
> > > +with an exception message, @value{GDBN} provides that message via
> > > +the @code{exception-message} field.
> 
> Otherwise, the documentation part is OK.

Thanks Eli! Documentation adjusted as suggested.

I reran the testsuite on x86_64-linux, and pushed the patch.
Attached is what I pushed.

-- 
Joel

[-- Attachment #2: 0001-Ada-provide-the-exception-message-when-hitting-an-ex.patch --]
[-- Type: text/x-diff, Size: 12755 bytes --]

From e547c119d043f2ecffb70452020ab9150d083a91 Mon Sep 17 00:00:00 2001
From: Joel Brobecker <brobecker@adacore.com>
Date: Fri, 24 Nov 2017 17:09:42 -0500
Subject: [PATCH] (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.
---
 gdb/ChangeLog                         |  8 ++++
 gdb/NEWS                              |  5 +++
 gdb/ada-lang.c                        | 81 +++++++++++++++++++++++++++++++++++
 gdb/doc/ChangeLog                     |  6 ++-
 gdb/doc/gdb.texinfo                   |  4 +-
 gdb/testsuite/ChangeLog               |  6 +++
 gdb/testsuite/gdb.ada/catch_ex.exp    |  8 ++--
 gdb/testsuite/gdb.ada/mi_catch_ex.exp | 10 ++---
 gdb/testsuite/gdb.ada/mi_ex_cond.exp  |  2 +-
 9 files changed, 118 insertions(+), 12 deletions(-)

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 48441bdae5..26d5cd3d46 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 b2c96eef41..754ce103bd 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 33c4e8e2fa..3265c211fb 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 79a4025ba3..988b7b8d87 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 f7067464a8..00451d243d 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 f3f11864b8..8f194c4fde 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 5313e77dd7..3797601d12 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 c9dd6161c3..2ca3b6c38f 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 78765be901..369f155f8a 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"
-- 
2.11.0

Re: [RFA/doco] (Ada) provide the exception message when hitting an exception catchpoint

[Pedro Alves]

Hi Joel,

I run the testsuite now to get a fresh baseline, and noticed this regression
compared to a gdb build from a couple weeks ago:

-PASS: gdb.ada/mi_catch_ex.exp: continue until CE caught by all-exceptions catchpoint 
-PASS: gdb.ada/mi_catch_ex.exp: continue until PE caught by all-exceptions catchpoint 
-PASS: gdb.ada/mi_catch_ex.exp: breakpoint at main 
-PASS: gdb.ada/mi_catch_ex.exp: mi runto main 
-PASS: gdb.ada/mi_catch_ex.exp: catch Program_Error 
-PASS: gdb.ada/mi_catch_ex.exp: catch assert failures 
-PASS: gdb.ada/mi_catch_ex.exp: catch unhandled exceptions 
-PASS: gdb.ada/mi_catch_ex.exp: continue to exception catchpoint hit 
-PASS: gdb.ada/mi_catch_ex.exp: continue to assert failure catchpoint hit 
-PASS: gdb.ada/mi_catch_ex.exp: continue to unhandled exception catchpoint hit 
+ERROR: tcl error sourcing /home/pedro/gdb/src/gdb/testsuite/gdb.ada/mi_catch_ex.exp. 
+ERROR: can't read "exception_name(",exception-message="foo\.adb:[0-9]+ explicit raise)": variable isn't array 
+    while executing
+"mi_expect_stop  "breakpoint-hit\",disp=\"keep\",bkptno=\"$any_nb\",exception-name=\"$exception_name(\",exception-message=\"$exception_message)?"  "foo..."
+    (procedure "continue_to_exception" line 17)
+    invoked from within
+"continue_to_exception \
+    "CONSTRAINT_ERROR" "foo\\.adb:$decimal explicit raise" \
+    "continue until CE caught by all-exceptions catchpoint""
+    (file "/home/pedro/gdb/src/gdb/testsuite/gdb.ada/mi_catch_ex.exp" line 106)
+    invoked from within
+"source /home/pedro/gdb/src/gdb/testsuite/gdb.ada/mi_catch_ex.exp"
+    ("uplevel" body line 1)
+    invoked from within
+"uplevel #0 source /home/pedro/gdb/src/gdb/testsuite/gdb.ada/mi_catch_ex.exp"
+    invoked from within
+"catch "uplevel #0 source $test_file_name""

Thanks,
Pedro Alves

Re: [RFA/doco] (Ada) provide the exception message when hitting an exception catchpoint

[Joel Brobecker]

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

> +ERROR: tcl error sourcing /home/pedro/gdb/src/gdb/testsuite/gdb.ada/mi_catch_ex.exp. 
> +ERROR: can't read "exception_name(",exception-message="foo\.adb:[0-9]+ explicit raise)": variable isn't array 
> +    while executing
> +"mi_expect_stop  "breakpoint-hit\",disp=\"keep\",bkptno=\"$any_nb\",exception-name=\"$exception_name(\",exception-message=\"$exception_message)?"  "foo..."
> +    (procedure "continue_to_exception" line 17)
> +    invoked from within
> +"continue_to_exception \
> +    "CONSTRAINT_ERROR" "foo\\.adb:$decimal explicit raise" \
> +    "continue until CE caught by all-exceptions catchpoint""
> +    (file "/home/pedro/gdb/src/gdb/testsuite/gdb.ada/mi_catch_ex.exp" line 106)
> +    invoked from within
> +"source /home/pedro/gdb/src/gdb/testsuite/gdb.ada/mi_catch_ex.exp"
> +    ("uplevel" body line 1)
> +    invoked from within
> +"uplevel #0 source /home/pedro/gdb/src/gdb/testsuite/gdb.ada/mi_catch_ex.exp"
> +    invoked from within
> +"catch "uplevel #0 source $test_file_name""

Grumpf. Sorry about that. I'm not sure why it was working for me
before. I was able to reproduce on a different machine, but noticed
another error in the process. Attached is a tentative patch. It gives
me clean results (15 PASSes). Does it work for you?

gdb/testsuite/ChangeLog:

        * gdb.ada/mi_catch_ex.exp (continue_to_exception): Adjust
        expected output in gdb_expect call to allow the exception
        message to be present as well. Fix syntax confusion to avoid
        TCL thinking that exception_name is an array.

Thanks!
-- 
Joel

[-- Attachment #2: 0001-fix-two-issues-in-gdb.ada-mi_catch_ex.exp-re-excepti.patch --]
[-- Type: text/x-diff, Size: 2625 bytes --]

From 3649f51b60ae1711a2c449f64a1887326ea066c7 Mon Sep 17 00:00:00 2001
From: Joel Brobecker <brobecker@adacore.com>
Date: Fri, 24 Nov 2017 17:48:46 -0800
Subject: [PATCH] fix two issues in gdb.ada/mi_catch_ex.exp (re:
 "exception-message")

The following patch introduced a new feature related to Ada exception
catchpoints:

    commit e547c119d043f2ecffb70452020ab9150d083a91
    Author: Joel Brobecker <brobecker@adacore.com>
    Date:   Fri Nov 24 17:09:42 2017 -0500
    Subject: (Ada) provide the exception message when hitting an exception catchpoint

Unfortunately, the patch left 2 errors in gdb.ada/mi_catch_ex.exp,
both inside the "continue_to_exception" function:

  1. The exception message on the console can include the exception
     message, and thus this patch adjust the expected output in
     the corresponding gdb_expect call to allow it;
     to allow it.

  2. There was a TCL syntax confusion in "$exception_name(..."
     that caused TCL to evaluate "exception_name as an array,
     rather than as a variable. This patch fixes this by escaping
     the '(' (and the corresponding closing parenthesis, for
     consistency).

gdb/testsuite/ChangeLog:

        * gdb.ada/mi_catch_ex.exp (continue_to_exception): Adjust
        expected output in gdb_expect call to allow the exception
        message to be present as well. Fix syntax confusion to avoid
        TCL thinking that exception_name is an array.

Tested on x86_64-linux, with:

    DejaGnu version  1.6
    Expect version   5.45
    Tcl version      8.6
---
 gdb/testsuite/gdb.ada/mi_catch_ex.exp | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/gdb/testsuite/gdb.ada/mi_catch_ex.exp b/gdb/testsuite/gdb.ada/mi_catch_ex.exp
index 2ca3b6c38f..2440be56a9 100644
--- a/gdb/testsuite/gdb.ada/mi_catch_ex.exp
+++ b/gdb/testsuite/gdb.ada/mi_catch_ex.exp
@@ -87,7 +87,7 @@ proc continue_to_exception { exception_name exception_message test } {
 
     # Match console stream output.
     gdb_expect {
-	-re " $exception_name at $hex in foo " {
+	-re " $exception_name\( \\($exception_message\\)\)? at $hex in foo " {
 	}
 	timeout {
 	    fail "$test (timeout)"
@@ -97,7 +97,7 @@ proc continue_to_exception { exception_name exception_message test } {
 
     # Now MI stream output.
     mi_expect_stop \
-	"breakpoint-hit\",disp=\"keep\",bkptno=\"$any_nb\",exception-name=\"$exception_name(\",exception-message=\"$exception_message)?" \
+	"breakpoint-hit\",disp=\"keep\",bkptno=\"$any_nb\",exception-name=\"$exception_name\(\",exception-message=\"$exception_message\)?" \
 	"foo" "" ".*" ".*" \
 	".*" \
 	$test
-- 
2.11.0

Re: [RFA/doco] (Ada) provide the exception message when hitting an exception catchpoint

[Pedro Alves]

On 11/25/2017 02:05 AM, Joel Brobecker wrote:
>> +ERROR: tcl error sourcing /home/pedro/gdb/src/gdb/testsuite/gdb.ada/mi_catch_ex.exp. 
>> +ERROR: can't read "exception_name(",exception-message="foo\.adb:[0-9]+ explicit raise)": variable isn't array 
>> +    while executing
>> +"mi_expect_stop  "breakpoint-hit\",disp=\"keep\",bkptno=\"$any_nb\",exception-name=\"$exception_name(\",exception-message=\"$exception_message)?"  "foo..."
>> +    (procedure "continue_to_exception" line 17)
>> +    invoked from within
>> +"continue_to_exception \
>> +    "CONSTRAINT_ERROR" "foo\\.adb:$decimal explicit raise" \
>> +    "continue until CE caught by all-exceptions catchpoint""
>> +    (file "/home/pedro/gdb/src/gdb/testsuite/gdb.ada/mi_catch_ex.exp" line 106)
>> +    invoked from within
>> +"source /home/pedro/gdb/src/gdb/testsuite/gdb.ada/mi_catch_ex.exp"
>> +    ("uplevel" body line 1)
>> +    invoked from within
>> +"uplevel #0 source /home/pedro/gdb/src/gdb/testsuite/gdb.ada/mi_catch_ex.exp"
>> +    invoked from within
>> +"catch "uplevel #0 source $test_file_name""
> 
> Grumpf. Sorry about that. I'm not sure why it was working for me
> before. I was able to reproduce on a different machine, but noticed
> another error in the process. Attached is a tentative patch. It gives
> me clean results (15 PASSes). Does it work for you?

Yup, works for me.

Thanks,
Pedro Alves

> 
> gdb/testsuite/ChangeLog:
> 
>         * gdb.ada/mi_catch_ex.exp (continue_to_exception): Adjust
>         expected output in gdb_expect call to allow the exception
>         message to be present as well. Fix syntax confusion to avoid
>         TCL thinking that exception_name is an array.
> 

Re: [RFA/doco] (Ada) provide the exception message when hitting an exception catchpoint

[Joel Brobecker]

> > Grumpf. Sorry about that. I'm not sure why it was working for me
> > before. I was able to reproduce on a different machine, but noticed
> > another error in the process. Attached is a tentative patch. It gives
> > me clean results (15 PASSes). Does it work for you?
> 
> Yup, works for me.

Thanks for confirming, Pedro. Now pushed to master.

> > gdb/testsuite/ChangeLog:
> > 
> >         * gdb.ada/mi_catch_ex.exp (continue_to_exception): Adjust
> >         expected output in gdb_expect call to allow the exception
> >         message to be present as well. Fix syntax confusion to avoid
> >         TCL thinking that exception_name is an array.
> > 

-- 
Joel