[Ada] Pointers to unconstrained arrays inside variant record.
gdb/ChangeLog:
* ada-lang.c (ada_template_to_fixed_record_type_1): Do not
strip typedef layer when computing the fixed type's field type,
only when computing its size.
gdb/testsuite/ChangeLog:
* gdb.ada/unc_arr_ptr_in_var_rec: New testcase.
This commit is contained in:
Joel Brobecker
parent
d8d842913d
commit
5ded533171
|
|
@ -1,3 +1,9 @@
|
|||
2012-10-24 Joel Brobecker <brobecker@adacore.com>
|
||||
|
||||
* ada-lang.c (ada_template_to_fixed_record_type_1): Do not
|
||||
strip typedef layer when computing the fixed type's field type,
|
||||
only when computing its size.
|
||||
|
||||
2012-10-24 Mark Kettenis <kettenis@gnu.org>
|
||||
|
||||
PR gdb/12783
|
||||
|
|
|
|||
|
|
@ -7504,25 +7504,35 @@ ada_template_to_fixed_record_type_1 (struct type *type,
|
|||
}
|
||||
else
|
||||
{
|
||||
struct type *field_type = TYPE_FIELD_TYPE (type, f);
|
||||
/* Note: If this field's type is a typedef, it is important
|
||||
to preserve the typedef layer.
|
||||
|
||||
/* If our field is a typedef type (most likely a typedef of
|
||||
a fat pointer, encoding an array access), then we need to
|
||||
look at its target type to determine its characteristics.
|
||||
In particular, we would miscompute the field size if we took
|
||||
the size of the typedef (zero), instead of the size of
|
||||
the target type. */
|
||||
if (TYPE_CODE (field_type) == TYPE_CODE_TYPEDEF)
|
||||
field_type = ada_typedef_target_type (field_type);
|
||||
|
||||
TYPE_FIELD_TYPE (rtype, f) = field_type;
|
||||
Otherwise, we might be transforming a typedef to a fat
|
||||
pointer (encoding a pointer to an unconstrained array),
|
||||
into a basic fat pointer (encoding an unconstrained
|
||||
array). As both types are implemented using the same
|
||||
structure, the typedef is the only clue which allows us
|
||||
to distinguish between the two options. Stripping it
|
||||
would prevent us from printing this field appropriately. */
|
||||
TYPE_FIELD_TYPE (rtype, f) = TYPE_FIELD_TYPE (type, f);
|
||||
TYPE_FIELD_NAME (rtype, f) = TYPE_FIELD_NAME (type, f);
|
||||
if (TYPE_FIELD_BITSIZE (type, f) > 0)
|
||||
fld_bit_len =
|
||||
TYPE_FIELD_BITSIZE (rtype, f) = TYPE_FIELD_BITSIZE (type, f);
|
||||
else
|
||||
fld_bit_len =
|
||||
TYPE_LENGTH (ada_check_typedef (field_type)) * TARGET_CHAR_BIT;
|
||||
{
|
||||
struct type *field_type = TYPE_FIELD_TYPE (type, f);
|
||||
|
||||
/* We need to be careful of typedefs when computing
|
||||
the length of our field. If this is a typedef,
|
||||
get the length of the target type, not the length
|
||||
of the typedef. */
|
||||
if (TYPE_CODE (field_type) == TYPE_CODE_TYPEDEF)
|
||||
field_type = ada_typedef_target_type (field_type);
|
||||
|
||||
fld_bit_len =
|
||||
TYPE_LENGTH (ada_check_typedef (field_type)) * TARGET_CHAR_BIT;
|
||||
}
|
||||
}
|
||||
if (off + fld_bit_len > bit_len)
|
||||
bit_len = off + fld_bit_len;
|
||||
|
|
|
|||
|
|
@ -1,3 +1,7 @@
|
|||
2012-10-24 Joel Brobecker <brobecker@adacore.com>
|
||||
|
||||
* gdb.ada/unc_arr_ptr_in_var_rec: New testcase.
|
||||
|
||||
2012-10-24 Mark Kettenis <kettenis@gnu.org>
|
||||
|
||||
* gdb.base/callfuncs.exp: PR gdb/12783 is now fixed.
|
||||
|
|
|
|||
|
|
@ -0,0 +1,84 @@
|
|||
# Copyright 2012 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"
|
||||
|
||||
standard_ada_testfile foo
|
||||
|
||||
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } {
|
||||
return -1
|
||||
}
|
||||
|
||||
clean_restart ${testfile}
|
||||
|
||||
set bp_location [gdb_get_line_number "STOP1" ${testdir}/foo.adb]
|
||||
runto "foo.adb:$bp_location"
|
||||
|
||||
# Print My_Object and My_Object.Ptr when Ptr is null...
|
||||
|
||||
gdb_test "print my_object" \
|
||||
"= \\(n => 3, ptr => 0x0, data => \\(3, 5, 8\\)\\)" \
|
||||
"print My_Object with null Ptr"
|
||||
|
||||
gdb_test "print my_object.ptr" \
|
||||
"= \\(foo.table_access\\) 0x0" \
|
||||
"print My_Object.Ptr when null"
|
||||
|
||||
# Same for My_P_Object...
|
||||
|
||||
gdb_test "print my_p_object" \
|
||||
"= \\(n => 3, ptr => 0x0, data => \\(3, 5, 8\\)\\)" \
|
||||
"print My_P_Object with null Ptr"
|
||||
|
||||
gdb_test "print my_p_object.ptr" \
|
||||
"\\(foo.p_table_access\\) 0x0" \
|
||||
"print My_P_Object.Ptr when null"
|
||||
|
||||
# Continue until the Ptr component of both objects get allocated.
|
||||
|
||||
set bp_location [gdb_get_line_number "STOP2" ${testdir}/foo.adb]
|
||||
|
||||
gdb_breakpoint "foo.adb:$bp_location"
|
||||
|
||||
gdb_test "continue" \
|
||||
"Breakpoint $decimal, foo \\(\\) at .*foo.adb:$decimal.*" \
|
||||
"continue to STOP2"
|
||||
|
||||
# Inspect My_Object again...
|
||||
|
||||
gdb_test "print my_object" \
|
||||
"= \\(n => 3, ptr => $hex, data => \\(3, 5, 8\\)\\)" \
|
||||
"print my_object after setting Ptr"
|
||||
|
||||
gdb_test "print my_object.ptr" \
|
||||
"\\(foo.table_access\\) $hex" \
|
||||
"print My_P_Object.Ptr when no longer null"
|
||||
|
||||
gdb_test "print my_object.ptr.all" \
|
||||
"= \\(13, 21, 34\\)"
|
||||
|
||||
# Same with My_P_Object...
|
||||
|
||||
gdb_test "print my_p_object" \
|
||||
"= \\(n => 3, ptr => $hex, data => \\(3, 5, 8\\)\\)" \
|
||||
"print my_p_object after setting Ptr"
|
||||
|
||||
gdb_test "print my_p_object.ptr" \
|
||||
"= \\(foo.p_table_access\\) $hex" \
|
||||
"print My_P_Object.Ptr when no longer null"
|
||||
|
||||
gdb_test "print my_p_object.ptr.all" \
|
||||
"\\(13, 21, 34\\)"
|
||||
|
||||
|
|
@ -0,0 +1,51 @@
|
|||
-- Copyright 2012 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 Foo is
|
||||
|
||||
type Table is array (Positive range <>) of Integer;
|
||||
type Table_Access is access Table;
|
||||
|
||||
type Object (N : Integer) is record
|
||||
Ptr : Table_Access;
|
||||
Data : Table (1 .. N);
|
||||
end record;
|
||||
|
||||
My_Object : Object := (N => 3, Ptr => null, Data => (3, 5, 8));
|
||||
|
||||
-- Same as above, but with a pointer to an unconstrained packed array.
|
||||
|
||||
type Byte is range 0 .. 255;
|
||||
|
||||
type P_Table is array (Positive range <>) of Byte;
|
||||
pragma Pack (P_Table);
|
||||
type P_Table_Access is access P_Table;
|
||||
|
||||
type P_Object (N : Integer) is record
|
||||
Ptr : P_Table_Access;
|
||||
Data : P_Table (1 .. N);
|
||||
end record;
|
||||
|
||||
My_P_Object : P_Object := (N => 3, Ptr => null, Data => (3, 5, 8));
|
||||
|
||||
begin
|
||||
My_Object.Ptr := new Table'(13, 21, 34); -- STOP1
|
||||
My_P_Object.Ptr := new P_Table'(13, 21, 34);
|
||||
Do_Nothing (My_Object'Address); -- STOP2
|
||||
Do_Nothing (My_P_Object'Address);
|
||||
end Foo;
|
||||
|
||||
|
|
@ -0,0 +1,21 @@
|
|||
-- Copyright 2012 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 body Pck is
|
||||
procedure Do_Nothing (A : System.Address) is
|
||||
begin
|
||||
null;
|
||||
end Do_Nothing;
|
||||
end Pck;
|
||||
|
|
@ -0,0 +1,19 @@
|
|||
-- Copyright 2012 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 System;
|
||||
package Pck is
|
||||
procedure Do_Nothing (A : System.Address);
|
||||
end Pck;
|
||||
Loading…
Reference in New Issue