From adfb981595c1ea12736b6d3c4686973040f171ff Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Fri, 24 Apr 2020 13:40:31 -0600 Subject: [PATCH] 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 * 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. --- gdb/testsuite/ChangeLog | 11 ++++ gdb/testsuite/gdb.ada/mi_var_array.exp | 69 +++++++++++++---------- gdb/testsuite/gdb.ada/mi_var_union.exp | 65 +++++++++++---------- gdb/testsuite/gdb.ada/mi_variant.exp | 65 +++++++++++++++++++++ gdb/testsuite/gdb.ada/mi_variant/pck.ads | 54 ++++++++++++++++++ gdb/testsuite/gdb.ada/mi_variant/pkg.adb | 28 +++++++++ gdb/testsuite/gdb.ada/packed_tagged.exp | 41 ++++++++------ gdb/testsuite/gdb.ada/unchecked_union.exp | 29 ++++++---- 8 files changed, 276 insertions(+), 86 deletions(-) create mode 100644 gdb/testsuite/gdb.ada/mi_variant.exp create mode 100644 gdb/testsuite/gdb.ada/mi_variant/pck.ads create mode 100644 gdb/testsuite/gdb.ada/mi_variant/pkg.adb diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog index 4e7dfacc4a1..daeed54886d 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,3 +1,14 @@ +2020-04-24 Tom Tromey + + * 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 * gdb.ada/variant.exp: Add dynamic field offset tests. diff --git a/gdb/testsuite/gdb.ada/mi_var_array.exp b/gdb/testsuite/gdb.ada/mi_var_array.exp index e0980c6a2d6..646ebd196f6 100644 --- a/gdb/testsuite/gdb.ada/mi_var_array.exp +++ b/gdb/testsuite/gdb.ada/mi_var_array.exp @@ -17,36 +17,47 @@ load_lib "ada.exp" 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" diff --git a/gdb/testsuite/gdb.ada/mi_var_union.exp b/gdb/testsuite/gdb.ada/mi_var_union.exp index c5f43b4c5d2..7619d86d273 100644 --- a/gdb/testsuite/gdb.ada/mi_var_union.exp +++ b/gdb/testsuite/gdb.ada/mi_var_union.exp @@ -17,38 +17,45 @@ load_lib "ada.exp" 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" diff --git a/gdb/testsuite/gdb.ada/mi_variant.exp b/gdb/testsuite/gdb.ada/mi_variant.exp new file mode 100644 index 00000000000..ac9ece7303c --- /dev/null +++ b/gdb/testsuite/gdb.ada/mi_variant.exp @@ -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 . + +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" +} diff --git a/gdb/testsuite/gdb.ada/mi_variant/pck.ads b/gdb/testsuite/gdb.ada/mi_variant/pck.ads new file mode 100644 index 00000000000..3895b9c48eb --- /dev/null +++ b/gdb/testsuite/gdb.ada/mi_variant/pck.ads @@ -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 . + +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; diff --git a/gdb/testsuite/gdb.ada/mi_variant/pkg.adb b/gdb/testsuite/gdb.ada/mi_variant/pkg.adb new file mode 100644 index 00000000000..ffa8e5e070b --- /dev/null +++ b/gdb/testsuite/gdb.ada/mi_variant/pkg.adb @@ -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 . + +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; diff --git a/gdb/testsuite/gdb.ada/packed_tagged.exp b/gdb/testsuite/gdb.ada/packed_tagged.exp index 2670dad6046..72ae29c08d4 100644 --- a/gdb/testsuite/gdb.ada/packed_tagged.exp +++ b/gdb/testsuite/gdb.ada/packed_tagged.exp @@ -17,24 +17,31 @@ load_lib "ada.exp" 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" ] +} diff --git a/gdb/testsuite/gdb.ada/unchecked_union.exp b/gdb/testsuite/gdb.ada/unchecked_union.exp index 87a27d286c7..c85d7c33153 100644 --- a/gdb/testsuite/gdb.ada/unchecked_union.exp +++ b/gdb/testsuite/gdb.ada/unchecked_union.exp @@ -19,15 +19,6 @@ load_lib "ada.exp" 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] { @@ -54,5 +45,21 @@ set pair_string { case ? is } 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] +} -- 2.30.2