From 931e5bc3e19d1e279fc28c5cf5571f812c79b8d3 Mon Sep 17 00:00:00 2001 From: Jerome Guitton Date: Thu, 26 Mar 2015 16:19:27 +0100 Subject: [PATCH] Non bit-packed packed arrays as variable-length fields In the case of non bit-packed arrays, GNAT does not generate its traditional XP encoding; it is not needed. However, it still generates the so-called "implementation type" with a P suffix. This implementation type shall be skipped when looking for other descriptive types such as XA encodings for variable-length fields. Note also that there may be an intermediate typedef between the implementation type and its XA description. It shall be skipped as well. gdb/ChangeLog: Jerome Guitton * ada-lang.c (find_parallel_type_by_descriptive_type): Go through typedefs during lookup. (to_fixed_array_type): Add support for non-bit packed arrays as variable-length fields. gdb/testsuite/ChangeLog: * gdb.ada/byte_packed_arr: New testcase. --- gdb/ChangeLog | 7 +++ gdb/ada-lang.c | 44 +++++++++++++++++-- gdb/testsuite/ChangeLog | 4 ++ gdb/testsuite/gdb.ada/byte_packed_arr.exp | 32 ++++++++++++++ .../gdb.ada/byte_packed_arr/array_list_g.ads | 27 ++++++++++++ .../gdb.ada/byte_packed_arr/reprod.adb | 22 ++++++++++ .../gdb.ada/byte_packed_arr/reprod.ads | 35 +++++++++++++++ .../gdb.ada/byte_packed_arr/reprod_main.adb | 23 ++++++++++ 8 files changed, 190 insertions(+), 4 deletions(-) create mode 100644 gdb/testsuite/gdb.ada/byte_packed_arr.exp create mode 100644 gdb/testsuite/gdb.ada/byte_packed_arr/array_list_g.ads create mode 100644 gdb/testsuite/gdb.ada/byte_packed_arr/reprod.adb create mode 100644 gdb/testsuite/gdb.ada/byte_packed_arr/reprod.ads create mode 100644 gdb/testsuite/gdb.ada/byte_packed_arr/reprod_main.adb diff --git a/gdb/ChangeLog b/gdb/ChangeLog index b7694c769c0..c1dc2d0f7c5 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,10 @@ +2015-05-15 Jerome Guitton + + * ada-lang.c (find_parallel_type_by_descriptive_type): + Go through typedefs during lookup. + (to_fixed_array_type): Add support for non-bit packed arrays + as variable-length fields. + 2015-05-15 Pedro Alves Simon Marchi diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c index e3fa3632dc8..02d82ef48cd 100644 --- a/gdb/ada-lang.c +++ b/gdb/ada-lang.c @@ -7762,7 +7762,7 @@ ada_type_name (struct type *type) static struct type * find_parallel_type_by_descriptive_type (struct type *type, const char *name) { - struct type *result; + struct type *result, *tmp; if (ada_ignore_descriptive_types_p) return NULL; @@ -7789,9 +7789,21 @@ find_parallel_type_by_descriptive_type (struct type *type, const char *name) /* Otherwise, look at the next item on the list, if any. */ if (HAVE_GNAT_AUX_INFO (result)) - result = TYPE_DESCRIPTIVE_TYPE (result); + tmp = TYPE_DESCRIPTIVE_TYPE (result); else - result = NULL; + tmp = NULL; + + /* If not found either, try after having resolved the typedef. */ + if (tmp != NULL) + result = tmp; + else + { + CHECK_TYPEDEF (result); + if (HAVE_GNAT_AUX_INFO (result)) + result = TYPE_DESCRIPTIVE_TYPE (result); + else + result = NULL; + } } /* If we didn't find a match, see whether this is a packed array. With @@ -8509,6 +8521,7 @@ to_fixed_array_type (struct type *type0, struct value *dval, struct type *index_type_desc; struct type *result; int constrained_packed_array_p; + static const char *xa_suffix = "___XA"; type0 = ada_check_typedef (type0); if (TYPE_FIXED_INSTANCE (type0)) @@ -8518,7 +8531,30 @@ to_fixed_array_type (struct type *type0, struct value *dval, if (constrained_packed_array_p) type0 = decode_constrained_packed_array_type (type0); - index_type_desc = ada_find_parallel_type (type0, "___XA"); + index_type_desc = ada_find_parallel_type (type0, xa_suffix); + + /* As mentioned in exp_dbug.ads, for non bit-packed arrays an + encoding suffixed with 'P' may still be generated. If so, + it should be used to find the XA type. */ + + if (index_type_desc == NULL) + { + const char *typename = ada_type_name (type0); + + if (typename != NULL) + { + const int len = strlen (typename); + char *name = (char *) alloca (len + strlen (xa_suffix)); + + if (typename[len - 1] == 'P') + { + strcpy (name, typename); + strcpy (name + len - 1, xa_suffix); + index_type_desc = ada_find_parallel_type_with_name (type0, name); + } + } + } + ada_fixup_array_indexes_type (index_type_desc); if (index_type_desc != NULL && ada_is_redundant_index_type_desc (type0, index_type_desc)) diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog index cc2c1565b8d..74559f4cf7b 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2015-05-15 Joel Brobecker + + * gdb.ada/byte_packed_arr: New testcase. + 2015-05-15 Joel Brobecker * gdb.ada/pckd_neg: New testcase. diff --git a/gdb/testsuite/gdb.ada/byte_packed_arr.exp b/gdb/testsuite/gdb.ada/byte_packed_arr.exp new file mode 100644 index 00000000000..1a66f599c6c --- /dev/null +++ b/gdb/testsuite/gdb.ada/byte_packed_arr.exp @@ -0,0 +1,32 @@ +# Copyright 2015 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" + +if { [skip_ada_tests] } { return -1 } + +standard_ada_testfile reprod_main + +if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug}] != ""} { + return -1 +} + +clean_restart ${testfile} + +set bp_location [gdb_get_line_number "STOP" ${testdir}/reprod.adb] +runto "reprod.adb:$bp_location" + +gdb_test "print broken" \ + " = \\(len => 1, data => \\(\\(i => 1\\)\\)\\)" diff --git a/gdb/testsuite/gdb.ada/byte_packed_arr/array_list_g.ads b/gdb/testsuite/gdb.ada/byte_packed_arr/array_list_g.ads new file mode 100644 index 00000000000..288d88fa02b --- /dev/null +++ b/gdb/testsuite/gdb.ada/byte_packed_arr/array_list_g.ads @@ -0,0 +1,27 @@ +-- Copyright 2015 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 . + +generic + type Index_Base_T is range <>; + type Component_T is private; +package Array_List_G is + + subtype Length_T is Index_Base_T range 0 .. Index_Base_T'Last; + subtype Index_T is Length_T range 1 .. Length_T'Last; + + type T is array (Index_T range <>) of Component_T; + pragma Pack(T); + +end Array_List_G; diff --git a/gdb/testsuite/gdb.ada/byte_packed_arr/reprod.adb b/gdb/testsuite/gdb.ada/byte_packed_arr/reprod.adb new file mode 100644 index 00000000000..6beacab8a70 --- /dev/null +++ b/gdb/testsuite/gdb.ada/byte_packed_arr/reprod.adb @@ -0,0 +1,22 @@ +-- Copyright 2015 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 Reprod is + + procedure Do_Nothing (Broken : Obj_T) is + begin + null; -- STOP + end Do_Nothing; +end Reprod; diff --git a/gdb/testsuite/gdb.ada/byte_packed_arr/reprod.ads b/gdb/testsuite/gdb.ada/byte_packed_arr/reprod.ads new file mode 100644 index 00000000000..9a2c325ca80 --- /dev/null +++ b/gdb/testsuite/gdb.ada/byte_packed_arr/reprod.ads @@ -0,0 +1,35 @@ +-- Copyright 2015 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 Array_List_G; + +package Reprod is + + package Objects is + type T is record + I : Integer; + end record; + package List is new Array_List_G (Index_Base_T => Natural, + Component_T => T); + end Objects; + + type Obj_T (Len : Natural) is record + Data : Objects.List.T (1 .. Len); + end record; + + type T is access Obj_T; + + procedure Do_Nothing (Broken : Obj_T); +end Reprod; diff --git a/gdb/testsuite/gdb.ada/byte_packed_arr/reprod_main.adb b/gdb/testsuite/gdb.ada/byte_packed_arr/reprod_main.adb new file mode 100644 index 00000000000..09f804f2d56 --- /dev/null +++ b/gdb/testsuite/gdb.ada/byte_packed_arr/reprod_main.adb @@ -0,0 +1,23 @@ +-- Copyright 2015 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 Reprod; use Reprod; + +procedure Reprod_Main is + O : Obj_T (Len => 1); +begin + O.Data := (others => (I => 1)); + Do_Nothing (O); +end Reprod_Main;