OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

Compare Revisions

  • This comparison shows the changes necessary to convert path 
    /openrisc/trunk/gnu-old/gdb-6.8/gdb/testsuite/gdb.ada
    from Rev 157 to Rev 816
    ↔ Reverse comparison
  •

Rev 157 → Rev 816

/Makefile.in
0,0 → 1,39
VPATH = @srcdir@
srcdir = @srcdir@
 
EXECUTABLES = \
array_return/p \
arrayidx/p \
catch_ex/foo \
char_param/foo \
exec_changed/common \
exec_changed/first \
exec_changed/second \
fixed_points/fixed_points \
frame_args/foo \
nested/hello \
null_record/null_record \
packed_array/pa \
print_chars/foo \
start/dummy \
watch_arg/watch
 
MISCELLANEOUS =
 
all info install-info dvi install uninstall installcheck check:
@echo "Nothing to be done for $@..."
 
clean mostlyclean:
-find . -name '*.o' -print | xargs rm -f
-find . -name '*.ali' -print | xargs rm -f
-find . -name 'b~*.ad[sb]' -print | xargs rm -f
-rm -f *~ a.out xgdb *.x *.ci *.tmp
-rm -f *~ *.o a.out xgdb *.x *.ci *.tmp
-rm -f core core.coremaker coremaker.core corefile $(EXECUTABLES)
-rm -f $(MISCELLANEOUS) twice-tmp.c
 
distclean maintainer-clean realclean: clean
-rm -f *~ core
-rm -f Makefile config.status config.log
-rm -f *-init.exp
-rm -fr *.log summary detail *.plog *.sum *.psum site.*
/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;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.