Add tests for Ada changes
The previous patches largely came without test cases. This was done to make the patches easier to review; as most of the patches were needed before existing tests could be updated. This patch adds a new test and updates some existing tests to test all the settings of -fgnat-encodings. This ensures that tests are run both with the old-style "magic symbol name" encoding, and the new-style DWARF encoding. Note that in one case, a test is modified to be more lax. See the comment in mi_var_array.exp. I didn't want to fix this in this series, as it's already complicated enough. However, I think it could be fixed; I will file a bug for it. gdb/testsuite/ChangeLog 2020-04-24 Tom Tromey <tromey@adacore.com> * gdb.ada/mi_var_array.exp: Try all -fgnat-encodings settings. Make array type matching more lax. * gdb.ada/mi_var_union.exp: Try all -fgnat-encodings settings. * gdb.ada/mi_variant.exp: New file. * gdb.ada/mi_variant/pck.ads: New file. * gdb.ada/mi_variant/pkg.adb: New file. * gdb.ada/packed_tagged.exp: Try all -fgnat-encodings settings. * gdb.ada/unchecked_union.exp: Try all -fgnat-encodings settings.
This commit is contained in:
parent
d656f129eb
commit
adfb981595
|
@ -1,3 +1,14 @@
|
||||||
|
2020-04-24 Tom Tromey <tromey@adacore.com>
|
||||||
|
|
||||||
|
* gdb.ada/mi_var_array.exp: Try all -fgnat-encodings settings.
|
||||||
|
Make array type matching more lax.
|
||||||
|
* gdb.ada/mi_var_union.exp: Try all -fgnat-encodings settings.
|
||||||
|
* gdb.ada/mi_variant.exp: New file.
|
||||||
|
* gdb.ada/mi_variant/pck.ads: New file.
|
||||||
|
* gdb.ada/mi_variant/pkg.adb: New file.
|
||||||
|
* gdb.ada/packed_tagged.exp: Try all -fgnat-encodings settings.
|
||||||
|
* gdb.ada/unchecked_union.exp: Try all -fgnat-encodings settings.
|
||||||
|
|
||||||
2020-04-24 Tom Tromey <tromey@adacore.com>
|
2020-04-24 Tom Tromey <tromey@adacore.com>
|
||||||
|
|
||||||
* gdb.ada/variant.exp: Add dynamic field offset tests.
|
* gdb.ada/variant.exp: Add dynamic field offset tests.
|
||||||
|
|
|
@ -17,36 +17,47 @@ load_lib "ada.exp"
|
||||||
|
|
||||||
standard_ada_testfile bar
|
standard_ada_testfile bar
|
||||||
|
|
||||||
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } {
|
|
||||||
return -1
|
|
||||||
}
|
|
||||||
|
|
||||||
load_lib mi-support.exp
|
load_lib mi-support.exp
|
||||||
set MIFLAGS "-i=mi"
|
set MIFLAGS "-i=mi"
|
||||||
|
|
||||||
gdb_exit
|
foreach_with_prefix scenario {none all minimal} {
|
||||||
if [mi_gdb_start] {
|
set flags {debug}
|
||||||
continue
|
if {$scenario != "none"} {
|
||||||
|
lappend flags additional_flags=-fgnat-encodings=$scenario
|
||||||
|
}
|
||||||
|
|
||||||
|
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != "" } {
|
||||||
|
return -1
|
||||||
|
}
|
||||||
|
|
||||||
|
gdb_exit
|
||||||
|
if [mi_gdb_start] {
|
||||||
|
continue
|
||||||
|
}
|
||||||
|
|
||||||
|
mi_delete_breakpoints
|
||||||
|
mi_gdb_reinitialize_dir $srcdir/$subdir
|
||||||
|
mi_gdb_load ${binfile}
|
||||||
|
|
||||||
|
if ![mi_run_to_main] then {
|
||||||
|
fail "cannot run to main, testcase aborted"
|
||||||
|
return 0
|
||||||
|
}
|
||||||
|
|
||||||
|
set bp_location [gdb_get_line_number "STOP" ${testdir}/bar.adb]
|
||||||
|
mi_continue_to_line \
|
||||||
|
"bar.adb:$bp_location" \
|
||||||
|
"stop at start of main Ada procedure"
|
||||||
|
|
||||||
|
mi_gdb_test "-var-create vta * vta" \
|
||||||
|
"\\^done,name=\"vta\",numchild=\"2\",.*" \
|
||||||
|
"create bt varobj"
|
||||||
|
|
||||||
|
# In the "minimal" mode, we don't currently have the ability to
|
||||||
|
# print the subrange type properly. So, we just allow anything
|
||||||
|
# for the array range here. The correct result would be to fix
|
||||||
|
# this to read "(1 .. n)".
|
||||||
|
mi_gdb_test "-var-list-children vta" \
|
||||||
|
"\\^done,numchild=\"2\",children=\\\[child={name=\"vta.n\",exp=\"n\",numchild=\"0\",type=\"bar\\.int\",thread-id=\"$decimal\"},child={name=\"vta.f\",exp=\"f\",numchild=\"0\",type=\"array .* of character\",thread-id=\"$decimal\"}\\\],.*" \
|
||||||
|
"list vta's children"
|
||||||
}
|
}
|
||||||
|
|
||||||
mi_delete_breakpoints
|
|
||||||
mi_gdb_reinitialize_dir $srcdir/$subdir
|
|
||||||
mi_gdb_load ${binfile}
|
|
||||||
|
|
||||||
if ![mi_run_to_main] then {
|
|
||||||
fail "cannot run to main, testcase aborted"
|
|
||||||
return 0
|
|
||||||
}
|
|
||||||
|
|
||||||
set bp_location [gdb_get_line_number "STOP" ${testdir}/bar.adb]
|
|
||||||
mi_continue_to_line \
|
|
||||||
"bar.adb:$bp_location" \
|
|
||||||
"stop at start of main Ada procedure"
|
|
||||||
|
|
||||||
mi_gdb_test "-var-create vta * vta" \
|
|
||||||
"\\^done,name=\"vta\",numchild=\"2\",.*" \
|
|
||||||
"create bt varobj"
|
|
||||||
|
|
||||||
mi_gdb_test "-var-list-children vta" \
|
|
||||||
"\\^done,numchild=\"2\",children=\\\[child={name=\"vta.n\",exp=\"n\",numchild=\"0\",type=\"bar\\.int\",thread-id=\"$decimal\"},child={name=\"vta.f\",exp=\"f\",numchild=\"0\",type=\"array \\(1 .. n\\) of character\",thread-id=\"$decimal\"}\\\],.*" \
|
|
||||||
"list vta's children"
|
|
||||||
|
|
|
@ -17,38 +17,45 @@ load_lib "ada.exp"
|
||||||
|
|
||||||
standard_ada_testfile bar
|
standard_ada_testfile bar
|
||||||
|
|
||||||
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } {
|
|
||||||
return -1
|
|
||||||
}
|
|
||||||
|
|
||||||
load_lib mi-support.exp
|
load_lib mi-support.exp
|
||||||
set MIFLAGS "-i=mi"
|
set MIFLAGS "-i=mi"
|
||||||
|
|
||||||
gdb_exit
|
|
||||||
if [mi_gdb_start] {
|
|
||||||
continue
|
|
||||||
}
|
|
||||||
|
|
||||||
set float "\\-?((\[0-9\]+(\\.\[0-9\]+)?(e\[-+\]\[0-9\]+)?)|(nan\\($hex\\)))"
|
set float "\\-?((\[0-9\]+(\\.\[0-9\]+)?(e\[-+\]\[0-9\]+)?)|(nan\\($hex\\)))"
|
||||||
|
|
||||||
mi_delete_breakpoints
|
foreach_with_prefix scenario {none all minimal} {
|
||||||
mi_gdb_reinitialize_dir $srcdir/$subdir
|
set flags {debug}
|
||||||
mi_gdb_load ${binfile}
|
if {$scenario != "none"} {
|
||||||
|
lappend flags additional_flags=-fgnat-encodings=$scenario
|
||||||
|
}
|
||||||
|
|
||||||
if ![mi_run_to_main] then {
|
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != "" } {
|
||||||
fail "cannot run to main, testcase aborted"
|
return -1
|
||||||
return 0
|
}
|
||||||
|
|
||||||
|
gdb_exit
|
||||||
|
if [mi_gdb_start] {
|
||||||
|
continue
|
||||||
|
}
|
||||||
|
|
||||||
|
mi_delete_breakpoints
|
||||||
|
mi_gdb_reinitialize_dir $srcdir/$subdir
|
||||||
|
mi_gdb_load ${binfile}
|
||||||
|
|
||||||
|
if ![mi_run_to_main] then {
|
||||||
|
fail "cannot run to main, testcase aborted"
|
||||||
|
return 0
|
||||||
|
}
|
||||||
|
|
||||||
|
set bp_location [gdb_get_line_number "STOP" ${testdir}/bar.adb]
|
||||||
|
mi_continue_to_line \
|
||||||
|
"bar.adb:$bp_location" \
|
||||||
|
"stop at start of main Ada procedure"
|
||||||
|
|
||||||
|
mi_gdb_test "-var-create var1 * Ut" \
|
||||||
|
"\\^done,name=\"var1\",numchild=\"2\",.*" \
|
||||||
|
"Create var1 varobj"
|
||||||
|
|
||||||
|
mi_gdb_test "-var-list-children 1 var1" \
|
||||||
|
"\\^done,numchild=\"2\",children=\\\[child={name=\"var1.b\",exp=\"b\",numchild=\"0\",value=\"3\",type=\"integer\",thread-id=\"$decimal\"},child={name=\"var1.c\",exp=\"c\",numchild=\"0\",value=\"$float\",type=\"float\",thread-id=\"$decimal\"}\\\],has_more=\"0\"" \
|
||||||
|
"list var1's children"
|
||||||
}
|
}
|
||||||
|
|
||||||
set bp_location [gdb_get_line_number "STOP" ${testdir}/bar.adb]
|
|
||||||
mi_continue_to_line \
|
|
||||||
"bar.adb:$bp_location" \
|
|
||||||
"stop at start of main Ada procedure"
|
|
||||||
|
|
||||||
mi_gdb_test "-var-create var1 * Ut" \
|
|
||||||
"\\^done,name=\"var1\",numchild=\"2\",.*" \
|
|
||||||
"Create var1 varobj"
|
|
||||||
|
|
||||||
mi_gdb_test "-var-list-children 1 var1" \
|
|
||||||
"\\^done,numchild=\"2\",children=\\\[child={name=\"var1.b\",exp=\"b\",numchild=\"0\",value=\"3\",type=\"integer\",thread-id=\"$decimal\"},child={name=\"var1.c\",exp=\"c\",numchild=\"0\",value=\"$float\",type=\"float\",thread-id=\"$decimal\"}\\\],has_more=\"0\"" \
|
|
||||||
"list var1's children"
|
|
||||||
|
|
|
@ -0,0 +1,65 @@
|
||||||
|
# Copyright 2020 Free Software Foundation, Inc.
|
||||||
|
#
|
||||||
|
# This program is free software; you can redistribute it and/or modify
|
||||||
|
# it under the terms of the GNU General Public License as published by
|
||||||
|
# the Free Software Foundation; either version 3 of the License, or
|
||||||
|
# (at your option) any later version.
|
||||||
|
#
|
||||||
|
# This program is distributed in the hope that it will be useful,
|
||||||
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
# GNU General Public License for more details.
|
||||||
|
#
|
||||||
|
# You should have received a copy of the GNU General Public License
|
||||||
|
# along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
load_lib "ada.exp"
|
||||||
|
load_lib "gdb-python.exp"
|
||||||
|
|
||||||
|
standard_ada_testfile pkg
|
||||||
|
|
||||||
|
load_lib mi-support.exp
|
||||||
|
set MIFLAGS "-i=mi"
|
||||||
|
|
||||||
|
foreach_with_prefix scenario {none all minimal} {
|
||||||
|
set flags {debug}
|
||||||
|
if {$scenario != "none"} {
|
||||||
|
lappend flags additional_flags=-fgnat-encodings=$scenario
|
||||||
|
}
|
||||||
|
|
||||||
|
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} {
|
||||||
|
return -1
|
||||||
|
}
|
||||||
|
|
||||||
|
gdb_exit
|
||||||
|
if [mi_gdb_start] {
|
||||||
|
continue
|
||||||
|
}
|
||||||
|
|
||||||
|
mi_delete_breakpoints
|
||||||
|
mi_gdb_reinitialize_dir $srcdir/$subdir
|
||||||
|
mi_gdb_load ${binfile}
|
||||||
|
|
||||||
|
if ![mi_run_to_main] then {
|
||||||
|
fail "cannot run to main, testcase aborted"
|
||||||
|
return 0
|
||||||
|
}
|
||||||
|
|
||||||
|
set bp_location [gdb_get_line_number "STOP" ${testdir}/pkg.adb]
|
||||||
|
mi_continue_to_line \
|
||||||
|
"pkg.adb:$bp_location" \
|
||||||
|
"stop at start of main Ada procedure"
|
||||||
|
|
||||||
|
mi_gdb_test "-var-create r * r" \
|
||||||
|
"\\^done,name=\"r\",numchild=\"1\",.*" \
|
||||||
|
"create r varobj"
|
||||||
|
|
||||||
|
set bp_location [gdb_get_line_number "STOP2" ${testdir}/pkg.adb]
|
||||||
|
mi_continue_to_line \
|
||||||
|
"pkg.adb:$bp_location" \
|
||||||
|
"stop at second breakpoint"
|
||||||
|
|
||||||
|
mi_gdb_test "-var-update 1 r" \
|
||||||
|
"\\^done.*name=\"r\",.*new_num_children=\"2\",.*" \
|
||||||
|
"update r varobj"
|
||||||
|
}
|
|
@ -0,0 +1,54 @@
|
||||||
|
-- Copyright 2020 Free Software Foundation, Inc.
|
||||||
|
--
|
||||||
|
-- This program is free software; you can redistribute it and/or modify
|
||||||
|
-- it under the terms of the GNU General Public License as published by
|
||||||
|
-- the Free Software Foundation; either version 3 of the License, or
|
||||||
|
-- (at your option) any later version.
|
||||||
|
--
|
||||||
|
-- This program is distributed in the hope that it will be useful,
|
||||||
|
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
-- GNU General Public License for more details.
|
||||||
|
--
|
||||||
|
-- You should have received a copy of the GNU General Public License
|
||||||
|
-- along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
package Pck is
|
||||||
|
|
||||||
|
type Rec_Type (C : Character := 'd') is record
|
||||||
|
case C is
|
||||||
|
when Character'First => X_First : Integer;
|
||||||
|
when Character'Val (127) => X_127 : Integer;
|
||||||
|
when Character'Val (128) => X_128 : Integer;
|
||||||
|
when Character'Last => X_Last : Integer;
|
||||||
|
when others => null;
|
||||||
|
end case;
|
||||||
|
end record;
|
||||||
|
|
||||||
|
type Second_Type (I : Integer) is record
|
||||||
|
One: Integer;
|
||||||
|
case I is
|
||||||
|
when -5 .. 5 =>
|
||||||
|
X : Integer;
|
||||||
|
when others =>
|
||||||
|
Y : Integer;
|
||||||
|
end case;
|
||||||
|
end record;
|
||||||
|
|
||||||
|
type Nested_And_Variable (One, Two: Integer) is record
|
||||||
|
Str : String (1 .. One);
|
||||||
|
case One is
|
||||||
|
when 0 =>
|
||||||
|
null;
|
||||||
|
when others =>
|
||||||
|
OneValue : Integer;
|
||||||
|
Str2 : String (1 .. Two);
|
||||||
|
case Two is
|
||||||
|
when 0 =>
|
||||||
|
null;
|
||||||
|
when others =>
|
||||||
|
TwoValue : Integer;
|
||||||
|
end case;
|
||||||
|
end case;
|
||||||
|
end record;
|
||||||
|
end Pck;
|
|
@ -0,0 +1,28 @@
|
||||||
|
-- Copyright 2020 Free Software Foundation, Inc.
|
||||||
|
--
|
||||||
|
-- This program is free software; you can redistribute it and/or modify
|
||||||
|
-- it under the terms of the GNU General Public License as published by
|
||||||
|
-- the Free Software Foundation; either version 3 of the License, or
|
||||||
|
-- (at your option) any later version.
|
||||||
|
--
|
||||||
|
-- This program is distributed in the hope that it will be useful,
|
||||||
|
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
-- GNU General Public License for more details.
|
||||||
|
--
|
||||||
|
-- You should have received a copy of the GNU General Public License
|
||||||
|
-- along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
with Pck; use Pck;
|
||||||
|
|
||||||
|
procedure Pkg is
|
||||||
|
|
||||||
|
R : Rec_Type;
|
||||||
|
|
||||||
|
begin
|
||||||
|
R := (C => 'd');
|
||||||
|
null; -- STOP
|
||||||
|
|
||||||
|
R := (C => Character'First, X_First => 27);
|
||||||
|
null; -- STOP2
|
||||||
|
end Pkg;
|
|
@ -17,24 +17,31 @@ load_lib "ada.exp"
|
||||||
|
|
||||||
standard_ada_testfile comp_bug
|
standard_ada_testfile comp_bug
|
||||||
|
|
||||||
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } {
|
foreach_with_prefix scenario {none all minimal} {
|
||||||
return -1
|
set flags {debug}
|
||||||
|
if {$scenario != "none"} {
|
||||||
|
lappend flags additional_flags=-fgnat-encodings=$scenario
|
||||||
|
}
|
||||||
|
|
||||||
|
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} {
|
||||||
|
return -1
|
||||||
|
}
|
||||||
|
|
||||||
|
clean_restart ${testfile}
|
||||||
|
|
||||||
|
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\\)"
|
||||||
|
|
||||||
|
gdb_test "ptype x" \
|
||||||
|
[multi_line "type = record" \
|
||||||
|
" exists: (boolean|range false \\.\\. true);" \
|
||||||
|
" case exists is" \
|
||||||
|
" when true =>" \
|
||||||
|
" value: range 0 \\.\\. 255;" \
|
||||||
|
" when others => null;" \
|
||||||
|
" end case;" \
|
||||||
|
"end record" ]
|
||||||
}
|
}
|
||||||
|
|
||||||
clean_restart ${testfile}
|
|
||||||
|
|
||||||
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\\)"
|
|
||||||
|
|
||||||
gdb_test "ptype x" \
|
|
||||||
[multi_line "type = record" \
|
|
||||||
" exists: (boolean|range false \\.\\. true);" \
|
|
||||||
" case exists is" \
|
|
||||||
" when true =>" \
|
|
||||||
" value: range 0 \\.\\. 255;" \
|
|
||||||
" when others => null;" \
|
|
||||||
" end case;" \
|
|
||||||
"end record" ]
|
|
||||||
|
|
|
@ -19,15 +19,6 @@ load_lib "ada.exp"
|
||||||
|
|
||||||
standard_ada_testfile unchecked_union
|
standard_ada_testfile unchecked_union
|
||||||
|
|
||||||
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug}] != ""} {
|
|
||||||
return -1
|
|
||||||
}
|
|
||||||
|
|
||||||
clean_restart ${testfile}
|
|
||||||
|
|
||||||
set bp_location [gdb_get_line_number "BREAK" ${testdir}/unchecked_union.adb]
|
|
||||||
runto "unchecked_union.adb:$bp_location"
|
|
||||||
|
|
||||||
proc multi_line_string {str} {
|
proc multi_line_string {str} {
|
||||||
set result {}
|
set result {}
|
||||||
foreach line [split $str \n] {
|
foreach line [split $str \n] {
|
||||||
|
@ -54,5 +45,21 @@ set pair_string { case ? is
|
||||||
}
|
}
|
||||||
set pair_full "type = record\n${inner_string}${pair_string}end record"
|
set pair_full "type = record\n${inner_string}${pair_string}end record"
|
||||||
|
|
||||||
gdb_test "ptype Pair" [multi_line_string $pair_full]
|
foreach_with_prefix scenario {none all minimal} {
|
||||||
gdb_test "ptype Inner" [multi_line_string $inner_full]
|
set flags {debug}
|
||||||
|
if {$scenario != "none"} {
|
||||||
|
lappend flags additional_flags=-fgnat-encodings=$scenario
|
||||||
|
}
|
||||||
|
|
||||||
|
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} {
|
||||||
|
return -1
|
||||||
|
}
|
||||||
|
|
||||||
|
clean_restart ${testfile}
|
||||||
|
|
||||||
|
set bp_location [gdb_get_line_number "BREAK" ${testdir}/unchecked_union.adb]
|
||||||
|
runto "unchecked_union.adb:$bp_location"
|
||||||
|
|
||||||
|
gdb_test "ptype Pair" [multi_line_string $pair_full]
|
||||||
|
gdb_test "ptype Inner" [multi_line_string $inner_full]
|
||||||
|
}
|
||||||
|
|
Loading…
Reference in New Issue