Re: [PATCH] Fix "catch exception" with dynamic linking

[Joel Brobecker <brobecker at adacore dot com>]

> 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