URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
Compare Revisions
- This comparison shows the changes necessary to convert path
/openrisc/tags/gdb/gdb-6.8/gdb-6.8.openrisc-2.1/gdb/testsuite/gdb.ada
- from Rev 24 to Rev 33
- ↔ Reverse comparison
Rev 24 → Rev 33
/formatted_ref/defs.adb
0,0 → 1,23
-- Copyright 2007, 2008 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 Defs is |
|
function F1 (S : Struct1) return Integer is |
begin |
return s.x; -- Set breakpoint marker here. |
end F1; |
|
end Defs; |
/formatted_ref/formatted_ref.adb
0,0 → 1,21
-- Copyright 2007, 2008 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 Defs; |
procedure Formatted_Ref is |
X : Integer; |
begin |
X := Defs.F1 (Defs.S1); |
end Formatted_Ref; |
/formatted_ref/defs.ads
0,0 → 1,27
-- Copyright 2007, 2008 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 Defs is |
|
type Struct1 is limited record |
X : Integer := 13; |
Y : Integer := 19; |
end record; |
|
function F1 (S : Struct1) return Integer; |
|
S1 : Struct1; |
|
end Defs; |
/nested/hello.adb
0,0 → 1,36
-- Copyright 2007 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/>. |
|
procedure Hello is |
|
procedure First is |
begin |
null; |
end First; |
|
procedure Second is |
begin |
First; |
end Second; |
|
procedure Third is |
begin |
Second; |
end Third; |
|
begin |
Third; |
end Hello; |
|
/watch_arg.exp
0,0 → 1,59
# Copyright 2006, 2007, 2008 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 $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "ada.exp" |
|
set testdir "watch_arg" |
set testfile "${testdir}/watch" |
set srcfile ${srcdir}/${subdir}/${testfile}.adb |
set binfile ${objdir}/${subdir}/${testfile} |
|
file mkdir ${objdir}/${subdir}/${testdir} |
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } { |
return -1 |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
|
set bp_location [gdb_get_line_number "BREAK1" ${testdir}/watch.adb] |
runto "watch.adb:$bp_location" |
|
# Insert a watchpoint on argument X |
|
gdb_test "watch x" \ |
".*atchpoint \[0-9\]+: x" \ |
"Set watchpoint on function argument X" |
|
# Then insert a breakpoint at the location we'd like to continue to... |
set bp_location [gdb_get_line_number "BREAK2" ${testdir}/watch.adb] |
gdb_test "break watch.adb:$bp_location" \ |
"Breakpoint \[0-9\]+ at.*: file .*watch.adb, line \[0-9\]+." \ |
"insert second breakpoint in watch.adb" |
|
# Then continue to that breakpoint, and verify that the watchpoint |
# did not interfere with that. |
|
gdb_test "cont" \ |
"Breakpoint \[0-9\]+, watch \\(\\).*" \ |
"Continuing to second breakpoint" |
|
|
/str_ref_cmp.exp
0,0 → 1,49
# Copyright 2008 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 $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "ada.exp" |
|
set testdir "str_ref_cmp" |
set testfile "${testdir}/foo" |
set srcfile ${srcdir}/${subdir}/${testfile}.adb |
set binfile ${objdir}/${subdir}/${testfile} |
|
file mkdir ${objdir}/${subdir}/${testdir} |
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } { |
return -1 |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
|
set bp_location [gdb_get_line_number "START" ${testdir}/foo.adb] |
runto "foo.adb:$bp_location" |
|
# Verify that we can compare a string slice with another string. |
|
gdb_test "print String_Var (1 .. 3) = \"Hel\"" \ |
"true" \ |
"print String_Var (1 .. 3) = \"Hel\"" |
|
gdb_test "print String_Var (1 .. 3) = \"hel\"" \ |
"false" \ |
"print String_Var (1 .. 3) = \"hel\"" |
|
/watch_arg/watch.adb
0,0 → 1,29
-- Copyright 2006, 2007, 2008 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/>. |
|
procedure Watch is |
|
procedure Foo (X : access Integer) is |
begin |
X.all := 3; -- BREAK1 |
end Foo; |
|
X : aliased Integer := 1; |
|
begin |
Foo (X'Access); |
X := 2; -- BREAK2 |
end Watch; |
|
/array_subscript_addr.exp
0,0 → 1,45
# Copyright 2008 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 $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "ada.exp" |
|
set testdir "array_subscript_addr" |
set testfile "${testdir}/p" |
set srcfile ${srcdir}/${subdir}/${testfile}.adb |
set binfile ${objdir}/${subdir}/${testfile} |
|
file mkdir ${objdir}/${subdir}/${testdir} |
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } { |
return -1 |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
|
set bp_location [gdb_get_line_number "STOP" ${testdir}/p.adb] |
runto "p.adb:$bp_location" |
|
# Verify that we can compare a string slice with another string. |
|
gdb_test "print a(2)'Address" \ |
"\\(system\\.address\\) 0x\[0-9a-fA-F\]+" \ |
"print a(2)'Address" |
|
/complete.exp
0,0 → 1,189
# Copyright 2005, 2007 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 $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "ada.exp" |
|
set testdir "complete" |
set testfile "${testdir}/foo" |
set srcfile ${srcdir}/${subdir}/${testfile}.adb |
set binfile ${objdir}/${subdir}/${testfile} |
|
file mkdir ${objdir}/${subdir}/${testdir} |
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } { |
return -1 |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
|
set bp_location [gdb_get_line_number "START" ${testdir}/foo.adb] |
runto "foo.adb:$bp_location" |
|
set eol "\[\r\n\]*" |
|
# A convenience function that verifies that the "complete EXPR" command |
# returns the EXPECTED_OUTPUT. |
|
proc test_gdb_complete { expr expected_output } { |
gdb_test "complete p $expr" \ |
"$expected_output" \ |
"complete p $expr" |
} |
|
# A convenience function that verifies that the "complete EXPR" command |
# does not genearte any output. |
|
proc test_gdb_no_completion { expr } { |
# FIXME: brobecker/2007-12-27: How do you verify that the command |
# output is actually really empty??? For now, the following does |
# not verify this at all: |
test_gdb_complete "$expr" "" |
} |
|
# A convenience function that joins all the arguments together, |
# with a regexp that matches zero-or-more end of lines in between |
# each argument. This function is ideal to write the expected output |
# of a GDB command that generates more than a couple of lines, as |
# this allows us to write each line as a separate string, which is |
# easier to read by a human being. |
|
proc multi_line { args } { |
return [join $args "\[\r\n\]*"] |
} |
# Try a global variable, only one match should be found: |
|
test_gdb_complete "my_glob" \ |
"p my_global_variable" |
|
# A global variable, inside a nested package: |
|
test_gdb_complete "insi" \ |
"p inside_variable" |
|
# A global variable inside a nested package, but only giving part of |
# the fully qualified name (top level package name missing): |
|
test_gdb_no_completion "inner.insi" |
|
# An incomplete nested package name, were lies a single symbol: |
test_gdb_complete "pck.inne" \ |
"p pck.inner.inside_variable" |
|
# A fully qualified symbol name, mangled... |
test_gdb_complete "pck__inner__ins" \ |
"p pck__inner__inside_variable" |
|
# A fully qualified symbol name... |
test_gdb_complete "pck.inner.ins" \ |
"p pck.inner.inside_variable" |
|
# Make sure that "inside" is not returned as a possible completion |
# for "side"... |
test_gdb_no_completion "side" |
|
# Verify that "Exported_Capitalized" is not returned as a match for |
# "exported", since its symbol name contains capital letters. |
test_gdb_no_completion "exported" |
|
# check the "<...>" notation. |
test_gdb_complete "<Exported" \ |
"p <Exported_Capitalized>" |
|
# A global symbol, created by the binder, that starts with __gnat... |
test_gdb_complete "__gnat_ada_main_progra" \ |
"p __gnat_ada_main_program_name" |
|
# A global symbol, created by the binder, that starts with __gnat, |
# and using the '<' notation. |
test_gdb_complete "<__gnat_ada_main_prog" \ |
"p <__gnat_ada_main_program_name>" |
|
# A local variable |
test_gdb_complete "some" \ |
"p some_local_variable" |
|
# A local variable variable, but in a different procedure. No match |
# should be returned. |
test_gdb_no_completion "not_in_sco" |
|
# A fully qualified variable name that doesn't exist... |
test_gdb_no_completion "pck.ins" |
|
# A fully qualified variable name that does exist... |
test_gdb_complete "pck.my" \ |
"p pck.my_global_variable" |
|
# A fully qualified package name |
test_gdb_complete "pck.inne" \ |
"p pck.inner.inside_variable" |
|
# A fully qualified package name, with a dot at the end |
test_gdb_complete "pck.inner." \ |
"p pck.inner.inside_variable" |
|
# Two matches, from the global scope: |
test_gdb_complete "local_ident" \ |
[multi_line "p local_identical_one" \ |
"p local_identical_two" ] |
|
# Two matches, from the global scope, but using fully qualified names: |
test_gdb_complete "pck.local_ident" \ |
[multi_line "p pck.local_identical_one" \ |
"p pck.local_identical_two" ] |
|
# Two matches, from the global scope, but using mangled fully qualified |
# names: |
test_gdb_complete "pck__local_ident" \ |
[multi_line "p pck__local_identical_one" \ |
"p pck__local_identical_two" ] |
|
# Two matches, one from the global scope, the other from the local scope: |
test_gdb_complete "external_ident" \ |
[multi_line "p external_identical_one" \ |
"p external_identical_two" ] |
|
# Complete on the name of package. |
test_gdb_complete "pck" \ |
[multi_line "(p pck\\.ad\[sb\])?" \ |
"(p pck\\.ad\[sb\])?" \ |
"p pck.external_identical_one" \ |
"p pck.inner.inside_variable" \ |
"p pck.local_identical_one" \ |
"p pck.local_identical_two" \ |
"p pck.my_global_variable" \ |
"p pck.proc" ] |
|
# Complete on the name of a package followed by a dot: |
test_gdb_complete "pck." \ |
[multi_line "(p pck\\.ad\[sb\])?" \ |
"(p pck\\.ad\[sb\])?" \ |
"p pck.external_identical_one" \ |
"p pck.inner.inside_variable" \ |
"p pck.local_identical_one" \ |
"p pck.local_identical_two" \ |
"p pck.my_global_variable" \ |
"p pck.proc" ] |
|
# Complete a mangled symbol name, but using the '<...>' notation. |
test_gdb_complete "<pck__my" \ |
"p <pck__my_global_variable>" |
|
|
/str_ref_cmp/pck.ads
0,0 → 1,20
-- Copyright 2008 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 Pck is |
|
String_Var : String := "Hello from package Pck"; |
|
end Pck; |
/str_ref_cmp/foo.adb
0,0 → 1,21
-- Copyright 2008 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 Pck; use Pck; |
|
procedure Foo is |
begin |
String_Var (String_Var'First) := 'h'; -- START |
end Foo; |
/array_subscript_addr/p.adb
0,0 → 1,29
-- Copyright 2008 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/>. |
|
procedure P is |
type Table is array (1 .. 3) of Integer; |
|
function Create (I : Integer) return Table is |
begin |
return (4 + I, 8 * I, 7 * I + 4); |
end Create; |
|
A : Table := Create (7); |
C : Integer; |
begin |
C := A (1) + A (2); -- STOP |
end P; |
|
/complete/pck.adb
0,0 → 1,9
package body Pck is |
|
procedure Proc (I : Integer) is |
Not_In_Scope : Integer := 77; |
begin |
Inner.Inside_Variable := Not_In_Scope + I; |
end Proc; |
|
end Pck; |
/complete/pck.ads
0,0 → 1,19
package Pck is |
|
My_Global_Variable : Integer := 1; |
|
Exported_Capitalized : Integer := 2; |
pragma Export (C, Exported_Capitalized, "Exported_Capitalized"); |
|
Local_Identical_One : Integer := 4; |
Local_Identical_Two : Integer := 8; |
|
External_Identical_One : Integer := 19; |
|
package Inner is |
Inside_Variable : Integer := 3; |
end Inner; |
|
procedure Proc (I : Integer); |
|
end Pck; |
/complete/foo.adb
0,0 → 1,10
with Pck; use Pck; |
|
procedure Foo is |
Some_Local_Variable : Integer := 1; |
External_Identical_Two : Integer := 74; |
begin |
My_Global_Variable := Some_Local_Variable + 1; -- START |
Proc (External_Identical_Two); |
end Foo; |
|
/array_return.exp
0,0 → 1,99
# Copyright 2005, 2006, 2007, 2008 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 $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "ada.exp" |
|
set testdir "array_return" |
set testfile "${testdir}/p" |
set srcfile ${srcdir}/${subdir}/${testfile}.adb |
set binfile ${objdir}/${subdir}/${testfile} |
|
file mkdir ${objdir}/${subdir}/${testdir} |
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } { |
return -1 |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
|
# Start the inferior |
|
if ![runto_main] then { |
fail "Cannot run to main, testcase aborted" |
return 0 |
} |
|
# Create a breakpoint in each function from which we want to test |
# the "finish" command. |
|
gdb_test "break create_small" \ |
"Breakpoint \[0-9\]+ at.*: file .*pck.adb, line \[0-9\]+." \ |
"insert breakpoint in create_small" |
|
gdb_test "break create_large" \ |
"Breakpoint \[0-9\]+ at.*: file .*pck.adb, line \[0-9\]+." \ |
"insert breakpoint in create_large" |
|
gdb_test "break create_small_float_vector" \ |
"Breakpoint \[0-9\]+ at.*: file .*pck.adb, line \[0-9\]+." \ |
"insert breakpoint in create_small_float_vector" |
|
# Then continue until reaching the first breakpoint inside Create_Small, |
# and then do a "finish". |
|
gdb_test "cont" \ |
"Breakpoint \[0-9\]+, pck.create_small \\(\\).*" \ |
"Continuing to Create_Small" |
|
gdb_test "finish" \ |
"Value returned is \\\$\[0-9\]+ = \\(1, 1\\)" \ |
"value printed by finish of Create_Small" |
|
# Now continue until reaching the second breakpoint inside Create_Large, |
# and then do another "finish". |
|
gdb_test "cont" \ |
"Breakpoint \[0-9\]+, pck.create_large \\(\\).*" \ |
"Continuing to Create_Large" |
|
# On hppa32, the value returned is too large to be returned via a register. |
# Instead, it is returned using the struct convention, and the debugger |
# unfortunately cannot find the address of the result. The following |
# test is therefore expected to fail for all hppa targets except hppa64. |
if { ! [istarget "hppa*64*-*-*"] } then { |
setup_xfail "hppa*-*-*" |
} |
|
gdb_test "finish" \ |
"Value returned is \\\$\[0-9\]+ = \\(2, 2, 2, 2\\)" \ |
"value printed by finish of Create_Large" |
|
# Now continue until reaching the third breakpoint, and then do another |
# "finish" again. |
|
gdb_test "cont" \ |
"Breakpoint \[0-9\]+, pck.create_small_float_vector \\(\\).*" \ |
"Continuing to Create_Small_Float_Vector" |
|
gdb_test "finish" \ |
"Value returned is \\\$\[0-9\]+ = \\(4.25, 4.25\\)" \ |
"value printed by finish of Create_Small_Float_Vector" |
|
/boolean_expr.exp
0,0 → 1,42
# Copyright 2007, 2008 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 $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "ada.exp" |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
|
set any_nb "\[0-9\]+" |
set any_addr "0x\[0-9a-zA-Z\]+" |
|
# Force the language to Ada, as this will not happen automatically |
# in this case (no test program). |
gdb_test "set lang ada" \ |
"" \ |
"Changing the language to ada" |
|
gdb_test "print 1 = 2" \ |
"false" \ |
"print 1 = 2" |
|
gdb_test "print 3 = 3" \ |
"true" \ |
"print 3 = 3" |
|
/array_return/pck.adb
0,0 → 1,33
-- Copyright 2006, 2007, 2008 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 Pck is |
|
function Create_Small return Data_Small is |
begin |
return (others => 1); |
end Create_Small; |
|
function Create_Large return Data_Large is |
begin |
return (others => 2); |
end Create_Large; |
|
function Create_Small_Float_Vector return Small_Float_Vector is |
begin |
return (others => 4.25); |
end Create_Small_Float_Vector; |
|
end Pck; |
/array_return/pck.ads
0,0 → 1,28
-- Copyright 2006, 2007, 2008 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 Pck is |
|
type Data_Small is array (1 .. 2) of Integer; |
type Data_Large is array (1 .. 4) of Integer; |
|
type Small_Float_Vector is array (1 .. 2) of Float; |
|
function Create_Small return Data_Small; |
function Create_Large return Data_Large; |
function Create_Small_Float_Vector return Small_Float_Vector; |
|
end Pck; |
|
/array_return/p.adb
0,0 → 1,28
-- Copyright 2006, 2007, 2008 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 Pck; use Pck; |
|
procedure P is |
Small : Data_Small; |
Large : Data_Large; |
Vector : Small_Float_Vector; |
begin |
Small := Create_Small; |
Large := Create_Large; |
Vector := Create_Small_Float_Vector; |
Small (1) := Large (1); |
Small (2) := Integer (Vector (1)); |
end P; |
/arrayidx.exp
0,0 → 1,116
# Copyright 2005, 2007, 2008 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 $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "ada.exp" |
|
set testdir "arrayidx" |
set testfile "${testdir}/p" |
set srcfile ${srcdir}/${subdir}/${testfile}.adb |
set binfile ${objdir}/${subdir}/${testfile} |
|
file mkdir ${objdir}/${subdir}/${testdir} |
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } { |
return -1 |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
|
set bp_location [gdb_get_line_number "START" ${testdir}/p.adb] |
runto "p.adb:$bp_location" |
|
# First, print all the arrays without indexes |
|
gdb_test "set print array-indexes off" \ |
"" \ |
"set print array-indexes to off" |
|
gdb_test "print one_two_three" \ |
"\\(1, 2, 3\\)" \ |
"print one_two_three, indexes off" |
|
gdb_test "print e_one_two_three" \ |
"\\(1, 2, 3\\)" \ |
"print e_one_two_three, indexes off" |
|
gdb_test "print r_two_three" \ |
"\\(two => 2, 3\\)" \ |
"print r_two_three, indexes off" |
|
gdb_test "print u_one_two_three" \ |
"\\(1, 2, 3\\)" \ |
"print u_one_two_three, indexes off" |
|
gdb_test "print p_one_two_three" \ |
"\\(0 => false, true, true\\)" \ |
"print p_one_two_three, indexes off" |
|
gdb_test "print few_reps" \ |
"\\(1, 2, 3, 3, 3, 3, 3, 4, 5\\)" \ |
"print few_reps, indexes off" |
|
gdb_test "print many_reps" \ |
"\\(1, 2, 3 <repeats 12 times>, 4, 5\\)" \ |
"print many_reps, indexes off" |
|
gdb_test "print empty" \ |
"\\(\\)" \ |
"print empty, indexes off" |
|
# Next, print all the arrays with the indexes |
|
gdb_test "set print array-indexes on" \ |
"" \ |
"set print array-indexes to on" |
|
gdb_test "print one_two_three" \ |
"\\(1 => 1, 2 => 2, 3 => 3\\)" \ |
"print one_two_three" |
|
gdb_test "print e_one_two_three" \ |
"\\(one => 1, two => 2, three => 3\\)" \ |
"print e_one_two_three" |
|
gdb_test "print r_two_three" \ |
"\\(two => 2, three => 3\\)" \ |
"print r_two_three" |
|
gdb_test "print u_one_two_three" \ |
"\\(1 => 1, 2 => 2, 3 => 3\\)" \ |
"print u_one_two_three" |
|
gdb_test "print p_one_two_three" \ |
"\\(0 => false, 1 => true, 2 => true\\)" \ |
"print p_one_two_three" |
|
gdb_test "print few_reps" \ |
"\\(1 => 1, 2 => 2, 3 => 3, 4 => 3, 5 => 3, 6 => 3, 7 => 3, 8 => 4, 9 => 5\\)" \ |
"print few_reps" |
|
gdb_test "print many_reps" \ |
"\\(1 => 1, 2 => 2, 3 => 3 <repeats 12 times>, 15 => 4, 16 => 5\\)" \ |
"print many_reps" |
|
gdb_test "print empty" \ |
"\\(\\)" \ |
"print empty" |
|
|
/packed_array.exp
0,0 → 1,53
# Copyright 2005, 2007, 2008 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 $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "ada.exp" |
|
set testdir "packed_array" |
set testfile "${testdir}/pa" |
set srcfile ${srcdir}/${subdir}/${testfile}.adb |
set binfile ${objdir}/${subdir}/${testfile} |
|
file mkdir ${objdir}/${subdir}/${testdir} |
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } { |
return -1 |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
|
set bp_location [gdb_get_line_number "STOP" ${testdir}/pa.adb] |
runto "pa.adb:$bp_location" |
|
gdb_test "print var" \ |
".* = \\(4 => true, false, true, false, true\\)" \ |
"print var" |
|
# Try printing the value and the type definition of a reference |
# to variable "Var". |
|
gdb_test "ptype &var" \ |
"type = access array \\(4 \\.\\. 8\\) of boolean <packed: 1-bit elements>" \ |
"ptype &var" |
|
gdb_test "print &var" \ |
"\\(access array \\(\\.\\.\\.\\) of boolean\\) \\(4 => true, false, true, false, true\\)" \ |
"print &var" |
/homonym.exp
0,0 → 1,94
# Copyright 2008 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 $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "ada.exp" |
|
set testdir "homonym" |
set testfile "${testdir}/homonym_main" |
set srcfile ${srcdir}/${subdir}/${testfile}.adb |
set binfile ${objdir}/${subdir}/${testfile} |
|
file mkdir ${objdir}/${subdir}/${testdir} |
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } { |
return -1 |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
|
set bp_location [gdb_get_line_number "BREAK_1" ${testdir}/homonym.adb] |
runto "homonym.adb:$bp_location" |
|
# Check the variables and types defined inside the current scope. |
# There are some homonyms in a different scope, so we want to make |
# sure that the debugger doesn't get mixed up. |
|
gdb_test "ptype local_type" \ |
"type = range -100 \\.\\. 100" \ |
"ptype local_type at BREAK_1" |
|
gdb_test "ptype local_type_subtype" \ |
"type = range -100 \\.\\. 100" \ |
"ptype local_type_subtype at BREAK_1" |
|
gdb_test "ptype int_type" \ |
"type = range -100 \\.\\. 100" \ |
"ptype int_type at BREAK_1" |
|
gdb_test "ptype lcl" \ |
"type = range -100 \\.\\. 100" \ |
"ptype lcl at BREAK_1" |
|
gdb_test "print lcl" \ |
"29" \ |
"print lcl at BREAK_1" |
|
# Now, continue until reaching BREAK_2, and do the same commands |
# as above. The result should be different since the definitions |
# in the new scope are different. |
|
set bp_location [gdb_get_line_number "BREAK_2" ${testdir}/homonym.adb] |
gdb_test "break homonym.adb:$bp_location" \ |
"Breakpoint \[0-9\]+ at 0x\[0-9a-fA-F\]+: file .*homonym\.adb, line \[0-9\]+\." \ |
"break at BREAK_2" |
|
gdb_test "continue" \ |
".*Breakpoint \[0-9\]+, homonym\\.get_value \\(\\) at .*homonym\\.adb:.*" \ |
"continue until BREAK_2" |
|
gdb_test "ptype local_type" \ |
"type = range 1 \\.\\. 19740804" \ |
"ptype local_type at BREAK_2" |
|
gdb_test "ptype local_type_subtype" \ |
"type = range 1 \\.\\. 19740804" \ |
"ptype local_type_subtype at BREAK_2" |
|
gdb_test "ptype lcl" \ |
"type = range 1 \\.\\. 19740804" \ |
"ptype lcl at BREAK_2" |
|
gdb_test "print lcl" \ |
"17" \ |
"print lcl at BREAK_2" |
|
|
|
/arrayidx/p.adb
0,0 → 1,54
-- Copyright 2005, 2007, 2008 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/>. |
|
procedure P is |
type Index is (One, Two, Three); |
|
type Table is array (Integer range 1 .. 3) of Integer; |
type ETable is array (Index) of Integer; |
type RTable is array (Index range Two .. Three) of Integer; |
type UTable is array (Positive range <>) of Integer; |
|
type PTable is array (Index) of Boolean; |
pragma Pack (PTable); |
|
function Get_UTable (I : Integer) return UTable is |
begin |
return Utable'(1 => I, 2 => 2, 3 => 3); |
end Get_UTable; |
|
One_Two_Three : Table := (1, 2, 3); |
E_One_Two_Three : ETable := (1, 2, 3); |
R_Two_Three : RTable := (2, 3); |
U_One_Two_Three : UTable := Get_UTable (1); |
P_One_Two_Three : PTable := (False, True, True); |
|
Few_Reps : UTable := (1, 2, 3, 3, 3, 3, 3, 4, 5); |
Many_Reps : UTable := (1, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 5); |
|
Empty : array (1 .. 0) of Integer := (others => 0); |
|
begin |
One_Two_Three (1) := 4; -- START |
E_One_Two_Three (One) := 4; |
R_Two_Three (Two) := 4; |
U_One_Two_Three (U_One_Two_Three'First) := 4; |
P_One_Two_Three (One) := True; |
|
Few_Reps (Few_Reps'First) := 2; |
Many_Reps (Many_Reps'First) := 2; |
|
Empty := (others => 1); |
end P; |
/packed_array/pa.adb
0,0 → 1,28
-- Copyright 2005, 2007, 2008 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/>. |
|
procedure PA is |
|
type Packed_Array is array (4 .. 8) of Boolean; |
pragma pack (Packed_Array); |
|
Var : Packed_Array; |
|
begin |
|
Var := (True, False, True, False, True); |
Var (8) := False; -- STOP |
|
end PA; |
/homonym/homonym_main.adb
0,0 → 1,21
-- Copyright 2008 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 Homonym; |
|
procedure Homonym_Main is |
begin |
Homonym.Start_Test; |
end Homonym_Main; |
/homonym/homonym.adb
0,0 → 1,61
-- Copyright 2008 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 Homonym is |
|
type Integer_Range is new Integer range -100 .. 100; |
type Positive_Range is new Positive range 1 .. 19740804; |
|
--------------- |
-- Get_Value -- |
--------------- |
|
function Get_Value return Integer_Range |
is |
subtype Local_Type is Integer_Range; |
subtype Local_Type_Subtype is Local_Type; |
subtype Int_Type is Integer_Range; |
Lcl : Local_Type := 29; |
begin |
return Lcl; -- BREAK_1 |
end Get_Value; |
|
--------------- |
-- Get_Value -- |
--------------- |
|
function Get_Value return Positive_Range |
is |
subtype Local_Type is Positive_Range; |
subtype Local_Type_Subtype is Local_Type; |
subtype Pos_Type is Positive_Range; |
Lcl : Local_Type := 17; |
begin |
return Lcl; -- BREAK_2 |
end Get_Value; |
|
---------------- |
-- Start_Test -- |
---------------- |
|
procedure Start_Test is |
Int : Integer_Range; |
Pos : Positive_Range; |
begin |
Int := Get_Value; |
Pos := Get_Value; |
end Start_Test; |
|
end Homonym; |
/homonym/homonym.ads
0,0 → 1,20
-- Copyright 2008 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 Homonym is |
|
procedure Start_Test; |
|
end Homonym; |
/fixed_points.exp
0,0 → 1,50
# Copyright 2004, 2007, 2008 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 $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "ada.exp" |
|
set testdir "fixed_points" |
set testfile "${testdir}/fixed_points" |
set srcfile ${srcdir}/${subdir}/${testfile}.adb |
set binfile ${objdir}/${subdir}/${testfile} |
|
file mkdir ${objdir}/${subdir}/${testdir} |
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } { |
return -1 |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
|
set bp_location [gdb_get_line_number "Set breakpoint here" ${testdir}/fixed_points.adb] |
runto "fixed_points.adb:$bp_location" |
|
gdb_test "print base_object" \ |
".* = -50" \ |
"p on a fixed point type" |
|
gdb_test "print subtype_object" \ |
".* = -50" \ |
"p on a subtype fixed point type" |
|
gdb_test "print new_type_object" \ |
".* = -50" \ |
"p on a new fixed point type" |
/start.exp
0,0 → 1,45
# Copyright 2005, 2007, 2008 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 $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "ada.exp" |
|
set testdir "start" |
set testfile "${testdir}/dummy" |
set srcfile ${srcdir}/${subdir}/${testfile}.adb |
set binfile ${objdir}/${subdir}/${testfile} |
|
file mkdir ${objdir}/${subdir}/${testdir} |
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } { |
return -1 |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
|
# Verify that "start" lands inside the right procedure. |
if { [gdb_start_cmd] < 0 } { |
untested start |
return -1 |
} |
|
gdb_test "" \ |
"dummy \\(\\) at .*dummy.adb.*" \ |
"start" |
/char_param.exp
0,0 → 1,65
# Copyright 2007, 2008 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 $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "ada.exp" |
|
set testdir "char_param" |
set testfile "${testdir}/foo" |
set srcfile ${srcdir}/${subdir}/${testfile}.adb |
set binfile ${objdir}/${subdir}/${testfile} |
|
file mkdir ${objdir}/${subdir}/${testdir} |
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } { |
return -1 |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
|
set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb] |
runto "foo.adb:$bp_location" |
|
# Call same and next which are procedures that take a Character |
# as a parameter. To verify that the call was performed correctly, |
# we check the value of "Procedure_Result" which is set during |
# the function call. |
|
gdb_test "print procedure_result" \ |
"32 ' '" \ |
"print procedure_result before calling same" |
|
gdb_test "call same (first)" \ |
"" \ |
"call same" |
|
gdb_test "print procedure_result" \ |
"97 'a'" \ |
"print procedure_result after calling same" |
|
gdb_test "call next (first)" \ |
"98 'b'" \ |
"call next" |
|
gdb_test "print procedure_result" \ |
"98 'b'" \ |
"print procedure_result after calling next" |
|
|
/fixed_cmp.exp
0,0 → 1,57
# Copyright 2007, 2008 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 $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "ada.exp" |
|
set testdir "fixed_cmp" |
set testfile "${testdir}/fixed" |
set srcfile ${srcdir}/${subdir}/${testfile}.adb |
set binfile ${objdir}/${subdir}/${testfile} |
|
file mkdir ${objdir}/${subdir}/${testdir} |
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } { |
return -1 |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
|
set bp_location [gdb_get_line_number "STOP" ${testdir}/fixed.adb] |
runto "fixed.adb:$bp_location" |
|
gdb_test "print My_Var > 10.0" \ |
"true" \ |
"print My_Var > 10.0" |
|
gdb_test "print My_Var > 20.0" \ |
"false" \ |
"print My_Var > 20.0" |
|
# Do the same, but with integer values. |
|
gdb_test "print My_Var > 10" \ |
"true" \ |
"print My_Var > 10" |
|
gdb_test "print My_Var > 20" \ |
"false" \ |
"print My_Var > 20" |
|
/fixed_points/fixed_points.adb
0,0 → 1,38
-- Copyright 2004, 2007, 2008 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 System; |
|
procedure Fixed_Points is |
|
type Base_Fixed_Point_Type is |
delta 1.0 / 16.0 |
range (System.Min_Int / 2) * 1.0 / 16.0 .. |
(System.Max_Int / 2) * 1.0 / 16.0; |
|
subtype Fixed_Point_Subtype is |
Base_Fixed_Point_Type range -50.0 .. 50.0; |
|
type New_Fixed_Point_Type is |
new Base_Fixed_Point_Type range -50.0 .. 50.0; |
|
Base_Object : Base_Fixed_Point_Type := -50.0; |
Subtype_Object : Fixed_Point_Subtype := -50.0; |
New_Type_Object : New_Fixed_Point_Type := -50.0; |
begin |
Base_Object := 1.0/16.0; -- Set breakpoint here |
Subtype_Object := 1.0/16.0; |
New_Type_Object := 1.0/16.0; |
end Fixed_Points; |
/start/dummy.adb
0,0 → 1,19
-- Copyright 2005, 2007, 2008 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/>. |
|
procedure Dummy is |
begin |
null; |
end Dummy; |
/char_param/pck.adb
0,0 → 1,33
-- Copyright 2007, 2008 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 Pck is |
|
procedure Same (C : Character) is |
begin |
Procedure_Result := C; |
end Same; |
|
procedure Next (C : in out Character) is |
begin |
if C = Character'Last then |
C := Character'First; |
else |
C := Character'Succ (C); |
end if; |
Procedure_Result := C; |
end Next; |
|
end Pck; |
/char_param/pck.ads
0,0 → 1,27
-- Copyright 2007, 2008 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 Pck is |
|
Procedure_Result : Character := ' '; |
|
procedure Same (C : Character); |
-- Set Procedure_Result to C. |
|
procedure Next (C : in out Character); |
-- Increment C (if C is the last character, then set C to the first |
-- character). Set Procedure_Result to the new value of C. |
|
end Pck; |
/char_param/foo.adb
0,0 → 1,27
-- Copyright 2007, 2008 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 Pck; use Pck; |
|
procedure Foo is |
First : Character := 'a'; |
begin |
Procedure_Result := ' '; |
Same (First); -- STOP |
Next (First); |
end Foo; |
|
|
|
/type_coercion.exp
0,0 → 1,63
# Copyright 2008 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 $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "ada.exp" |
|
set testdir "type_coercion" |
set testfile "${testdir}/assign" |
set srcfile ${srcdir}/${subdir}/${testfile}.adb |
set binfile ${objdir}/${subdir}/${testfile} |
|
file mkdir ${objdir}/${subdir}/${testdir} |
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } { |
return -1 |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
|
set bp_location [gdb_get_line_number "START" ${testdir}/assign.adb] |
runto "assign.adb:$bp_location" |
|
gdb_test "p q" \ |
"\\(2, 3, 5, 7, 11\\)" \ |
"p q" |
|
gdb_test "set \$addr := q'address" \ |
"" \ |
"save q'address in convenience variable" |
|
gdb_test "p {Integer} \$addr" \ |
"2" \ |
"print {Integer} \$addr" |
|
# Now change the value at $addr using the same "{TYPE}" syntax. |
|
gdb_test "set {Integer} \$addr := 19" \ |
"" \ |
"set {Integer} \$addr := 19" |
|
gdb_test "p q" \ |
"\\(19, 3, 5, 7, 11\\)" \ |
"p q" |
|
|
|
/fixed_cmp/pck.adb
0,0 → 1,23
-- Copyright 2007, 2008 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 Pck is |
|
procedure Do_Nothing (A : System.Address) is |
begin |
null; |
end Do_Nothing; |
|
end Pck; |
/fixed_cmp/pck.ads
0,0 → 1,22
-- Copyright 2007, 2008 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 System; |
|
package Pck is |
|
procedure Do_Nothing (A : System.Address); |
|
end Pck; |
/fixed_cmp/fixed.adb
0,0 → 1,24
-- Copyright 2007, 2008 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 Pck; use Pck; |
|
procedure Fixed is |
type Fixed_Point_Type is delta 0.001 range 0.0 .. 1000.0; |
|
My_Var : Fixed_Point_Type := 14.0; |
begin |
Do_Nothing (My_Var'Address); -- STOP |
end Fixed; |
/type_coercion/ident.adb
0,0 → 1,19
-- Copyright 2008 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/>. |
|
function Ident (X : Integer) return Integer is |
begin |
return X; |
end Ident; |
/type_coercion/assign.adb
0,0 → 1,25
-- Copyright 2008 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 Ident; |
procedure Assign is |
|
Q: array (1..5) of Integer := (2, 3, 5, 7, 11); |
|
begin |
|
Q(1) := Ident (Q(3)); -- START |
|
end Assign; |
/null_array.exp
0,0 → 1,50
# Copyright 2008 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 $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "ada.exp" |
|
set testdir "null_array" |
set testfile "${testdir}/foo" |
set srcfile ${srcdir}/${subdir}/${testfile}.adb |
set binfile ${objdir}/${subdir}/${testfile} |
|
file mkdir ${objdir}/${subdir}/${testdir} |
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } { |
return -1 |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
|
set bp_location [gdb_get_line_number "START" ${testdir}/foo.adb] |
runto "foo.adb:$bp_location" |
|
# Test printing and type-printing of a tagged type that is not |
# class-wide. |
|
gdb_test "print my_table" \ |
"\\(\\)" \ |
"print my_table" |
|
gdb_test "ptype my_table" \ |
"type = array \\(10 \\.\\. 1\\) of integer" \ |
"ptype my_table" |
|
/null_array/pck.adb
0,0 → 1,28
-- Copyright 2008 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 Pck is |
|
function Ident (I : Integer) return Integer is |
begin |
return I; |
end Ident; |
|
procedure Do_Nothing (A : System.Address) is |
begin |
null; |
end Do_Nothing; |
|
end Pck; |
/null_array/pck.ads
0,0 → 1,24
-- Copyright 2008 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 System; |
|
package Pck is |
|
function Ident (I : Integer) return Integer; |
|
procedure Do_Nothing (A : System.Address); |
|
end Pck; |
/null_array/foo.adb
0,0 → 1,24
-- Copyright 2008 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 Pck; use Pck; |
|
procedure Foo is |
type Table is array (Integer range <>) of Integer; |
|
My_Table : Table (Ident (10) .. Ident (1)); |
begin |
Do_Nothing (My_Table'Address); -- START |
end Foo; |
/print_pc.exp
0,0 → 1,48
# Copyright 2008 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 $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "ada.exp" |
|
set testdir "start" |
set testfile "${testdir}/dummy" |
set srcfile ${srcdir}/${subdir}/${testfile}.adb |
set binfile ${objdir}/${subdir}/${testfile} |
|
file mkdir ${objdir}/${subdir}/${testdir} |
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } { |
return -1 |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
|
if { [gdb_start_cmd] < 0 } { |
untested start |
return -1 |
} |
|
gdb_test "" \ |
"dummy \\(\\) at .*dummy.adb:.*" \ |
"start inferior" |
|
gdb_test "p /x \$pc" \ |
"0x\[0-9a-zA-Z\]+" \ |
"p /x \$pc" |
/gnat_ada.gpr
0,0 → 1,26
-- Copyright 2004, 2007, 2008 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 2 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, write to the Free Software |
-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. |
|
-- This project file allows us to control the location where the |
-- compilation artifacts produced when building the Ada examples |
-- are stored. |
|
project Gnat_Ada is |
|
for Source_Dirs use (external ("SRC")); |
for Object_Dir use external ("OBJ"); |
|
end Gnat_Ada; |
/exec_changed.exp
0,0 → 1,84
# Copyright 2005, 2007, 2008 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 $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "ada.exp" |
|
set testdir "exec_changed" |
file mkdir ${objdir}/${subdir}/${testdir} |
|
# Build the first test program (note that cygwin needs the $EXEEXT). |
set testfile1 "${testdir}/first" |
set srcfile1 ${srcdir}/${subdir}/${testfile1}.adb |
set binfile1 ${objdir}/${subdir}/${testfile1}$EXEEXT |
|
if {[gdb_compile_ada "${srcfile1}" "${binfile1}" executable [list debug ]] != "" } { |
return -1 |
} |
|
# Build the second test program |
set testfile2 "${testdir}/second" |
set srcfile2 ${srcdir}/${subdir}/${testfile2}.adb |
set binfile2 ${objdir}/${subdir}/${testfile2}$EXEEXT |
|
if {[gdb_compile_ada "${srcfile2}" "${binfile2}" executable [list debug ]] != "" } { |
return -1 |
} |
|
# Start with a fresh gdb. |
|
set testfile "${testdir}/common" |
set binfile ${objdir}/${subdir}/${testfile}$EXEEXT |
|
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
|
# Load the first executable. |
|
gdb_test "shell mv ${binfile1} ${binfile}" "" "" |
gdb_load ${binfile} |
|
# Start the program, we should land in the program main procedure |
if { [gdb_start_cmd] < 0 } { |
untested start |
return -1 |
} |
|
gdb_test "" \ |
"first \\(\\) at .*first.adb.*" \ |
"start first" |
|
# Restore first executable to its original name, and move |
# second executable into its place. Ensure that the new |
# executable is at least a second newer than the old. |
|
gdb_test "shell mv ${binfile} ${binfile1}" "" "" |
gdb_test "shell mv ${binfile2} ${binfile}" "" "" |
gdb_test "shell sleep 1" "" "" |
gdb_test "shell touch ${binfile}" "" "" |
|
# Start the program a second time, GDB should land in procedure Second |
# this time. |
|
if { [gdb_start_cmd] < 0 } { |
fail "start second" |
} else { |
gdb_test "" \ |
"second \\(\\) at .*second.adb.*" \ |
"start second" |
} |
/fun_in_declare.exp
0,0 → 1,55
# Copyright 2008 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 $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "ada.exp" |
|
set testdir "fun_in_declare" |
set testfile "${testdir}/foo" |
set srcfile ${srcdir}/${subdir}/${testfile}.adb |
set binfile ${objdir}/${subdir}/${testfile} |
|
file mkdir ${objdir}/${subdir}/${testdir} |
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } { |
return -1 |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
|
if ![runto main] then { |
perror "Couldn't run ${testfile}" |
return |
} |
|
# Some variables used to simplify the maintenance of some of |
# the regular expressions below. |
set any_nb "\[0-9\]+" |
set any_addr "0x\[0-9a-zA-Z\]+" |
|
set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb] |
gdb_test "break foo.adb:$bp_location" \ |
"Breakpoint $any_nb at $any_addr: file .*foo.adb, line $any_nb." \ |
"insert breakpoint inside foo.call_me" |
|
gdb_test "continue" \ |
".*Breakpoint $any_nb, foo\\.call_me \\(\\) at .*foo.adb:$any_nb.*" \ |
"decoding of function name" |
|
/exec_changed/second.adb
0,0 → 1,19
-- Copyright 2005, 2007, 2008 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/>. |
|
procedure Second is |
begin |
null; |
end Second; |
/exec_changed/first.adb
0,0 → 1,19
-- Copyright 2005, 2007, 2008 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/>. |
|
procedure First is |
begin |
null; |
end First; |
/fun_in_declare/pck.adb
0,0 → 1,21
-- Copyright 2008 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 Pck is |
procedure Do_Nothing is |
begin |
null; |
end Do_Nothing; |
end Pck; |
/fun_in_declare/pck.ads
0,0 → 1,18
-- Copyright 2008 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 Pck is |
procedure Do_Nothing; |
end Pck; |
/fun_in_declare/foo.adb
0,0 → 1,28
-- Copyright 2008 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 Pck; use Pck; |
|
procedure Foo is |
begin |
declare |
procedure Call_Me is |
begin |
Do_Nothing; -- STOP |
end Call_Me; |
begin |
Call_Me; |
end; |
end Foo; |
/ptype_field.exp
0,0 → 1,70
# Copyright 2008 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 $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "ada.exp" |
|
set testdir "ptype_field" |
set testfile "${testdir}/foo" |
set srcfile ${srcdir}/${subdir}/${testfile}.adb |
set binfile ${objdir}/${subdir}/${testfile} |
|
file mkdir ${objdir}/${subdir}/${testdir} |
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug additional_flags=-gnat05 ]] != "" } { |
return -1 |
} |
|
# A convenience function that joins all the arguments together, |
# with a regexp that matches zero-or-more end of lines in between |
# each argument. This function is ideal to write the expected output |
# of a GDB command that generates more than a couple of lines, as |
# this allows us to write each line as a separate string, which is |
# easier to read by a human being. |
|
proc multi_line { args } { |
return [join $args "\[\r\n\]*"] |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
|
set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb] |
runto "foo.adb:$bp_location" |
|
gdb_test "ptype circle" \ |
[multi_line "type = record" \ |
" pos: pck\\.position;" \ |
" radius: integer;" \ |
"end record" ] \ |
"ptype circle" |
|
gdb_test "ptype circle.pos" \ |
[multi_line "type = record" \ |
" x: integer;" \ |
" y: integer;" \ |
"end record" ] \ |
"ptype circle.pos" |
|
gdb_test "ptype circle.pos.x" \ |
"type = <\[0-9\]+-byte integer>" \ |
"ptype circle.pos.x" |
|
|
|
/frame_args.exp
0,0 → 1,57
# Copyright 2007, 2008 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 $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "ada.exp" |
|
set testdir "frame_args" |
set testfile "${testdir}/foo" |
set srcfile ${srcdir}/${subdir}/${testfile}.adb |
set binfile ${objdir}/${subdir}/${testfile} |
|
file mkdir ${objdir}/${subdir}/${testdir} |
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } { |
return -1 |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
|
set any_nb "\[0-9\]+" |
set any_addr "0x\[0-9a-zA-Z\]+" |
set eol "\[\r\n\]+" |
set sp "\[ \t\]*" |
|
if ![runto break_me] then { |
perror "Couldn't run ${testfile}" |
return |
} |
|
# First, print all the arrays without indexes |
|
gdb_test "set print frame-arguments scalars" \ |
"" \ |
"set print frame-arguments scalars" |
|
gdb_test "frame 1" \ |
"#1$sp$any_addr in pck.call_me \\(int=1, flt=2.0, bln=true, ary=\\.\\.\\., chr=106 'j', sad=\\(system.address\\) $any_addr, rec=\\.\\.\\.\\).*" \ |
"display frame 1 with frame-arguments set to scalars" |
|
|
/null_record.exp
0,0 → 1,48
# Copyright 2004, 2007, 2008 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 $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "ada.exp" |
|
set testdir "null_record" |
set testfile "${testdir}/null_record" |
set srcfile ${srcdir}/${subdir}/${testfile}.adb |
set binfile ${objdir}/${subdir}/${testfile} |
|
file mkdir ${objdir}/${subdir}/${testdir} |
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } { |
return -1 |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
|
if { [gdb_start_cmd] < 0 } { |
untested start |
return -1 |
} |
|
gdb_test "" \ |
"null_record \\(\\) at .*null_record.adb.*" \ |
"start" |
|
gdb_test "ptype empty" \ |
"type = record null; end record" \ |
"ptype on null record" |
/ptype_field/pck.adb
0,0 → 1,23
-- Copyright 2008 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 Pck is |
|
procedure Do_Nothing (C : in out Circle) is |
begin |
null; |
end Do_Nothing; |
|
end Pck; |
/ptype_field/pck.ads
0,0 → 1,30
-- Copyright 2008 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 Pck is |
|
type Position is record |
X : Integer; |
Y : Integer; |
end record; |
|
type Circle is record |
Pos : Position; |
Radius : Integer; |
end record; |
|
procedure Do_Nothing (C : in out Circle); |
|
end Pck; |
/ptype_field/foo.adb
0,0 → 1,22
-- Copyright 2008 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 Pck; use Pck; |
|
procedure Foo is |
My_Circle : Circle := (Pos => (1, 2), Radius => 3); |
begin |
Do_Nothing (My_Circle); -- STOP |
end Foo; |
/frame_args/pck.adb
0,0 → 1,36
-- Copyright 2007, 2008 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 Pck is |
|
procedure Break_Me is |
begin |
null; |
end Break_Me; |
|
procedure Call_Me (Int : Integer; |
Flt : Float; |
Bln : Boolean; |
Ary : Arr; |
Chr : Character; |
Sad : System.Address; |
Rec : Struct) |
is |
begin |
Break_Me; |
end Call_Me; |
|
end Pck; |
|
/frame_args/pck.ads
0,0 → 1,37
-- Copyright 2007, 2008 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 System; |
|
package Pck is |
|
type Struct is record |
A : Integer; |
B : Integer; |
end record; |
|
type Arr is array (1 .. 3) of Integer; |
|
|
procedure Call_Me (Int : Integer; |
Flt : Float; |
Bln : Boolean; |
Ary : Arr; -- Non scalar |
Chr : Character; |
Sad : System.Address; |
Rec : Struct); -- Non scalar |
|
end Pck; |
|
/frame_args/foo.adb
0,0 → 1,23
-- Copyright 2007, 2008 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 Pck; use Pck; |
|
procedure Foo is |
I : Integer := 1; |
begin |
Call_Me (Int => 1, Flt => 2.0, Bln => True, Ary => (1, 4, 8), Chr => 'j', |
Sad => I'Address, Rec => (A => 3, B => 7)); |
end Foo; |
/null_record/bar.adb
0,0 → 1,23
-- Copyright 2004, 2007, 2008 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 Bar is |
|
procedure Do_Nothing (E : Void_Star) is |
begin |
null; |
end Do_Nothing; |
|
end Bar; |
/null_record/bar.ads
0,0 → 1,23
-- Copyright 2004, 2007, 2008 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 Bar is |
|
type Empty is null record; |
type Void_Star is access all Empty; |
|
procedure Do_Nothing (E : Void_Star); |
|
end Bar; |
/null_record/null_record.adb
0,0 → 1,23
-- Copyright 2004, 2007, 2008 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 Bar; use Bar; |
|
procedure Null_Record is |
E : Void_Star := new Empty; |
begin |
Do_Nothing (E); |
end Null_Record; |
|
/fun_addr.exp
0,0 → 1,44
# Copyright 2008 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 $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "ada.exp" |
|
set testdir "fun_addr" |
set testfile "${testdir}/foo" |
set srcfile ${srcdir}/${subdir}/${testfile}.adb |
set binfile ${objdir}/${subdir}/${testfile} |
|
file mkdir ${objdir}/${subdir}/${testdir} |
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } { |
return -1 |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
|
# Verify that we are able to print the address of a function when |
# the inferior is *not* running (no frame). |
|
gdb_test "print foo'address" \ |
"0x\[0-9a-zA-Z\]+" \ |
"print foo'address" |
|
|
/sym_print_name.exp
0,0 → 1,73
# Copyright 2008 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 $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "ada.exp" |
|
set testdir "sym_print_name" |
set testfile "${testdir}/foo" |
set srcfile ${srcdir}/${subdir}/${testfile}.adb |
set binfile ${objdir}/${subdir}/${testfile} |
|
file mkdir ${objdir}/${subdir}/${testdir} |
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } { |
return -1 |
} |
|
# A convenience function that joins all the arguments together, |
# with a regexp that matches zero-or-more end of lines in between |
# each argument. This function is ideal to write the expected output |
# of a GDB command that generates more than a couple of lines, as |
# this allows us to write each line as a separate string, which is |
# easier to read by a human being. |
|
proc multi_line { args } { |
return [join $args "\[\r\n\]*"] |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
|
set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb] |
runto "foo.adb:$bp_location" |
|
set menu [multi_line "Multiple matches for i" \ |
"\\\[0\\\] cancel" \ |
"\\\[1\\\] pck\\.first\\.i.*" \ |
"\\\[2\\\] pck\\.second\\.i.*" \ |
"> $" ] |
|
set test_name "multiple matches for symbol i" |
gdb_test_multiple "print i" "$test_name" \ |
{ |
-re "$menu" { |
pass "$test_name" |
} |
|
default { |
fail "$test_name" |
} |
} |
|
# Select the first choice from the multiple-choice menu above. |
gdb_test "1" \ |
"48" \ |
"select first choice from multiple-choice menu" |
|
/fun_addr/foo.adb
0,0 → 1,19
-- Copyright 2008 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/>. |
|
procedure Foo is |
begin |
null; |
end Foo; |
/array_bounds.exp
0,0 → 1,58
# Copyright 2008 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 $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "ada.exp" |
|
set testdir "array_bounds" |
set testfile "${testdir}/bar" |
set srcfile ${srcdir}/${subdir}/${testfile}.adb |
set binfile ${objdir}/${subdir}/${testfile} |
|
file mkdir ${objdir}/${subdir}/${testdir} |
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } { |
return -1 |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
|
set bp_location [gdb_get_line_number "STOP" ${testdir}/bar.adb] |
if ![runto "bar.adb:$bp_location" ] then { |
perror "Couldn't run ${testfile}" |
return |
} |
|
gdb_test "print itable'first" \ |
"2" \ |
"print itable'first" |
|
gdb_test "print itable'last" \ |
"5" \ |
"print itable'last" |
|
gdb_test "print table'first" \ |
"zero" \ |
"print table'first" |
|
gdb_test "print table'last" \ |
"two" \ |
"print table'last" |
|
/sym_print_name/pck.adb
0,0 → 1,21
-- Copyright 2008 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 Pck is |
procedure Do_Nothing (Val : in out Integer) is |
begin |
null; |
end Do_Nothing; |
end Pck; |
/sym_print_name/pck.ads
0,0 → 1,26
-- Copyright 2008 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 Pck is |
package First is |
I : Integer := 48; |
end First; |
|
package Second is |
I : Integer := 74; |
end Second; |
|
procedure Do_Nothing (Val : in out Integer); |
end Pck; |
/sym_print_name/foo.adb
0,0 → 1,22
-- Copyright 2008 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 Pck; use Pck; |
|
procedure Foo is |
begin |
Do_Nothing (First.I); -- STOP |
Do_Nothing (Second.I); |
end Foo; |
/tagged.exp
0,0 → 1,76
# Copyright 2008 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 $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "ada.exp" |
|
set testdir "tagged" |
set testfile "${testdir}/foo" |
set srcfile ${srcdir}/${subdir}/${testfile}.adb |
set binfile ${objdir}/${subdir}/${testfile} |
|
file mkdir ${objdir}/${subdir}/${testdir} |
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } { |
return -1 |
} |
|
# A convenience function that joins all the arguments together, |
# with a regexp that matches zero-or-more end of lines in between |
# each argument. This function is ideal to write the expected output |
# of a GDB command that generates more than a couple of lines, as |
# this allows us to write each line as a separate string, which is |
# easier to read by a human being. |
|
proc multi_line { args } { |
return [join $args "\[\r\n\]*"] |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
|
set bp_location [gdb_get_line_number "START" ${testdir}/foo.adb] |
runto "foo.adb:$bp_location" |
|
# Test printing and type-printing of a tagged type that is not |
# class-wide. |
|
gdb_test "ptype segm" \ |
[multi_line "type = new pck\\.object with record" \ |
" width: integer;" \ |
"end record" ] \ |
"ptype segm" |
|
gdb_test "print segm" \ |
"\\(position => 74, width => 8\\)" \ |
"print segm" |
|
# Now, test printing of an class-wide object. |
|
gdb_test "ptype obj" \ |
[multi_line "type = new pck\\.object with record" \ |
" width: integer;" \ |
"end record" ] \ |
"ptype obj" |
|
gdb_test "print obj" \ |
"\\(position => 74, width => 8\\)" \ |
"print obj" |
|
|
/ref_param.exp
0,0 → 1,46
# Copyright 2008 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 $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "ada.exp" |
|
set testdir "ref_param" |
set testfile "${testdir}/foo" |
set srcfile ${srcdir}/${subdir}/${testfile}.adb |
set binfile ${objdir}/${subdir}/${testfile} |
|
file mkdir ${objdir}/${subdir}/${testdir} |
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } { |
return -1 |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
|
if ![runto call_me] then { |
perror "Couldn't run ${testfile}" |
return |
} |
|
set expected_d "\\(one => 1, two => 2, three => 3, four => 4, five => 5, six => 6\\)" |
gdb_test "frame" \ |
"#0\[ \t\]*pck\\.call_me \\(d=${expected_d}\\).*" \ |
"frame argument value printed" |
|
/array_bounds/bar.adb
0,0 → 1,27
-- Copyright 2008 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/>. |
|
procedure Bar is |
type Index is (Zero, One, Two); |
type Vector is array (Index) of Integer; |
type IVector is array (Integer range 2 .. 5) of Integer; |
|
Table : Vector := (0, 1, 2); |
ITable : IVector := (2, 3, 4, 5); |
begin |
Table (Zero) := 5; -- START |
ITable (3) := 10; |
end Bar; |
|
/taft_type.exp
0,0 → 1,46
# Copyright 2008 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 $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "ada.exp" |
|
set testdir "taft_type" |
set testfile "${testdir}/p" |
set srcfile ${srcdir}/${subdir}/${testfile}.adb |
set binfile ${objdir}/${subdir}/${testfile} |
|
file mkdir ${objdir}/${subdir}/${testdir} |
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } { |
return -1 |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
|
set bp_location [gdb_get_line_number "START" ${testdir}/p.adb] |
if ![runto "p.adb:$bp_location" ] then { |
perror "Couldn't run ${testfile}" |
return |
} |
|
gdb_test "print w.e.all" \ |
"\\(month => 8, year => 1974\\)" \ |
"print w.e.all" |
|
/arrayparam.exp
0,0 → 1,61
# Copyright 2008 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 $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "ada.exp" |
|
set testdir "arrayparam" |
set testfile "${testdir}/foo" |
set srcfile ${srcdir}/${subdir}/${testfile}.adb |
set binfile ${objdir}/${subdir}/${testfile} |
|
file mkdir ${objdir}/${subdir}/${testdir} |
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } { |
return -1 |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
|
set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb] |
runto "foo.adb:$bp_location" |
|
# Verify that a call to a function that takes an array as a parameter |
# works without problem. |
|
gdb_test "print call_me (\"bonjour\")" \ |
"void" \ |
"print call_me (\"bonjour\")" |
|
# Verify that the array was passed properly by checking the global |
# variables that Call_Me sets as side-effects. |
|
gdb_test "print first" \ |
"98 'b'" \ |
"print first after function call" |
|
gdb_test "print last" \ |
"114 'r'" \ |
"print lasta after function call" |
|
gdb_test "print length" \ |
"7" \ |
"print length after function call" |
|
/tagged/pck.adb
0,0 → 1,25
-- Copyright 2008 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 Pck is |
|
procedure Do_Nothing (A : System.Address) is |
begin |
null; |
end Do_Nothing; |
|
end Pck; |
|
|
/tagged/pck.ads
0,0 → 1,32
-- Copyright 2008 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 System; |
|
package Pck is |
|
type Object is tagged record |
Position : Integer; |
end record; |
|
type Segment is new Object with record |
Width : Integer; |
end record; |
|
procedure Do_Nothing (A : System.Address); |
|
end Pck; |
|
|
/tagged/foo.adb
0,0 → 1,24
-- Copyright 2008 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 Pck; use Pck; |
|
procedure Foo is |
Segm : Segment := (Position => 74, Width => 8); |
Obj : Object'Class := Segm; |
begin |
Do_Nothing (Segm'Address); -- START |
Do_Nothing (Obj'Address); |
end Foo; |
/interface.exp
0,0 → 1,48
# Copyright 2008 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 $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "ada.exp" |
|
set testdir "interface" |
set testfile "${testdir}/foo" |
set srcfile ${srcdir}/${subdir}/${testfile}.adb |
set binfile ${objdir}/${subdir}/${testfile} |
|
file mkdir ${objdir}/${subdir}/${testdir} |
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug additional_flags=-gnat05 ]] != "" } { |
return -1 |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
|
set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb] |
runto "foo.adb:$bp_location" |
|
gdb_test "print r" \ |
"\\(x => 1, y => 2, w => 3, h => 4\\)" \ |
"print r" |
|
gdb_test "print s" \ |
"\\(x => 1, y => 2, w => 3, h => 4\\)" \ |
"print s" |
|
|
/exprs.exp
0,0 → 1,50
# Copyright 2005, 2007 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 $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "ada.exp" |
|
set testdir "exprs" |
set testfile "${testdir}/p" |
set srcfile ${srcdir}/${subdir}/${testfile}.adb |
set binfile ${objdir}/${subdir}/${testfile} |
|
file mkdir ${objdir}/${subdir}/${testdir} |
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } { |
return -1 |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
|
set bp_location [gdb_get_line_number "START" ${testdir}/p.adb] |
runto "p.adb:$bp_location" |
|
gdb_test "print X ** Y = Z" \ |
"true" \ |
"Long_Long_Integer ** Y" |
|
gdb_test "print long_float'min (long_float (X), 8.0)" \ |
"7.0" \ |
"long_float'min" |
|
gdb_test "print long_float'max (long_float (X), 8.0)" \ |
"8.0" \ |
"long_float'max" |
/ref_param/pck.adb
0,0 → 1,25
-- Copyright 2008 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 Pck is |
|
procedure Call_Me (D : in out Data) is |
begin |
if D.One > D.Two then |
D.Three := D.Four; |
end if; |
end Call_Me; |
|
end Pck; |
/ref_param/pck.ads
0,0 → 1,29
-- Copyright 2008 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 Pck is |
|
type Data is record |
One : Integer; |
Two : Integer; |
Three : Integer; |
Four : Integer; |
Five : Integer; |
Six : Integer; |
end record; |
|
procedure Call_Me (D : in out Data); |
|
end Pck; |
/ref_param/foo.adb
0,0 → 1,22
-- Copyright 2008 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 Pck; use Pck; |
|
procedure Foo is |
D : Data := (1, 2, 3, 4, 5, 6); |
begin |
Call_Me (D); |
end Foo; |
/packed_tagged.exp
0,0 → 1,65
# Copyright 2008 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 $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "ada.exp" |
|
set testdir "packed_tagged" |
set testfile "${testdir}/comp_bug" |
set srcfile ${srcdir}/${subdir}/${testfile}.adb |
set binfile ${objdir}/${subdir}/${testfile} |
|
file mkdir ${objdir}/${subdir}/${testdir} |
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } { |
return -1 |
} |
|
# A convenience function that joins all the arguments together, |
# with a regexp that matches zero-or-more end of lines in between |
# each argument. This function is ideal to write the expected output |
# of a GDB command that generates more than a couple of lines, as |
# this allows us to write each line as a separate string, which is |
# easier to read by a human being. |
|
proc multi_line { args } { |
return [join $args "\[\r\n\]*"] |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
|
set bp_location [gdb_get_line_number "STOP" ${testdir}/comp_bug.adb] |
runto "comp_bug.adb:$bp_location" |
|
gdb_test "print x" \ |
"\\(exists => true, value => 10\\)" \ |
"print x" |
|
gdb_test "ptype x" \ |
[multi_line "type = record" \ |
" exists: range false \\.\\. true;" \ |
" case exists is" \ |
" when true =>" \ |
" value: range 0 \\.\\. 255;" \ |
" when others => null;" \ |
" end case;" \ |
"end record" ] \ |
"ptype x" |
|
/taft_type/pck.adb
0,0 → 1,29
-- Copyright 2008 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 Pck is |
|
type Empty is record |
Month : Integer; |
Year : Integer; |
end record; |
|
function Create return Wrap is |
begin |
return (E => new Empty'(Month => 8, Year => 1974)); |
end Create; |
|
end Pck; |
/taft_type/pck.ads
0,0 → 1,31
-- Copyright 2008 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 Pck is |
|
type Wrap is private; |
|
function Create return Wrap; |
|
private |
|
type Empty; |
type Empty_Access is access Empty; |
|
type Wrap is record |
E : Empty_Access; |
end record; |
|
end Pck; |
/taft_type/p.adb
0,0 → 1,23
-- Copyright 2008 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 Pck; use Pck; |
|
procedure P is |
W : Wrap; |
begin |
W := Create; |
end P; -- START |
|
/arrayparam/pck.adb
0,0 → 1,28
-- Copyright 2008 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 Pck is |
|
procedure Call_Me (Str : String) is |
begin |
Length := Str'Length; |
if Length > 0 then |
First := Str (Str'First); |
Last := Str (Str'Last); |
end if; |
end Call_Me; |
|
end Pck; |
|
/arrayparam/pck.ads
0,0 → 1,25
-- Copyright 2008 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 Pck is |
|
First : Character := ASCII.NUL; |
Last : Character := ASCII.NUL; |
Length : Integer := 0; |
|
procedure Call_Me (Str : String); |
|
end Pck; |
|
/arrayparam/foo.adb
0,0 → 1,26
-- Copyright 2008 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 Pck; use Pck; |
|
procedure Foo is |
My_String : constant String := "Hello World"; |
begin |
First := ASCII.NUL; |
Last := ASCII.NUL; |
Length := -1; |
Call_Me (My_String); -- STOP |
end Foo; |
|
/arrayptr.exp
0,0 → 1,46
# Copyright 2008 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 $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "ada.exp" |
|
set testdir "arrayptr" |
set testfile "${testdir}/foo" |
set srcfile ${srcdir}/${subdir}/${testfile}.adb |
set binfile ${objdir}/${subdir}/${testfile} |
|
file mkdir ${objdir}/${subdir}/${testdir} |
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } { |
return -1 |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
|
set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb] |
if ![runto "foo.adb:$bp_location" ] then { |
perror "Couldn't run ${testfile}" |
return |
} |
|
gdb_test "print string_p" \ |
"\\(foo\\.string_access\\) 0x\[0-9a-zA-Z\]+" \ |
"print string_p" |
|
/funcall_param.exp
0,0 → 1,46
# Copyright 2008 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 $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "ada.exp" |
|
set testdir "funcall_param" |
set testfile "${testdir}/foo" |
set srcfile ${srcdir}/${subdir}/${testfile}.adb |
set binfile ${objdir}/${subdir}/${testfile} |
|
file mkdir ${objdir}/${subdir}/${testdir} |
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } { |
return -1 |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
|
set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb] |
runto "foo.adb:$bp_location" |
|
# Test printing and type-printing of a tagged type that is not |
# class-wide. |
|
gdb_test "p ident (ident (my_parameter))" \ |
"\\(one => 1, two => 2, three => 3\\)" \ |
"p ident (ident (my_parameter))" |
|
/interface/foo.adb
0,0 → 1,25
-- Copyright 2008 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 Types; use Types; |
|
procedure Foo is |
R : Rectangle := (1, 2, 3, 4); |
S : Object'Class := Ident (R); |
begin |
Do_Nothing (R); -- STOP |
Do_Nothing (S); |
end Foo; |
|
/interface/types.adb
0,0 → 1,29
-- Copyright 2008 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 Types is |
|
function Ident (O : Object'Class) return Object'Class is |
begin |
return O; |
end Ident; |
|
procedure Do_Nothing (O : in out Object'Class) is |
begin |
null; |
end Do_Nothing; |
|
end Types; |
|
/interface/types.ads
0,0 → 1,42
-- Copyright 2008 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 Types is |
|
type Object_Int is interface; |
|
type Another_Int is interface; |
|
type Object_Root is abstract tagged record |
X : Natural; |
Y : Natural; |
end record; |
|
type Object is abstract new Object_Root and Object_Int and Another_Int |
with null record; |
function Ident (O : Object'Class) return Object'Class; |
procedure Do_Nothing (O : in out Object'Class); |
|
type Rectangle is new Object with record |
W : Natural; |
H : Natural; |
end record; |
|
type Circle is new Object with record |
R : Natural; |
end record; |
|
end Types; |
|
/exprs/p.adb
0,0 → 1,41
-- Copyright 2008 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/>. |
|
-- Test Ada additions to core GDB evaluation. |
|
with System; |
with Text_IO; use Text_IO; |
|
procedure P is |
type Int is range System.Min_Int .. System.Max_Int; |
|
X, Z : Int; |
Y : Integer; |
|
begin |
X := 0; |
-- Set X to 7 by disguised means lest a future optimizer interfere. |
for I in 1 .. 7 loop |
X := X + 1; |
end loop; |
Z := 1; |
Y := 0; |
while Z < Int'Last / X loop |
Z := Z * X; |
Y := Y + 1; |
end loop; |
|
Put_Line (Int'Image (X ** Y)); -- START |
end P; |
/packed_tagged/comp_bug.adb
0,0 → 1,40
-- Copyright 2008 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/>. |
|
procedure Comp_Bug is |
|
type Number_T (Exists : Boolean := False) is |
record |
case Exists is |
when True => |
Value : Natural range 0 .. 255; |
when False => |
null; |
end case; |
end record; |
pragma Pack (Number_T); |
|
X : Number_T; |
-- brobecker/2007-09-06: At the time when this issue (G904-017) was |
-- reported, the problem only reproduced if the variable was declared |
-- inside a function (in other words, stored on stack). Although |
-- the issue probably still existed when I tried moving this variable |
-- to a package spec, the symptoms inside GDB disappeared. |
begin |
X := (Exists => True, Value => 10); |
if X.Exists then -- STOP |
X.Value := X.Value + 1; |
end if; |
end Comp_Bug; |
/funcall_param/pck.adb
0,0 → 1,28
-- Copyright 2008 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 Pck is |
|
function Ident (P : Parameter) return Parameter is |
begin |
return P; |
end Ident; |
|
procedure Do_Nothing (P : in out Parameter) is |
begin |
null; |
end Do_Nothing; |
|
end Pck; |
/funcall_param/pck.ads
0,0 → 1,28
-- Copyright 2008 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 Pck is |
|
type Parameter is record |
One : Integer; |
Two : Integer; |
Three : Integer; |
end record; |
|
function Ident (P : Parameter) return Parameter; |
|
procedure Do_Nothing (P : in out Parameter); |
|
end Pck; |
/funcall_param/foo.adb
0,0 → 1,22
-- Copyright 2008 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 Pck; use Pck; |
|
procedure Foo is |
My_Parameter : Parameter := Ident (P => (1, 2, 3)); |
begin |
Do_Nothing (My_Parameter); -- STOP |
end Foo; |
/arrayptr/pck.adb
0,0 → 1,23
-- Copyright 2008 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 Pck is |
|
procedure Do_Nothing (A : System.Address) is |
begin |
null; |
end Do_Nothing; |
|
end Pck; |
/arrayptr/pck.ads
0,0 → 1,22
-- Copyright 2008 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 System; |
|
package Pck is |
|
procedure Do_Nothing (A : System.Address); |
|
end Pck; |
/arrayptr/foo.adb
0,0 → 1,24
-- Copyright 2008 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 Pck; use Pck; |
|
procedure Foo is |
type String_Access is access String; |
|
String_P : String_Access := new String'("Hello"); |
begin |
Do_Nothing (String_P'Address); -- STOP |
end Foo; |
/print_chars.exp
0,0 → 1,53
# Copyright 2007, 2008 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 $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "ada.exp" |
|
set testdir "print_chars" |
set testfile "${testdir}/foo" |
set srcfile ${srcdir}/${subdir}/${testfile}.adb |
set binfile ${objdir}/${subdir}/${testfile} |
|
file mkdir ${objdir}/${subdir}/${testdir} |
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug additional_flags=-gnat05 ]] != "" } { |
return -1 |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
|
set bp_location [gdb_get_line_number "START" ${testdir}/foo.adb] |
runto "foo.adb:$bp_location" |
|
|
gdb_test "print C" \ |
"97 'a'" \ |
"print C" |
|
gdb_test "print WC" \ |
"98 'b'" \ |
"print WC" |
|
gdb_test "print WWC" \ |
"99 'c'" \ |
"print WWC" |
|
|
/catch_ex.exp
0,0 → 1,151
# Copyright 2007, 2008 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 $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "ada.exp" |
|
set testdir "catch_ex" |
set testfile "${testdir}/foo" |
set srcfile ${srcdir}/${subdir}/${testfile}.adb |
set binfile ${objdir}/${subdir}/${testfile} |
|
file mkdir ${objdir}/${subdir}/${testdir} |
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug additional_flags=-gnata ]] != "" } { |
return -1 |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
|
# Some global variables used to simplify the maintenance of some of |
# the regular expressions below. |
set any_nb "\[0-9\]+" |
set any_addr "0x\[0-9a-zA-Z\]+" |
set eol "\[\r\n\]+" |
set sp "\[ \t\]*" |
|
set info_break_header "Num${sp}Type${sp}Disp${sp}Enb${sp}Address${sp}What" |
set catch_exception_info \ |
"$any_nb${sp}breakpoint${sp}keep${sp}y${sp}$any_addr${sp}all Ada exceptions" |
|
#################################### |
# 1. Try catching all exceptions. # |
#################################### |
|
if ![runto_main] then { |
fail "Cannot run to main, testcase aborted" |
return 0 |
} |
|
set msg "insert catchpoint on all Ada exceptions" |
gdb_test_multiple "catch exception" $msg { |
-re "Catchpoint $any_nb: all Ada exceptions$eol$gdb_prompt $" { |
pass $msg |
} |
-re "Cannot break on __gnat_raise_nodefer_with_msg in this configuration\.$eol$gdb_prompt $" { |
# If the runtime was not built with enough debug information, |
# or if it was stripped, we can not test exception |
# catchpoints. |
unsupported $msg |
return -1 |
} |
} |
|
gdb_test "info break" \ |
"$info_break_header$eol.*$catch_exception_info" \ |
"info break, catch all Ada exceptions" |
|
set catchpoint_msg \ |
"Catchpoint $any_nb, CONSTRAINT_ERROR at $any_addr in foo \\\(\\\).*at .*foo.adb:$any_nb" |
gdb_test "continue" \ |
"Continuing\.$eol$catchpoint_msg$eol.*SPOT1" \ |
"continuing to first exception" |
|
set catchpoint_msg \ |
"Catchpoint $any_nb, PROGRAM_ERROR at $any_addr in foo \\\(\\\).*at .*foo.adb:$any_nb" |
gdb_test "continue" \ |
"Continuing\.$eol$catchpoint_msg$eol.*SPOT2" \ |
"continuing to second exception" |
|
################################################ |
# 2. Try catching only some of the exceptions. # |
################################################ |
|
# Here is the scenario: |
# - Restart the debugger from scratch, runto_main |
# - We'll catch only "Program_Error" |
# We'll catch assertions |
# We'll catch unhandled exceptions |
# - continue, we should see the first Program_Error exception |
# - continue, we should see the failed assertion |
# - continue, we should see the unhandled Constrait_Error exception |
# - continue, the program exits. |
|
if ![runto_main] then { |
fail "Cannot run to main, testcase aborted" |
return 0 |
} |
|
gdb_test "catch exception Program_Error" \ |
"Catchpoint $any_nb: \`Program_Error' Ada exception" \ |
"insert catchpoint on Program_Error" |
|
gdb_test "catch assert" \ |
"Catchpoint $any_nb: failed Ada assertions" \ |
"insert catchpoint on failed assertions" |
|
gdb_test "catch exception unhandled" \ |
"Catchpoint $any_nb: unhandled Ada exceptions" \ |
"insert catchpoint on unhandled exceptions" |
|
set catch_exception_entry \ |
"$any_nb${sp}breakpoint${sp}keep${sp}y${sp}$any_addr${sp}\`Program_Error' Ada exception" |
set catch_assert_entry \ |
"$any_nb${sp}breakpoint${sp}keep${sp}y${sp}$any_addr${sp}failed Ada assertions" |
set catch_unhandled_entry \ |
"$any_nb${sp}breakpoint${sp}keep${sp}y${sp}$any_addr${sp}unhandled Ada exceptions" |
|
gdb_test "info break" \ |
"$info_break_header$eol.*$catch_exception_entry$eol$catch_assert_entry$eol$catch_unhandled_entry" \ |
"info break, second run" |
|
set catchpoint_msg \ |
"Catchpoint $any_nb, PROGRAM_ERROR at $any_addr in foo \\\(\\\).*at .*foo.adb:$any_nb" |
gdb_test "continue" \ |
"Continuing\.$eol$catchpoint_msg$eol.*SPOT2" \ |
"continuing to Program_Error exception" |
|
set catchpoint_msg \ |
"Catchpoint $any_nb, failed assertion at $any_addr in foo \\\(\\\).*at .*foo.adb:$any_nb" |
gdb_test "continue" \ |
"Continuing\.$eol$catchpoint_msg$eol.*SPOT3" \ |
"continuing to failed assertion" |
|
set catchpoint_msg \ |
"Catchpoint $any_nb, unhandled CONSTRAINT_ERROR at $any_addr in foo \\\(\\\).*at .*foo.adb:$any_nb" |
gdb_test "continue" \ |
"Continuing\.$eol$catchpoint_msg$eol.*SPOT4" \ |
"continuing to unhandled exception" |
|
gdb_test "continue" \ |
"Continuing\..*Program exited.*" \ |
"continuing to program completion" |
|
|
/print_chars/pck.adb
0,0 → 1,23
-- Copyright 2007, 2008 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 Pck is |
|
procedure Do_Nothing (A : System.Address) is |
begin |
null; |
end Do_Nothing; |
|
end Pck; |
/print_chars/pck.ads
0,0 → 1,22
-- Copyright 2007, 2008 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 System; |
|
package Pck is |
|
procedure Do_Nothing (A : System.Address); |
|
end Pck; |
/print_chars/foo.adb
0,0 → 1,11
with Pck; use Pck; |
|
procedure Foo is |
C : Character := 'a'; |
WC : Wide_Character := 'b'; |
WWC : Wide_Wide_Character := 'c'; |
begin |
Do_Nothing (C'Address); -- START |
Do_Nothing (WC'Address); |
Do_Nothing (WWC'Address); |
end Foo; |
/formatted_ref.exp
0,0 → 1,102
# Copyright 2007, 2008 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/>. |
|
# Author: P. N. Hilfinger, AdaCore Inc. |
|
# Note: This test is essentially a transcription of gdb.cp/formatted-ref.exp, |
# and is thus much more wordy than it needs to be. There are fewer |
# tests because only a few parameter types in Ada are required to be |
# passed by reference, and there is no equivalent of &(&x) for reference |
# values. |
|
if $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "ada.exp" |
|
set testdir "formatted_ref" |
set testfile "${testdir}/formatted_ref" |
set srcfile ${srcdir}/${subdir}/${testfile}.adb |
set binfile ${objdir}/${subdir}/${testfile} |
|
|
file mkdir ${objdir}/${subdir}/${testdir} |
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } { |
untested formatted-ref.exp |
return -1 |
} |
|
proc get_address { var } { |
global expect_out |
global gdb_prompt |
|
send_gdb "print $var'access\n" |
gdb_expect { |
-re "\\$\[0-9\]+ = \\(.*\\) (0x\[0-9a-f\]+).*$gdb_prompt $" { |
return $expect_out(1,string) |
} |
timeout { |
perror "couldn't find address of $var" |
return "" |
} |
} |
} |
|
proc test_p_x { var val addr } { |
global gdb_prompt |
|
set test "print/x $var" |
gdb_test_multiple "$test" $test { |
-re "\\$\[0-9\]+ = [string_to_regexp $val].*$gdb_prompt $" { |
pass $test |
} |
-re "\\$\[0-9\]+ = $addr.*$gdb_prompt $" { |
fail "$test (prints just address)" |
} |
-re "\\$\[0-9\]+ = 0x\[a-f0-9\]+.*$gdb_prompt $" { |
fail "$test (prints unexpected address)" |
} |
} |
return 0 |
} |
|
proc test_p_x_addr { var addr } { |
global gdb_prompt |
|
set test "print/x $var'access" |
gdb_test_multiple $test $test { |
-re "\\$\[0-9\]+ = $addr.*$gdb_prompt $" { |
pass $test |
} |
-re "\\$\[0-9\]+ = 0x\[a-f0-9+\]+.*$gdb_prompt $" { |
fail "$test (prints unexpected address)" |
} |
} |
return 0 |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
|
runto defs.adb:[gdb_get_line_number "marker here" ${testdir}/defs.adb ] |
|
set s1_address [get_address "s1"] |
|
test_p_x "s" "(x => 0xd, y => 0x13)" $s1_address |
|
test_p_x_addr "s" $s1_address |
/nested.exp
0,0 → 1,45
# Copyright 2007 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 $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "ada.exp" |
|
set testdir "nested" |
set testfile "${testdir}/hello" |
set srcfile ${srcdir}/${subdir}/${testfile}.adb |
set binfile ${objdir}/${subdir}/${testfile} |
|
file mkdir ${objdir}/${subdir}/${testdir} |
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } { |
return -1 |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
|
set any_nb "\[0-9\]+" |
set any_addr "0x\[0-9a-zA-Z\]+" |
|
# Try breaking on a nested function. |
|
gdb_test "break first" \ |
"Breakpoint $any_nb at $any_addr: file .*hello.adb, line $any_nb." \ |
"break on nested function First" |
|
/catch_ex/foo.adb
0,0 → 1,43
-- Copyright 2007, 2008 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/>. |
|
procedure Foo is |
begin |
|
begin |
raise Constraint_Error; -- SPOT1 |
exception |
when others => |
null; |
end; |
|
begin |
raise Program_Error; -- SPOT2 |
exception |
when others => |
null; |
end; |
|
begin |
pragma Assert (False); -- SPOT3 |
null; |
exception |
when others => |
null; |
end; |
|
raise Constraint_Error; -- SPOT4 |
|
end Foo; |