+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>
* gdb.ada/variant.exp: Add dynamic field offset tests.
standard_ada_testfile bar
-if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } {
- return -1
-}
-
load_lib mi-support.exp
set MIFLAGS "-i=mi"
-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
+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}/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"
}
-
-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"
standard_ada_testfile bar
-if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } {
- return -1
-}
-
load_lib mi-support.exp
set MIFLAGS "-i=mi"
-gdb_exit
-if [mi_gdb_start] {
- continue
-}
-
set float "\\-?((\[0-9\]+(\\.\[0-9\]+)?(e\[-+\]\[0-9\]+)?)|(nan\\($hex\\)))"
-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
+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}/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"
--- /dev/null
+# 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"
+}
--- /dev/null
+-- 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;
--- /dev/null
+-- 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;
standard_ada_testfile comp_bug
-if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } {
- return -1
-}
+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
+ }
-clean_restart ${testfile}
+ clean_restart ${testfile}
-set bp_location [gdb_get_line_number "STOP" ${testdir}/comp_bug.adb]
-runto "comp_bug.adb:$bp_location"
+ 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 "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" ]
+ 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" ]
+}
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} {
set result {}
foreach line [split $str \n] {
}
set pair_full "type = record\n${inner_string}${pair_string}end record"
-gdb_test "ptype Pair" [multi_line_string $pair_full]
-gdb_test "ptype Inner" [multi_line_string $inner_full]
+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
+ }
+
+ 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]
+}
projects / binutils-gdb.git / commitdiff