File: catch_ex_std.exp

package info (click to toggle)
gdb-doc 10.1-1
  • links: PTS, VCS
  • area: non-free
  • in suites: bullseye
  • size: 237,684 kB
  • sloc: ansic: 1,939,544; asm: 342,614; exp: 164,373; cpp: 69,350; makefile: 58,777; sh: 25,051; yacc: 13,167; ada: 5,758; xml: 5,461; perl: 5,334; python: 4,759; pascal: 3,220; lisp: 1,575; tcl: 1,541; f90: 1,395; cs: 879; lex: 620; sed: 234; awk: 141; objc: 137; fortran: 62
file content (131 lines) | stat: -rw-r--r-- 3,768 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
# 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 <http://www.gnu.org/licenses/>.

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"
}