aboutsummaryrefslogtreecommitdiff
path: root/gdb/testsuite/gdb.ada
diff options
context:
space:
mode:
Diffstat (limited to 'gdb/testsuite/gdb.ada')
-rw-r--r--gdb/testsuite/gdb.ada/dyn-bit-offset.exp46
-rw-r--r--gdb/testsuite/gdb.ada/dyn-bit-offset/exam.adb45
-rw-r--r--gdb/testsuite/gdb.ada/fixed_points.exp4
-rw-r--r--gdb/testsuite/gdb.ada/fixed_points/fixed_points.adb7
-rw-r--r--gdb/testsuite/gdb.ada/packed_record_2.exp61
-rw-r--r--gdb/testsuite/gdb.ada/packed_record_2/exam.adb51
-rw-r--r--gdb/testsuite/gdb.ada/task_switch_in_core.exp2
7 files changed, 215 insertions, 1 deletions
diff --git a/gdb/testsuite/gdb.ada/dyn-bit-offset.exp b/gdb/testsuite/gdb.ada/dyn-bit-offset.exp
new file mode 100644
index 0000000..19d16b1
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/dyn-bit-offset.exp
@@ -0,0 +1,46 @@
+# Copyright 2025 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"
+
+require allow_ada_tests
+
+standard_ada_testfile exam
+
+set flags {debug}
+if {[ada_minimal_encodings]} {
+ lappend flags additional_flags=-fgnat-encodings=minimal
+}
+
+if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} {
+ return -1
+}
+
+clean_restart ${testfile}
+
+set bp_location [gdb_get_line_number "STOP" ${testdir}/exam.adb]
+runto "exam.adb:$bp_location"
+
+gdb_test_multiple "print spr" "" {
+ -re -wrap " = \\(discr => 3, array_field => \\(-5, -6, -7\\), field => -4, another_field => -6\\)" {
+ pass $gdb_test_name
+ }
+ -re -wrap " = \\(discr => 3, array_field => \\(-5, -6, -7\\), field => -4, another_field => -4\\)" {
+ # A known GCC bug.
+ xfail $gdb_test_name
+ }
+}
+
+gdb_test "print spr.field" " = -4"
diff --git a/gdb/testsuite/gdb.ada/dyn-bit-offset/exam.adb b/gdb/testsuite/gdb.ada/dyn-bit-offset/exam.adb
new file mode 100644
index 0000000..a882afd
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/dyn-bit-offset/exam.adb
@@ -0,0 +1,45 @@
+-- Copyright 2025 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 Exam is
+ type Small is range -7 .. -4;
+ for Small'Size use 2;
+
+ type Packed_Array is array (Integer range <>) of Small;
+ pragma pack (Packed_Array);
+
+ subtype Range_Int is Natural range 0 .. 7;
+
+ type Some_Packed_Record (Discr : Range_Int := 3) is record
+ Array_Field : Packed_Array (1 .. Discr);
+ Field: Small;
+ case Discr is
+ when 3 =>
+ Another_Field : Small;
+ when others =>
+ null;
+ end case;
+ end record;
+ pragma Pack (Some_Packed_Record);
+ pragma No_Component_Reordering (Some_Packed_Record);
+
+ SPR : Some_Packed_Record := (Discr => 3,
+ Field => -4,
+ Another_Field => -6,
+ Array_Field => (-5, -6, -7));
+
+begin
+ null; -- STOP
+end Exam;
diff --git a/gdb/testsuite/gdb.ada/fixed_points.exp b/gdb/testsuite/gdb.ada/fixed_points.exp
index 8bb9e10..0e65004 100644
--- a/gdb/testsuite/gdb.ada/fixed_points.exp
+++ b/gdb/testsuite/gdb.ada/fixed_points.exp
@@ -90,6 +90,10 @@ foreach_gnat_encoding scenario flags {all minimal} {
# This only started working in GCC 11.
if {$scenario == "minimal" && [gnat_version_compare >= 11]} {
gdb_test "print fp5_var" " = 3e-19"
+
+ gdb_test "print Float(Object_Fixed) = Float(Semicircle_Delta * 5)" \
+ " = true" \
+ "examine object_fixed"
}
# This failed before GCC 10.
diff --git a/gdb/testsuite/gdb.ada/fixed_points/fixed_points.adb b/gdb/testsuite/gdb.ada/fixed_points/fixed_points.adb
index adab614..94a41b9 100644
--- a/gdb/testsuite/gdb.ada/fixed_points/fixed_points.adb
+++ b/gdb/testsuite/gdb.ada/fixed_points/fixed_points.adb
@@ -64,6 +64,12 @@ procedure Fixed_Points is
for Another_Type'size use 64;
Another_Fixed : Another_Type := Another_Delta * 5;
+ Semicircle_Delta : constant := 1.0/(2**31);
+ type Semicircle_Type is delta Semicircle_Delta range -1.0 .. (1.0 - Semicircle_Delta);
+ for Semicircle_Type'small use Semicircle_Delta;
+ for Semicircle_Type'size use 32;
+ Object_Fixed : Semicircle_Type := Semicircle_Delta * 5;
+
begin
Base_Object := 1.0/16.0; -- Set breakpoint here
Subtype_Object := 1.0/16.0;
@@ -75,4 +81,5 @@ begin
Do_Nothing (FP4_Var'Address);
Do_Nothing (FP5_Var'Address);
Do_Nothing (Another_Fixed'Address);
+ Do_Nothing (Object_Fixed'Address);
end Fixed_Points;
diff --git a/gdb/testsuite/gdb.ada/packed_record_2.exp b/gdb/testsuite/gdb.ada/packed_record_2.exp
new file mode 100644
index 0000000..d0bcdbd
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/packed_record_2.exp
@@ -0,0 +1,61 @@
+# Copyright 2025 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"
+
+require allow_ada_tests
+
+standard_ada_testfile exam
+
+set flags {debug}
+if {[ada_minimal_encodings]} {
+ lappend flags additional_flags=-fgnat-encodings=minimal
+}
+
+if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} {
+ return -1
+}
+
+clean_restart ${testfile}
+
+set bp_location [gdb_get_line_number "STOP" ${testdir}/exam.adb]
+runto "exam.adb:$bp_location"
+
+set spr_contents "discr => 3, field => -4, array_field => \\(-5, -6, -7\\)"
+
+gdb_test "print spr" " = \\($spr_contents\\)"
+
+gdb_test "print spr.discr" " = 3"
+
+# See PR ada/32880 -- gdb should probably print array (1 .. 3) here,
+# but instead shows array (<>). However as this isn't totally
+# relevant to this test, we just accept it.
+gdb_test "ptype spr" \
+ [multi_line \
+ "type = tagged record" \
+ " discr: range 1 .. 8;" \
+ " field: range -7 .. -4;" \
+ " array_field: array \\(<>\\) of exam.small <packed: 2-bit elements>;" \
+ "end record"]
+
+gdb_test_multiple "print sc" "" {
+ -re " \\($spr_contents, outer => 2, another_array => \\(-7, -6\\)\\)" {
+ pass $gdb_test_name
+ }
+ -re " \\($spr_contents, outer => $decimal, another_array => \\(.*\\)\\)" {
+ # Other output is a known GCC bug.
+ xfail $gdb_test_name
+ }
+}
diff --git a/gdb/testsuite/gdb.ada/packed_record_2/exam.adb b/gdb/testsuite/gdb.ada/packed_record_2/exam.adb
new file mode 100644
index 0000000..e528ecf
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/packed_record_2/exam.adb
@@ -0,0 +1,51 @@
+-- Copyright 2025 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 Exam is
+ type Small is range -7 .. -4;
+ for Small'Size use 2;
+
+ type Range_Int is range 1 .. 8;
+ for Range_Int'Size use 3;
+
+ type Packed_Array is array (Range_Int range <>) of Small;
+ pragma pack (Packed_Array);
+
+ type Some_Packed_Record (Discr : Range_Int) is tagged record
+ Field: Small;
+ Array_Field : Packed_Array (1 .. Discr);
+ end record;
+ pragma Pack (Some_Packed_Record);
+
+ type Sub_Class (Inner, Outer : Range_Int)
+ is new Some_Packed_Record (Inner) with
+ record
+ Another_Array : Packed_Array (1 .. Outer);
+ end record;
+ pragma Pack (Sub_Class);
+
+ SPR : Some_Packed_Record := (Discr => 3,
+ Field => -4,
+ Array_Field => (-5, -6, -7));
+
+ SC : Sub_Class := (Inner => 3,
+ Outer => 2,
+ Field => -4,
+ Array_Field => (-5, -6, -7),
+ Another_Array => (-7, -6));
+
+begin
+ null; -- STOP
+end Exam;
diff --git a/gdb/testsuite/gdb.ada/task_switch_in_core.exp b/gdb/testsuite/gdb.ada/task_switch_in_core.exp
index 3aafc2b..bded377 100644
--- a/gdb/testsuite/gdb.ada/task_switch_in_core.exp
+++ b/gdb/testsuite/gdb.ada/task_switch_in_core.exp
@@ -15,7 +15,7 @@
load_lib "ada.exp"
-require allow_ada_tests
+require allow_ada_tests gcore_cmd_available
standard_ada_testfile crash