From 5ded533171a924509f15f951c50d54d5c56389ca Mon Sep 17 00:00:00 2001 From: Joel Brobecker Date: Wed, 24 Oct 2012 18:06:10 +0000 Subject: [PATCH] [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. --- gdb/ChangeLog | 6 ++ gdb/ada-lang.c | 38 +++++---- gdb/testsuite/ChangeLog | 4 + .../gdb.ada/unc_arr_ptr_in_var_rec.exp | 84 +++++++++++++++++++ .../gdb.ada/unc_arr_ptr_in_var_rec/foo.adb | 51 +++++++++++ .../gdb.ada/unc_arr_ptr_in_var_rec/pck.adb | 21 +++++ .../gdb.ada/unc_arr_ptr_in_var_rec/pck.ads | 19 +++++ 7 files changed, 209 insertions(+), 14 deletions(-) create mode 100644 gdb/testsuite/gdb.ada/unc_arr_ptr_in_var_rec.exp create mode 100644 gdb/testsuite/gdb.ada/unc_arr_ptr_in_var_rec/foo.adb create mode 100644 gdb/testsuite/gdb.ada/unc_arr_ptr_in_var_rec/pck.adb create mode 100644 gdb/testsuite/gdb.ada/unc_arr_ptr_in_var_rec/pck.ads diff --git a/gdb/ChangeLog b/gdb/ChangeLog index b5b0cbccf90..6f2fb0c1d6d 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,9 @@ +2012-10-24 Joel Brobecker + + * 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 PR gdb/12783 diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c index f45815f7686..9f329df0cd2 100644 --- a/gdb/ada-lang.c +++ b/gdb/ada-lang.c @@ -7504,25 +7504,35 @@ ada_template_to_fixed_record_type_1 (struct type *type, } else { - struct type *field_type = TYPE_FIELD_TYPE (type, f); - - /* 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; + /* Note: If this field's type is a typedef, it is important + to preserve the typedef layer. + + 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; diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog index e4f5657ff41..a7a11803651 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2012-10-24 Joel Brobecker + + * gdb.ada/unc_arr_ptr_in_var_rec: New testcase. + 2012-10-24 Mark Kettenis * gdb.base/callfuncs.exp: PR gdb/12783 is now fixed. diff --git a/gdb/testsuite/gdb.ada/unc_arr_ptr_in_var_rec.exp b/gdb/testsuite/gdb.ada/unc_arr_ptr_in_var_rec.exp new file mode 100644 index 00000000000..dc9e86319df --- /dev/null +++ b/gdb/testsuite/gdb.ada/unc_arr_ptr_in_var_rec.exp @@ -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 . + +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\\)" + diff --git a/gdb/testsuite/gdb.ada/unc_arr_ptr_in_var_rec/foo.adb b/gdb/testsuite/gdb.ada/unc_arr_ptr_in_var_rec/foo.adb new file mode 100644 index 00000000000..0b5e4f2be82 --- /dev/null +++ b/gdb/testsuite/gdb.ada/unc_arr_ptr_in_var_rec/foo.adb @@ -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 . + +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; + diff --git a/gdb/testsuite/gdb.ada/unc_arr_ptr_in_var_rec/pck.adb b/gdb/testsuite/gdb.ada/unc_arr_ptr_in_var_rec/pck.adb new file mode 100644 index 00000000000..1f7d45cf5e2 --- /dev/null +++ b/gdb/testsuite/gdb.ada/unc_arr_ptr_in_var_rec/pck.adb @@ -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 . + +package body Pck is + procedure Do_Nothing (A : System.Address) is + begin + null; + end Do_Nothing; +end Pck; diff --git a/gdb/testsuite/gdb.ada/unc_arr_ptr_in_var_rec/pck.ads b/gdb/testsuite/gdb.ada/unc_arr_ptr_in_var_rec/pck.ads new file mode 100644 index 00000000000..c20c0d81d74 --- /dev/null +++ b/gdb/testsuite/gdb.ada/unc_arr_ptr_in_var_rec/pck.ads @@ -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 . + +with System; +package Pck is + procedure Do_Nothing (A : System.Address); +end Pck; -- 2.30.2