Fix "catch exception" with dynamic linking
Commit Message
When an Ada program is dynamically linked against libgnat, and when
one of the standard exceptions is used, the exception object may be
referenced by the main executable using a copy relocation.
In this situation, a "catch exception" for those exceptions will not
manage to stop. This happens because, under the hood, "catch
exception" creates an expression object that examines the object
addresses -- but in this case, the address will be incorrect.
This patch fixes the problem by arranging for these filter expressions
to examine all the relevant minimal symbols. This way, the object
from libgnat will be found as well.
Tested on x86-64 Fedora 29.
gdb/ChangeLog
2019-04-23 Tom Tromey <tromey@adacore.com>
* ada-lang.c (ada_lookup_simple_minsyms): New function.
(create_excep_cond_exprs): Iterate over program spaces.
(ada_exception_catchpoint_cond_string): Examine all minimal
symbols for exception types.
gdb/testsuite/ChangeLog
2019-04-23 Tom Tromey <tromey@adacore.com>
* lib/ada.exp (find_ada_tool): New proc.
* lib/gdb.exp (gdb_compile_shlib): Allow .o files as inputs.
* gdb.ada/catch_ex_std.exp: New file.
* gdb.ada/catch_ex_std/foo.adb: New file.
* gdb.ada/catch_ex_std/some_package.adb: New file.
* gdb.ada/catch_ex_std/some_package.ads: New file.
---
gdb/ChangeLog | 7 ++
gdb/ada-lang.c | 108 ++++++++++++++----
gdb/testsuite/ChangeLog | 9 ++
gdb/testsuite/gdb.ada/catch_ex_std.exp | 103 +++++++++++++++++
gdb/testsuite/gdb.ada/catch_ex_std/foo.adb | 25 ++++
.../gdb.ada/catch_ex_std/some_package.adb | 21 ++++
.../gdb.ada/catch_ex_std/some_package.ads | 19 +++
gdb/testsuite/lib/ada.exp | 27 +++++
gdb/testsuite/lib/gdb.exp | 15 ++-
9 files changed, 304 insertions(+), 30 deletions(-)
create mode 100644 gdb/testsuite/gdb.ada/catch_ex_std.exp
create mode 100644 gdb/testsuite/gdb.ada/catch_ex_std/foo.adb
create mode 100644 gdb/testsuite/gdb.ada/catch_ex_std/some_package.adb
create mode 100644 gdb/testsuite/gdb.ada/catch_ex_std/some_package.ads
Comments
> When an Ada program is dynamically linked against libgnat, and when
> one of the standard exceptions is used, the exception object may be
> referenced by the main executable using a copy relocation.
>
> In this situation, a "catch exception" for those exceptions will not
> manage to stop. This happens because, under the hood, "catch
> exception" creates an expression object that examines the object
> addresses -- but in this case, the address will be incorrect.
>
> This patch fixes the problem by arranging for these filter expressions
> to examine all the relevant minimal symbols. This way, the object
> from libgnat will be found as well.
>
> Tested on x86-64 Fedora 29.
>
> gdb/ChangeLog
> 2019-04-23 Tom Tromey <tromey@adacore.com>
>
> * ada-lang.c (ada_lookup_simple_minsyms): New function.
> (create_excep_cond_exprs): Iterate over program spaces.
> (ada_exception_catchpoint_cond_string): Examine all minimal
> symbols for exception types.
>
> gdb/testsuite/ChangeLog
> 2019-04-23 Tom Tromey <tromey@adacore.com>
>
> * lib/ada.exp (find_ada_tool): New proc.
> * lib/gdb.exp (gdb_compile_shlib): Allow .o files as inputs.
> * gdb.ada/catch_ex_std.exp: New file.
> * gdb.ada/catch_ex_std/foo.adb: New file.
> * gdb.ada/catch_ex_std/some_package.adb: New file.
> * gdb.ada/catch_ex_std/some_package.ads: New file.
Note that I reviewed this patch internally at AdaCore before
Tom submitted it. The patch looked good to me, but if some
want to double-check the dejagnu part...
Otherwise, good for me!
> ---
> gdb/ChangeLog | 7 ++
> gdb/ada-lang.c | 108 ++++++++++++++----
> gdb/testsuite/ChangeLog | 9 ++
> gdb/testsuite/gdb.ada/catch_ex_std.exp | 103 +++++++++++++++++
> gdb/testsuite/gdb.ada/catch_ex_std/foo.adb | 25 ++++
> .../gdb.ada/catch_ex_std/some_package.adb | 21 ++++
> .../gdb.ada/catch_ex_std/some_package.ads | 19 +++
> gdb/testsuite/lib/ada.exp | 27 +++++
> gdb/testsuite/lib/gdb.exp | 15 ++-
> 9 files changed, 304 insertions(+), 30 deletions(-)
> create mode 100644 gdb/testsuite/gdb.ada/catch_ex_std.exp
> create mode 100644 gdb/testsuite/gdb.ada/catch_ex_std/foo.adb
> create mode 100644 gdb/testsuite/gdb.ada/catch_ex_std/some_package.adb
> create mode 100644 gdb/testsuite/gdb.ada/catch_ex_std/some_package.ads
>
> diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
> index 250ce438b1a..b531e4f60c2 100644
> --- a/gdb/ada-lang.c
> +++ b/gdb/ada-lang.c
> @@ -63,6 +63,7 @@
> #include "common/function-view.h"
> #include "common/byte-vector.h"
> #include <algorithm>
> +#include <map>
>
> /* Define whether or not the C operator '/' truncates towards zero for
> differently signed operands (truncation direction is undefined in C).
> @@ -4949,6 +4950,36 @@ ada_lookup_simple_minsym (const char *name)
> return result;
> }
>
> +/* Return all the bound minimal symbols matching NAME according to Ada
> + decoding rules. Returns an empty vector if there is no such
> + minimal symbol. Names prefixed with "standard__" are handled
> + specially: "standard__" is first stripped off, and only static and
> + global symbols are searched. */
> +
> +static std::vector<struct bound_minimal_symbol>
> +ada_lookup_simple_minsyms (const char *name)
> +{
> + std::vector<struct bound_minimal_symbol> result;
> +
> + symbol_name_match_type match_type = name_match_type_from_name (name);
> + lookup_name_info lookup_name (name, match_type);
> +
> + symbol_name_matcher_ftype *match_name
> + = ada_get_symbol_name_matcher (lookup_name);
> +
> + for (objfile *objfile : current_program_space->objfiles ())
> + {
> + for (minimal_symbol *msymbol : objfile->msymbols ())
> + {
> + if (match_name (MSYMBOL_LINKAGE_NAME (msymbol), lookup_name, NULL)
> + && MSYMBOL_TYPE (msymbol) != mst_solib_trampoline)
> + result.push_back ({msymbol, objfile});
> + }
> + }
> +
> + return result;
> +}
> +
> /* For all subprograms that statically enclose the subprogram of the
> selected frame, add symbols matching identifier NAME in DOMAIN
> and their blocks to the list of data in OBSTACKP, as for
> @@ -12437,8 +12468,6 @@ static void
> create_excep_cond_exprs (struct ada_catchpoint *c,
> enum ada_exception_catchpoint_kind ex)
> {
> - struct bp_location *bl;
> -
> /* Nothing to do if there's no specific exception to catch. */
> if (c->excep_string.empty ())
> return;
> @@ -12447,28 +12476,45 @@ create_excep_cond_exprs (struct ada_catchpoint *c,
> if (c->loc == NULL)
> return;
>
> - /* Compute the condition expression in text form, from the specific
> - expection we want to catch. */
> - std::string cond_string
> - = ada_exception_catchpoint_cond_string (c->excep_string.c_str (), ex);
> + /* We have to compute the expression once for each program space,
> + because the expression may hold the addresses of multiple symbols
> + in some cases. */
> + std::multimap<program_space *, struct bp_location *> loc_map;
> + for (struct bp_location *bl = c->loc; bl != NULL; bl = bl->next)
> + loc_map.emplace (bl->pspace, bl);
> +
> + scoped_restore_current_program_space save_pspace;
>
> - /* Iterate over all the catchpoint's locations, and parse an
> - expression for each. */
> - for (bl = c->loc; bl != NULL; bl = bl->next)
> + std::string cond_string;
> + program_space *last_ps = nullptr;
> + for (auto iter : loc_map)
> {
> struct ada_catchpoint_location *ada_loc
> - = (struct ada_catchpoint_location *) bl;
> + = (struct ada_catchpoint_location *) iter.second;
> +
> + if (ada_loc->pspace != last_ps)
> + {
> + last_ps = ada_loc->pspace;
> + set_current_program_space (last_ps);
> +
> + /* Compute the condition expression in text form, from the
> + specific expection we want to catch. */
> + cond_string
> + = ada_exception_catchpoint_cond_string (c->excep_string.c_str (),
> + ex);
> + }
> +
> expression_up exp;
>
> - if (!bl->shlib_disabled)
> + if (!ada_loc->shlib_disabled)
> {
> const char *s;
>
> s = cond_string.c_str ();
> try
> {
> - exp = parse_exp_1 (&s, bl->address,
> - block_for_pc (bl->address),
> + exp = parse_exp_1 (&s, ada_loc->address,
> + block_for_pc (ada_loc->address),
> 0);
> }
> catch (const gdb_exception_error &e)
> @@ -13130,18 +13176,18 @@ ada_exception_catchpoint_cond_string (const char *excep_string,
> enum ada_exception_catchpoint_kind ex)
> {
> int i;
> - bool is_standard_exc = false;
> std::string result;
> + const char *name;
>
> if (ex == ada_catch_handlers)
> {
> /* For exception handlers catchpoints, the condition string does
> not use the same parameter as for the other exceptions. */
> - result = ("long_integer (GNAT_GCC_exception_Access"
> - "(gcc_exception).all.occurrence.id)");
> + name = ("long_integer (GNAT_GCC_exception_Access"
> + "(gcc_exception).all.occurrence.id)");
> }
> else
> - result = "long_integer (e)";
> + name = "long_integer (e)";
>
> /* The standard exceptions are a special case. They are defined in
> runtime units that have been compiled without debugging info; if
> @@ -13160,23 +13206,35 @@ ada_exception_catchpoint_cond_string (const char *excep_string,
> If an exception named contraint_error is defined in another package of
> the inferior program, then the only way to specify this exception as a
> breakpoint condition is to use its fully-qualified named:
> - e.g. my_package.constraint_error. */
> + e.g. my_package.constraint_error.
> +
> + Furthermore, in some situations a standard exception's symbol may
> + be present in more than one objfile, because the compiler may
> + choose to emit copy relocations for them. So, we have to compare
> + against all the possible addresses. */
>
> + /* Storage for a rewritten symbol name. */
> + std::string std_name;
> for (i = 0; i < sizeof (standard_exc) / sizeof (char *); i++)
> {
> if (strcmp (standard_exc [i], excep_string) == 0)
> {
> - is_standard_exc = true;
> + std_name = std::string ("standard.") + excep_string;
> + excep_string = std_name.c_str ();
> break;
> }
> }
>
> - result += " = ";
> -
> - if (is_standard_exc)
> - string_appendf (result, "long_integer (&standard.%s)", excep_string);
> - else
> - string_appendf (result, "long_integer (&%s)", excep_string);
> + excep_string = ada_encode (excep_string);
> + std::vector<struct bound_minimal_symbol> symbols
> + = ada_lookup_simple_minsyms (excep_string);
> + for (const struct bound_minimal_symbol &msym : symbols)
> + {
> + if (!result.empty ())
> + result += " or ";
> + string_appendf (result, "%s = %s", name,
> + pulongest (BMSYMBOL_VALUE_ADDRESS (msym)));
> + }
>
> return result;
> }
> diff --git a/gdb/testsuite/gdb.ada/catch_ex_std.exp b/gdb/testsuite/gdb.ada/catch_ex_std.exp
> new file mode 100644
> index 00000000000..63714a8aa81
> --- /dev/null
> +++ b/gdb/testsuite/gdb.ada/catch_ex_std.exp
> @@ -0,0 +1,103 @@
> +# Copyright 2019 Free Software Foundation, Inc.
> +#
> +# This program is free software; you can redistribute it and/or modify
> +# it under the terms of the GNU General Public License as published by
> +# the Free Software Foundation; either version 3 of the License, or
> +# (at your option) any later version.
> +#
> +# This program is distributed in the hope that it will be useful,
> +# but WITHOUT ANY WARRANTY; without even the implied warranty of
> +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> +# GNU General Public License for more details.
> +#
> +# You should have received a copy of the GNU General Public License
> +# along with this program. If not, see <http://www.gnu.org/licenses/>.
> +
> +if {[skip_shlib_tests]} {
> + return 0
> +}
> +
> +load_lib "ada.exp"
> +
> +standard_ada_testfile foo
> +
> +set ofile ${binfile}.o
> +
> +set srcfile2 [file join [file dirname $srcfile] some_package.adb]
> +set ofile2 [standard_output_file some_package.o]
> +set sofile [standard_output_file libsome_package.so]
> +
> +set outdir [file dirname $binfile]
> +
> +# To make an Ada shared library we have to jump through a number of
> +# hoops.
> +
> +# First compile to a .o. We can't compile directly to a .so because
> +# GCC rejects that:
> +# $ gcc -g -shared -fPIC -o qqz.o some_package.adb
> +# gcc: error: -c or -S required for Ada
> +# And, we can't compile in "ada" mode because dejagnu will try to
> +# invoke gnatmake, which we don't want.
> +if {[target_compile_ada_from_dir $outdir $srcfile2 $ofile2 \
> + object {debug additional_flags=-fPIC}] != ""} {
> + return -1
> +}
> +
> +# Now turn the .o into a shared library.
> +if {[gdb_compile_shlib $ofile2 $sofile \
> + {debug additional_flags=-fPIC}] != ""} {
> + return -1
> +}
> +
> +# Now we can compile the main program to an object file; but again, we
> +# can't compile directly using gnatmake.
> +if {[target_compile_ada_from_dir $outdir $srcfile $ofile object debug] != ""} {
> + return -1
> +}
> +
> +set gnatbind [find_ada_tool gnatbind]
> +set gnatlink [find_ada_tool gnatlink]
> +
> +with_cwd $outdir {
> + # Bind.
> + set status [remote_exec host "$gnatbind -shared foo"]
> + if {[lindex $status 0] == 0} {
> + pass "gnatbind foo"
> + } else {
> + fail "gnatbind foo"
> + return -1
> + }
> +
> + # Finally, link.
> + if {[istarget "*-*-mingw*"]
> + || [istarget *-*-cygwin*]
> + || [istarget *-*-pe*]
> + || [istarget arm*-*-symbianelf*]} {
> + # Do not need anything.
> + set linkarg ""
> + } elseif {[istarget *-*-freebsd*] || [istarget *-*-openbsd*]} {
> + set linkarg "-Wl,-rpath,$outdir"
> + } else {
> + set linkarg "-Wl,-rpath,\\\$ORIGIN"
> + }
> + set status [remote_exec host "$gnatlink foo $linkarg -Wl,-lsome_package"]
> + if {[lindex $status 0] == 0} {
> + pass "gnatlink foo"
> + } else {
> + fail "gnatlink foo"
> + return -1
> + }
> +}
> +
> +clean_restart ${testfile}
> +
> +if {![runto_main]} then {
> + return 0
> +}
> +
> +gdb_test "catch exception some_kind_of_error" \
> + "Catchpoint \[0-9\]+: `some_kind_of_error' Ada exception"
> +
> +gdb_test "cont" \
> + "Catchpoint \[0-9\]+, .* at .*foo\.adb:\[0-9\]+.*" \
> + "caught the exception"
> diff --git a/gdb/testsuite/gdb.ada/catch_ex_std/foo.adb b/gdb/testsuite/gdb.ada/catch_ex_std/foo.adb
> new file mode 100644
> index 00000000000..3d17dc65ed8
> --- /dev/null
> +++ b/gdb/testsuite/gdb.ada/catch_ex_std/foo.adb
> @@ -0,0 +1,25 @@
> +-- Copyright 2019 Free Software Foundation, Inc.
> +--
> +-- This program is free software; you can redistribute it and/or modify
> +-- it under the terms of the GNU General Public License as published by
> +-- the Free Software Foundation; either version 3 of the License, or
> +-- (at your option) any later version.
> +--
> +-- This program is distributed in the hope that it will be useful,
> +-- but WITHOUT ANY WARRANTY; without even the implied warranty of
> +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> +-- GNU General Public License for more details.
> +--
> +-- You should have received a copy of the GNU General Public License
> +-- along with this program. If not, see <http://www.gnu.org/licenses/>.
> +
> +with Some_Package;
> +
> +procedure Foo is
> + Some_Val : Integer := 0;
> +begin
> + Some_Package.Do_Something (Some_Val);
> + if Some_Val = 1 then
> + raise Some_Package.Some_Kind_Of_Error;
> + end if;
> +end Foo;
> diff --git a/gdb/testsuite/gdb.ada/catch_ex_std/some_package.adb b/gdb/testsuite/gdb.ada/catch_ex_std/some_package.adb
> new file mode 100644
> index 00000000000..34b06d6ddfa
> --- /dev/null
> +++ b/gdb/testsuite/gdb.ada/catch_ex_std/some_package.adb
> @@ -0,0 +1,21 @@
> +-- Copyright 2019 Free Software Foundation, Inc.
> +--
> +-- This program is free software; you can redistribute it and/or modify
> +-- it under the terms of the GNU General Public License as published by
> +-- the Free Software Foundation; either version 3 of the License, or
> +-- (at your option) any later version.
> +--
> +-- This program is distributed in the hope that it will be useful,
> +-- but WITHOUT ANY WARRANTY; without even the implied warranty of
> +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> +-- GNU General Public License for more details.
> +--
> +-- You should have received a copy of the GNU General Public License
> +-- along with this program. If not, see <http://www.gnu.org/licenses/>.
> +
> +package body Some_Package is
> + procedure Do_Something (I : in out Integer) is
> + begin
> + I := I + 1;
> + end Do_Something;
> +end Some_Package;
> diff --git a/gdb/testsuite/gdb.ada/catch_ex_std/some_package.ads b/gdb/testsuite/gdb.ada/catch_ex_std/some_package.ads
> new file mode 100644
> index 00000000000..5cef5ec6627
> --- /dev/null
> +++ b/gdb/testsuite/gdb.ada/catch_ex_std/some_package.ads
> @@ -0,0 +1,19 @@
> +-- Copyright 2019 Free Software Foundation, Inc.
> +--
> +-- This program is free software; you can redistribute it and/or modify
> +-- it under the terms of the GNU General Public License as published by
> +-- the Free Software Foundation; either version 3 of the License, or
> +-- (at your option) any later version.
> +--
> +-- This program is distributed in the hope that it will be useful,
> +-- but WITHOUT ANY WARRANTY; without even the implied warranty of
> +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> +-- GNU General Public License for more details.
> +--
> +-- You should have received a copy of the GNU General Public License
> +-- along with this program. If not, see <http://www.gnu.org/licenses/>.
> +
> +package Some_Package is
> + Some_Kind_Of_Error : Exception;
> + procedure Do_Something (I : in out Integer);
> +end Some_Package;
> diff --git a/gdb/testsuite/lib/ada.exp b/gdb/testsuite/lib/ada.exp
> index ee9ade16ae5..1345c747c5e 100644
> --- a/gdb/testsuite/lib/ada.exp
> +++ b/gdb/testsuite/lib/ada.exp
> @@ -78,3 +78,30 @@ proc standard_ada_testfile {base_file {dir ""}} {
> set srcfile $srcdir/$subdir/$testdir/$testfile.adb
> set binfile [standard_output_file $testfile]
> }
> +
> +# A helper function to find the appropriate version of a tool.
> +# TOOL is the tool's name, e.g., "gnatbind" or "gnatlink".
> +
> +proc find_ada_tool {tool} {
> + set upper [string toupper $tool]
> +
> + set targname ${upper}_FOR_TARGET
> + global $targname
> + if {[info exists $targname]} {
> + return $targname
> + }
> +
> + global tool_root_dir
> + set root "$tool_root_dir/gcc"
> + set result ""
> +
> + if {![is_remote host]} {
> + set result [lookfor_file $root $tool]
> + }
> +
> + if {$result == ""} {
> + set result [transform $tool]
> + }
> +
> + return $result
> +}
> diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
> index 1176fdded14..b91700d1d5d 100644
> --- a/gdb/testsuite/lib/gdb.exp
> +++ b/gdb/testsuite/lib/gdb.exp
> @@ -3801,11 +3801,16 @@ proc gdb_compile_shlib {sources dest options} {
> set outdir [file dirname $dest]
> set objects ""
> foreach source $sources {
> - set sourcebase [file tail $source]
> - if {[gdb_compile $source "${outdir}/${sourcebase}.o" object $obj_options] != ""} {
> - return -1
> - }
> - lappend objects ${outdir}/${sourcebase}.o
> + set sourcebase [file tail $source]
> + if {[file extension $source] == ".o"} {
> + # Already a .o file.
> + lappend objects $source
> + } elseif {[gdb_compile $source "${outdir}/${sourcebase}.o" object \
> + $obj_options] != ""} {
> + return -1
> + } else {
> + lappend objects ${outdir}/${sourcebase}.o
> + }
> }
>
> set link_options $options
> --
> 2.20.1
>>>>> "Joel" == Joel Brobecker <brobecker@adacore.com> writes:
>> gdb/ChangeLog
>> 2019-04-23 Tom Tromey <tromey@adacore.com>
>>
>> * ada-lang.c (ada_lookup_simple_minsyms): New function.
>> (create_excep_cond_exprs): Iterate over program spaces.
>> (ada_exception_catchpoint_cond_string): Examine all minimal
>> symbols for exception types.
>>
>> gdb/testsuite/ChangeLog
>> 2019-04-23 Tom Tromey <tromey@adacore.com>
>>
>> * lib/ada.exp (find_ada_tool): New proc.
>> * lib/gdb.exp (gdb_compile_shlib): Allow .o files as inputs.
>> * gdb.ada/catch_ex_std.exp: New file.
>> * gdb.ada/catch_ex_std/foo.adb: New file.
>> * gdb.ada/catch_ex_std/some_package.adb: New file.
>> * gdb.ada/catch_ex_std/some_package.ads: New file.
Joel> Note that I reviewed this patch internally at AdaCore before
Joel> Tom submitted it. The patch looked good to me, but if some
Joel> want to double-check the dejagnu part...
I'm going to check it in; if anyone raises issues with that code, I will
write a fix.
Tom
On 30-04-19 15:31, Tom Tromey wrote:
>>>>>> "Joel" == Joel Brobecker <brobecker@adacore.com> writes:
>
>>> gdb/ChangeLog
>>> 2019-04-23 Tom Tromey <tromey@adacore.com>
>>>
>>> * ada-lang.c (ada_lookup_simple_minsyms): New function.
>>> (create_excep_cond_exprs): Iterate over program spaces.
>>> (ada_exception_catchpoint_cond_string): Examine all minimal
>>> symbols for exception types.
>>>
>>> gdb/testsuite/ChangeLog
>>> 2019-04-23 Tom Tromey <tromey@adacore.com>
>>>
>>> * lib/ada.exp (find_ada_tool): New proc.
>>> * lib/gdb.exp (gdb_compile_shlib): Allow .o files as inputs.
>>> * gdb.ada/catch_ex_std.exp: New file.
>>> * gdb.ada/catch_ex_std/foo.adb: New file.
>>> * gdb.ada/catch_ex_std/some_package.adb: New file.
>>> * gdb.ada/catch_ex_std/some_package.ads: New file.
>
> Joel> Note that I reviewed this patch internally at AdaCore before
> Joel> Tom submitted it. The patch looked good to me, but if some
> Joel> want to double-check the dejagnu part...
>
> I'm going to check it in; if anyone raises issues with that code, I will
> write a fix.
I'm seeing:
...
FAIL: gdb.ada/catch_ex_std.exp: catch exception some_kind_of_error
FAIL: gdb.ada/catch_ex_std.exp: caught the exception (the program exited)
...
on openSUSE leap 15.0 with gcc 7.4.0.
More specifically:
...
(gdb) break main^M
Breakpoint 1 at 0x401599: file
/data/gdb_versions/devel/build/gdb/testsuite/outputs/gdb.ada/catch_ex_std/b~foo.adb,
line 132.^M
(gdb) run ^M
Starting program:
/data/gdb_versions/devel/build/gdb/testsuite/outputs/gdb.ada/catch_ex_std/foo
^M
^M
Breakpoint 1, main (argc=1, argv=0x7fffffffc0e8, envp=0x7fffffffc0f8) at
/data/gdb_versions/devel/build/gdb/testsuite/outputs/gdb.ada/catch_ex_std/b~foo.adb:132^M
132
/data/gdb_versions/devel/build/gdb/testsuite/outputs/gdb.ada/catch_ex_std/b~foo.adb:
No such file or directory.^M
(gdb) catch exception some_kind_of_error^M
Your Ada runtime appears to be missing some debugging information.^M
Cannot insert Ada exception catchpoint in this configuration.^M
(gdb) FAIL: gdb.ada/catch_ex_std.exp: catch exception some_kind_of_error
cont^M
Continuing.^M
^M
raised SOME_PACKAGE.SOME_KIND_OF_ERROR : foo.adb:23^M
[Inferior 1 (process 22811) exited with code 01]^M
(gdb) FAIL: gdb.ada/catch_ex_std.exp: caught the exception (the program
exited)
...
Thanks,
- Tom
>>>>> "Tom" == Tom de Vries <tdevries@suse.de> writes:
Tom> FAIL: gdb.ada/catch_ex_std.exp: catch exception some_kind_of_error
Tom> FAIL: gdb.ada/catch_ex_std.exp: caught the exception (the program exited)
Does it happen for gdb.ada/catch_ex.exp as well?
I had to install the gnat debuginfo to make these tests work with the
Fedora gcc.
We could do better here, I suppose, by checking for these messages and
xfailing.
Tom
On 01-05-19 16:44, Tom Tromey wrote:
>>>>>> "Tom" == Tom de Vries <tdevries@suse.de> writes:
>
> Tom> FAIL: gdb.ada/catch_ex_std.exp: catch exception some_kind_of_error
> Tom> FAIL: gdb.ada/catch_ex_std.exp: caught the exception (the program exited)
>
> Does it happen for gdb.ada/catch_ex.exp as well?
>
No, that one passes just fine.
In particular, there we're able to find the file related to main:
...
Starting program:
/data/gdb_versions/devel/build/gdb/testsuite/outputs/gdb.ada/catch_ex/foo ^M
^M
Breakpoint 1, main (argc=1, argv=0x7fffffffc0c8, envp=0x7fffffffc0d8) at
/data/gdb_versions/devel/build/gdb/testsuite/outputs/gdb.ada/catch_ex/b~foo.adb:132^M
132 Ensure_Reference : aliased System.Address :=
Ada_Main_Program_Name'Address;^M
...
while that's not the case for catch_ex_std.exp.
> I had to install the gnat debuginfo to make these tests work with the
> Fedora gcc.
>
I've installed gcc7-ada-debuginfo and libada7-debuginfo, but that didn't
help.
Thanks,
- Tom
> We could do better here, I suppose, by checking for these messages and
> xfailing.
>
> Tom
>
@@ -63,6 +63,7 @@
#include "common/function-view.h"
#include "common/byte-vector.h"
#include <algorithm>
+#include <map>
/* Define whether or not the C operator '/' truncates towards zero for
differently signed operands (truncation direction is undefined in C).
@@ -4949,6 +4950,36 @@ ada_lookup_simple_minsym (const char *name)
return result;
}
+/* Return all the bound minimal symbols matching NAME according to Ada
+ decoding rules. Returns an empty vector if there is no such
+ minimal symbol. Names prefixed with "standard__" are handled
+ specially: "standard__" is first stripped off, and only static and
+ global symbols are searched. */
+
+static std::vector<struct bound_minimal_symbol>
+ada_lookup_simple_minsyms (const char *name)
+{
+ std::vector<struct bound_minimal_symbol> result;
+
+ symbol_name_match_type match_type = name_match_type_from_name (name);
+ lookup_name_info lookup_name (name, match_type);
+
+ symbol_name_matcher_ftype *match_name
+ = ada_get_symbol_name_matcher (lookup_name);
+
+ for (objfile *objfile : current_program_space->objfiles ())
+ {
+ for (minimal_symbol *msymbol : objfile->msymbols ())
+ {
+ if (match_name (MSYMBOL_LINKAGE_NAME (msymbol), lookup_name, NULL)
+ && MSYMBOL_TYPE (msymbol) != mst_solib_trampoline)
+ result.push_back ({msymbol, objfile});
+ }
+ }
+
+ return result;
+}
+
/* For all subprograms that statically enclose the subprogram of the
selected frame, add symbols matching identifier NAME in DOMAIN
and their blocks to the list of data in OBSTACKP, as for
@@ -12437,8 +12468,6 @@ static void
create_excep_cond_exprs (struct ada_catchpoint *c,
enum ada_exception_catchpoint_kind ex)
{
- struct bp_location *bl;
-
/* Nothing to do if there's no specific exception to catch. */
if (c->excep_string.empty ())
return;
@@ -12447,28 +12476,45 @@ create_excep_cond_exprs (struct ada_catchpoint *c,
if (c->loc == NULL)
return;
- /* Compute the condition expression in text form, from the specific
- expection we want to catch. */
- std::string cond_string
- = ada_exception_catchpoint_cond_string (c->excep_string.c_str (), ex);
+ /* We have to compute the expression once for each program space,
+ because the expression may hold the addresses of multiple symbols
+ in some cases. */
+ std::multimap<program_space *, struct bp_location *> loc_map;
+ for (struct bp_location *bl = c->loc; bl != NULL; bl = bl->next)
+ loc_map.emplace (bl->pspace, bl);
+
+ scoped_restore_current_program_space save_pspace;
- /* Iterate over all the catchpoint's locations, and parse an
- expression for each. */
- for (bl = c->loc; bl != NULL; bl = bl->next)
+ std::string cond_string;
+ program_space *last_ps = nullptr;
+ for (auto iter : loc_map)
{
struct ada_catchpoint_location *ada_loc
- = (struct ada_catchpoint_location *) bl;
+ = (struct ada_catchpoint_location *) iter.second;
+
+ if (ada_loc->pspace != last_ps)
+ {
+ last_ps = ada_loc->pspace;
+ set_current_program_space (last_ps);
+
+ /* Compute the condition expression in text form, from the
+ specific expection we want to catch. */
+ cond_string
+ = ada_exception_catchpoint_cond_string (c->excep_string.c_str (),
+ ex);
+ }
+
expression_up exp;
- if (!bl->shlib_disabled)
+ if (!ada_loc->shlib_disabled)
{
const char *s;
s = cond_string.c_str ();
try
{
- exp = parse_exp_1 (&s, bl->address,
- block_for_pc (bl->address),
+ exp = parse_exp_1 (&s, ada_loc->address,
+ block_for_pc (ada_loc->address),
0);
}
catch (const gdb_exception_error &e)
@@ -13130,18 +13176,18 @@ ada_exception_catchpoint_cond_string (const char *excep_string,
enum ada_exception_catchpoint_kind ex)
{
int i;
- bool is_standard_exc = false;
std::string result;
+ const char *name;
if (ex == ada_catch_handlers)
{
/* For exception handlers catchpoints, the condition string does
not use the same parameter as for the other exceptions. */
- result = ("long_integer (GNAT_GCC_exception_Access"
- "(gcc_exception).all.occurrence.id)");
+ name = ("long_integer (GNAT_GCC_exception_Access"
+ "(gcc_exception).all.occurrence.id)");
}
else
- result = "long_integer (e)";
+ name = "long_integer (e)";
/* The standard exceptions are a special case. They are defined in
runtime units that have been compiled without debugging info; if
@@ -13160,23 +13206,35 @@ ada_exception_catchpoint_cond_string (const char *excep_string,
If an exception named contraint_error is defined in another package of
the inferior program, then the only way to specify this exception as a
breakpoint condition is to use its fully-qualified named:
- e.g. my_package.constraint_error. */
+ e.g. my_package.constraint_error.
+
+ Furthermore, in some situations a standard exception's symbol may
+ be present in more than one objfile, because the compiler may
+ choose to emit copy relocations for them. So, we have to compare
+ against all the possible addresses. */
+ /* Storage for a rewritten symbol name. */
+ std::string std_name;
for (i = 0; i < sizeof (standard_exc) / sizeof (char *); i++)
{
if (strcmp (standard_exc [i], excep_string) == 0)
{
- is_standard_exc = true;
+ std_name = std::string ("standard.") + excep_string;
+ excep_string = std_name.c_str ();
break;
}
}
- result += " = ";
-
- if (is_standard_exc)
- string_appendf (result, "long_integer (&standard.%s)", excep_string);
- else
- string_appendf (result, "long_integer (&%s)", excep_string);
+ excep_string = ada_encode (excep_string);
+ std::vector<struct bound_minimal_symbol> symbols
+ = ada_lookup_simple_minsyms (excep_string);
+ for (const struct bound_minimal_symbol &msym : symbols)
+ {
+ if (!result.empty ())
+ result += " or ";
+ string_appendf (result, "%s = %s", name,
+ pulongest (BMSYMBOL_VALUE_ADDRESS (msym)));
+ }
return result;
}
new file mode 100644
@@ -0,0 +1,103 @@
+# Copyright 2019 Free Software Foundation, Inc.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+if {[skip_shlib_tests]} {
+ return 0
+}
+
+load_lib "ada.exp"
+
+standard_ada_testfile foo
+
+set ofile ${binfile}.o
+
+set srcfile2 [file join [file dirname $srcfile] some_package.adb]
+set ofile2 [standard_output_file some_package.o]
+set sofile [standard_output_file libsome_package.so]
+
+set outdir [file dirname $binfile]
+
+# To make an Ada shared library we have to jump through a number of
+# hoops.
+
+# First compile to a .o. We can't compile directly to a .so because
+# GCC rejects that:
+# $ gcc -g -shared -fPIC -o qqz.o some_package.adb
+# gcc: error: -c or -S required for Ada
+# And, we can't compile in "ada" mode because dejagnu will try to
+# invoke gnatmake, which we don't want.
+if {[target_compile_ada_from_dir $outdir $srcfile2 $ofile2 \
+ object {debug additional_flags=-fPIC}] != ""} {
+ return -1
+}
+
+# Now turn the .o into a shared library.
+if {[gdb_compile_shlib $ofile2 $sofile \
+ {debug additional_flags=-fPIC}] != ""} {
+ return -1
+}
+
+# Now we can compile the main program to an object file; but again, we
+# can't compile directly using gnatmake.
+if {[target_compile_ada_from_dir $outdir $srcfile $ofile object debug] != ""} {
+ return -1
+}
+
+set gnatbind [find_ada_tool gnatbind]
+set gnatlink [find_ada_tool gnatlink]
+
+with_cwd $outdir {
+ # Bind.
+ set status [remote_exec host "$gnatbind -shared foo"]
+ if {[lindex $status 0] == 0} {
+ pass "gnatbind foo"
+ } else {
+ fail "gnatbind foo"
+ return -1
+ }
+
+ # Finally, link.
+ if {[istarget "*-*-mingw*"]
+ || [istarget *-*-cygwin*]
+ || [istarget *-*-pe*]
+ || [istarget arm*-*-symbianelf*]} {
+ # Do not need anything.
+ set linkarg ""
+ } elseif {[istarget *-*-freebsd*] || [istarget *-*-openbsd*]} {
+ set linkarg "-Wl,-rpath,$outdir"
+ } else {
+ set linkarg "-Wl,-rpath,\\\$ORIGIN"
+ }
+ set status [remote_exec host "$gnatlink foo $linkarg -Wl,-lsome_package"]
+ if {[lindex $status 0] == 0} {
+ pass "gnatlink foo"
+ } else {
+ fail "gnatlink foo"
+ return -1
+ }
+}
+
+clean_restart ${testfile}
+
+if {![runto_main]} then {
+ return 0
+}
+
+gdb_test "catch exception some_kind_of_error" \
+ "Catchpoint \[0-9\]+: `some_kind_of_error' Ada exception"
+
+gdb_test "cont" \
+ "Catchpoint \[0-9\]+, .* at .*foo\.adb:\[0-9\]+.*" \
+ "caught the exception"
new file mode 100644
@@ -0,0 +1,25 @@
+-- Copyright 2019 Free Software Foundation, Inc.
+--
+-- This program is free software; you can redistribute it and/or modify
+-- it under the terms of the GNU General Public License as published by
+-- the Free Software Foundation; either version 3 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+-- GNU General Public License for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+with Some_Package;
+
+procedure Foo is
+ Some_Val : Integer := 0;
+begin
+ Some_Package.Do_Something (Some_Val);
+ if Some_Val = 1 then
+ raise Some_Package.Some_Kind_Of_Error;
+ end if;
+end Foo;
new file mode 100644
@@ -0,0 +1,21 @@
+-- Copyright 2019 Free Software Foundation, Inc.
+--
+-- This program is free software; you can redistribute it and/or modify
+-- it under the terms of the GNU General Public License as published by
+-- the Free Software Foundation; either version 3 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+-- GNU General Public License for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+package body Some_Package is
+ procedure Do_Something (I : in out Integer) is
+ begin
+ I := I + 1;
+ end Do_Something;
+end Some_Package;
new file mode 100644
@@ -0,0 +1,19 @@
+-- Copyright 2019 Free Software Foundation, Inc.
+--
+-- This program is free software; you can redistribute it and/or modify
+-- it under the terms of the GNU General Public License as published by
+-- the Free Software Foundation; either version 3 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+-- GNU General Public License for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+package Some_Package is
+ Some_Kind_Of_Error : Exception;
+ procedure Do_Something (I : in out Integer);
+end Some_Package;
@@ -78,3 +78,30 @@ proc standard_ada_testfile {base_file {dir ""}} {
set srcfile $srcdir/$subdir/$testdir/$testfile.adb
set binfile [standard_output_file $testfile]
}
+
+# A helper function to find the appropriate version of a tool.
+# TOOL is the tool's name, e.g., "gnatbind" or "gnatlink".
+
+proc find_ada_tool {tool} {
+ set upper [string toupper $tool]
+
+ set targname ${upper}_FOR_TARGET
+ global $targname
+ if {[info exists $targname]} {
+ return $targname
+ }
+
+ global tool_root_dir
+ set root "$tool_root_dir/gcc"
+ set result ""
+
+ if {![is_remote host]} {
+ set result [lookfor_file $root $tool]
+ }
+
+ if {$result == ""} {
+ set result [transform $tool]
+ }
+
+ return $result
+}
@@ -3801,11 +3801,16 @@ proc gdb_compile_shlib {sources dest options} {
set outdir [file dirname $dest]
set objects ""
foreach source $sources {
- set sourcebase [file tail $source]
- if {[gdb_compile $source "${outdir}/${sourcebase}.o" object $obj_options] != ""} {
- return -1
- }
- lappend objects ${outdir}/${sourcebase}.o
+ set sourcebase [file tail $source]
+ if {[file extension $source] == ".o"} {
+ # Already a .o file.
+ lappend objects $source
+ } elseif {[gdb_compile $source "${outdir}/${sourcebase}.o" object \
+ $obj_options] != ""} {
+ return -1
+ } else {
+ lappend objects ${outdir}/${sourcebase}.o
+ }
}
set link_options $options