# Copyright 2019-2020 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 . if {[skip_shlib_tests]} { return 0 } load_lib "ada.exp" if { [skip_ada_tests] } { return -1 } 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 { # Test if gnatbind is supported set status [remote_exec host "$gnatbind --version"] if {[lindex $status 0] == -1} { unsupported "gnatbind foo" return -1 } # Bind. set status [remote_exec host "$gnatbind -shared foo"] if {[lindex $status 0] == 0} { pass "gnatbind foo" } else { fail "gnatbind foo" return -1 } # Test if gnatlink is supported set status [remote_exec host "$gnatlink --version"] if {[lindex $status 0] == -1} { unsupported "gnatlink 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 } set can_catch_exceptions 0 gdb_test_multiple "catch exception some_kind_of_error" "" { -re "Catchpoint \[0-9\]+: `some_kind_of_error' Ada exception\r\n$gdb_prompt $" { pass $gdb_test_name set can_catch_exceptions 1 } -re "Your Ada runtime appears to be missing some debugging information.\r\nCannot insert Ada exception catchpoint in this configuration.\r\n$gdb_prompt $" { unsupported $gdb_test_name } } if { $can_catch_exceptions } { gdb_test "cont" \ "Catchpoint \[0-9\]+, .* at .*foo\.adb:\[0-9\]+.*" \ "caught the exception" gdb_test "print \$_ada_exception = some_package.some_kind_of_error'Address" \ " = true" }