diff --git a/gdb/ChangeLog b/gdb/ChangeLog index 9b905ee091b..27950c390e4 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,8 @@ +2020-11-04 Tom Tromey + + * ada-lang.c (recursively_update_array_bitsize): New function. + (decode_constrained_packed_array_type): Call it. + 2020-11-04 Tom Tromey * ada-lang.c (to_fixed_array_type): Error if diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c index 941b35f6081..93d8225ad2d 100644 --- a/gdb/ada-lang.c +++ b/gdb/ada-lang.c @@ -2139,6 +2139,35 @@ decode_constrained_packed_array_type (struct type *type) return constrained_packed_array_type (shadow_type, &bits); } +/* Helper function for decode_constrained_packed_array. Set the field + bitsize on a series of packed arrays. Returns the number of + elements in TYPE. */ + +static LONGEST +recursively_update_array_bitsize (struct type *type) +{ + gdb_assert (type->code () == TYPE_CODE_ARRAY); + + LONGEST low, high; + if (get_discrete_bounds (type->index_type (), &low, &high) < 0 + || low > high) + return 0; + LONGEST our_len = high - low + 1; + + struct type *elt_type = TYPE_TARGET_TYPE (type); + if (elt_type->code () == TYPE_CODE_ARRAY) + { + LONGEST elt_len = recursively_update_array_bitsize (elt_type); + LONGEST elt_bitsize = elt_len * TYPE_FIELD_BITSIZE (elt_type, 0); + TYPE_FIELD_BITSIZE (type, 0) = elt_bitsize; + + TYPE_LENGTH (type) = ((our_len * elt_bitsize + HOST_CHAR_BIT - 1) + / HOST_CHAR_BIT); + } + + return our_len; +} + /* Given that ARR is a struct value *indicating a GNAT constrained packed array, returns a simple array that denotes that array. Its type is a standard GDB array type except that the BITSIZEs of the array @@ -2168,6 +2197,18 @@ decode_constrained_packed_array (struct value *arr) return NULL; } + /* Decoding the packed array type could not correctly set the field + bitsizes for any dimension except the innermost, because the + bounds may be variable and were not passed to that function. So, + we further resolve the array bounds here and then update the + sizes. */ + const gdb_byte *valaddr = value_contents_for_printing (arr); + CORE_ADDR address = value_address (arr); + gdb::array_view view + = gdb::make_array_view (valaddr, TYPE_LENGTH (type)); + type = resolve_dynamic_type (type, view, address); + recursively_update_array_bitsize (type); + if (type_byte_order (value_type (arr)) == BFD_ENDIAN_BIG && ada_is_modular_type (value_type (arr))) { diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog index 0659c246f34..e9d5a23a1ed 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2020-11-04 Tom Tromey + + * gdb.ada/enum_idx_packed.exp: Add tests. + * gdb.ada/enum_idx_packed/foo.adb: Add variables. + * gdb.ada/enum_idx_packed/pck.adb: Add functions. + * gdb.ada/enum_idx_packed/pck.ads: Add types, function + declarations. + 2020-11-03 Tom de Vries * lib/dwarf.exp (Dwarf::_handle_DW_TAG): Improve attribute list diff --git a/gdb/testsuite/gdb.ada/enum_idx_packed.exp b/gdb/testsuite/gdb.ada/enum_idx_packed.exp index bfa091ec9a6..480de71b7c4 100644 --- a/gdb/testsuite/gdb.ada/enum_idx_packed.exp +++ b/gdb/testsuite/gdb.ada/enum_idx_packed.exp @@ -28,7 +28,55 @@ clean_restart ${testfile} set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb] runto "foo.adb:$bp_location" +gdb_test "ptype full" \ + "type = array \\(black \\.\\. white\\) of boolean " + gdb_test "print full" " = \\(false, true, false, true, false\\)" gdb_test "print full'first" " = black" +gdb_test "ptype primary" \ + "type = array \\(red \\.\\. blue\\) of boolean " + +gdb_test "print primary" " = \\(red => false, true, false\\)" + +gdb_test "print primary'first" " = red" + +gdb_test "ptype cold" \ + "type = array \\(green \\.\\. blue\\) of boolean " + +gdb_test "print cold" " = \\(green => false, true\\)" + +gdb_test "print cold'first" " = green" + +# Note the bounds values are still not correctly displayed. So we get +# the enum equivalent of "1 .. 0" (empty range) as the array ranges. +# Accept that for now. +gdb_test "ptype small" \ + "array \\(red \\.\\. green\\) of boolean " + +gdb_test "print small" " = \\(red => false, true\\)" + +gdb_test "print small'first" " = red" + +gdb_test "ptype multi" \ + "array \\(red \\.\\. green, low .. medium\\) of boolean " + +gdb_test "print multi" \ + " = \\(red => \\(low => true, false\\), \\(low => true, false\\)\\)" + +gdb_test "print multi'first" " = red" + +set base "\\(true, false, true, false, true, false, true, false, true, false\\)" +set matrix "\\(" +foreach x {1 2 3 4 5 6 7} { + if {$x > 1} { + append matrix ", " + } + append matrix $base +} +append matrix "\\)" + +gdb_test "print multi_multi" " = \\($matrix, $matrix\\)" +gdb_test "print multi_multi(1,3)" " = $base" +gdb_test "print multi_multi(2)" " = $matrix" diff --git a/gdb/testsuite/gdb.ada/enum_idx_packed/foo.adb b/gdb/testsuite/gdb.ada/enum_idx_packed/foo.adb index 6f142a18b00..e9f30747167 100644 --- a/gdb/testsuite/gdb.ada/enum_idx_packed/foo.adb +++ b/gdb/testsuite/gdb.ada/enum_idx_packed/foo.adb @@ -17,8 +17,16 @@ with Pck; use Pck; procedure Foo is Full : Full_Table := (False, True, False, True, False); + Primary : Primary_Table := (False, True, False); + Cold : Cold_Table := (False, True); + Small : Small_Table := New_Small_Table (Low => Red, High => Green); + Multi : Multi_Table := New_Multi_Table (Red, Green, Low, Medium); + Multi_Multi : Multi_Multi_Table := New_Multi_Multi_Table (1, 2, 1, 7, 1, 10); begin Do_Nothing (Full'Address); -- STOP + Do_Nothing (Primary'Address); + Do_Nothing (Cold'Address); + Do_Nothing (Small'Address); + Do_Nothing (Multi'Address); + Do_Nothing (Multi_Multi'Address); end Foo; - - diff --git a/gdb/testsuite/gdb.ada/enum_idx_packed/pck.adb b/gdb/testsuite/gdb.ada/enum_idx_packed/pck.adb index 5b18de9952b..a4e04747526 100644 --- a/gdb/testsuite/gdb.ada/enum_idx_packed/pck.adb +++ b/gdb/testsuite/gdb.ada/enum_idx_packed/pck.adb @@ -14,6 +14,46 @@ -- along with this program. If not, see . package body Pck is + + function New_Small_Table (Low: Color; High: Color) return Small_Table is + Result : Small_Table (Low .. High); + begin + for J in Low .. High loop + Result (J) := (J = Black or J = Green or J = White); + end loop; + return Result; + end New_Small_Table; + + function New_Multi_Table (Low, High: Color; LS, HS: Strength) + return Multi_Table is + Result : Multi_Table (Low .. High, LS .. HS); + Next : Boolean := True; + begin + for J in Low .. High loop + for K in LS .. HS loop + Result (J, K) := Next; + Next := not Next; + end loop; + end loop; + return Result; + end New_Multi_Table; + + function New_Multi_Multi_Table (L1, H1, L2, H2, L3, H3: Positive) + return Multi_Multi_Table is + Result : Multi_Multi_Table (L1 .. H1, L2 .. H2, L3 .. H3); + Next : Boolean := True; + begin + for J in L1 .. H1 loop + for K in L2 .. H2 loop + for L in L3 .. H3 loop + Result (J, K, L) := Next; + Next := not Next; + end loop; + end loop; + end loop; + return Result; + end New_Multi_Multi_Table; + procedure Do_Nothing (A : System.Address) is begin null; diff --git a/gdb/testsuite/gdb.ada/enum_idx_packed/pck.ads b/gdb/testsuite/gdb.ada/enum_idx_packed/pck.ads index c8f5b00d5c0..fdfd8bbc4c6 100644 --- a/gdb/testsuite/gdb.ada/enum_idx_packed/pck.ads +++ b/gdb/testsuite/gdb.ada/enum_idx_packed/pck.ads @@ -16,8 +16,32 @@ with System; package Pck is type Color is (Black, Red, Green, Blue, White); + type Strength is (None, Low, Medium, High); + type Full_Table is array (Color) of Boolean; pragma Pack (Full_Table); + subtype Primary_Color is Color range Red .. Blue; + type Primary_Table is array (Primary_Color) of Boolean; + pragma Pack (Primary_Table); + + type Cold_Color is new Color range Green .. Blue; + type Cold_Table is array (Cold_Color) of Boolean; + pragma Pack (Cold_Table); + + type Small_Table is array (Color range <>) of Boolean; + pragma Pack (Small_Table); + function New_Small_Table (Low: Color; High: Color) return Small_Table; + + type Multi_Table is array (Color range <>, Strength range <>) of Boolean; + pragma Pack (Multi_Table); + function New_Multi_Table (Low, High: Color; LS, HS: Strength) + return Multi_Table; + + type Multi_Multi_Table is array (Positive range <>, Positive range <>, Positive range <>) of Boolean; + pragma Pack (Multi_Multi_Table); + function New_Multi_Multi_Table (L1, H1, L2, H2, L3, H3: Positive) + return Multi_Multi_Table; + procedure Do_Nothing (A : System.Address); end Pck;