Fix "catch exception" with dynamic linking

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-30  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-30  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.

7 files changed, 214 insertions, 5 deletions

diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index 41aae07..8d2601b 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,5 +1,14 @@
 2019-04-30  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.
+
+2019-04-30  Tom Tromey  <tromey@adacore.com>
+
 	PR c++/24470:
 	* gdb.cp/temargs.cc: Add test code from PR.
 
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 0000000..63714a8
--- /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 0000000..3d17dc6
--- /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 0000000..34b06d6
--- /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 0000000..5cef5ec
--- /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 ee9ade1..1345c74 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 25d370e..57866da 100644
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -3832,11 +3832,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