[09/11] Add tests for Ada changes

Message ID 20200408175452.30637-10-tromey@adacore.com
State New
Headers show
Series
  • Variant part support, plus more
Related show

Commit Message

Tom Tromey April 8, 2020, 5:54 p.m.
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-08  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.
---
 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

-- 
2.21.1

Patch

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 <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"
+}
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 <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;
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 <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;
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]
+}