From d99dcf51e1ace49b2e69fa72d2f9d0a048faa0de Mon Sep 17 00:00:00 2001 From: Joel Brobecker Date: Wed, 24 Oct 2012 18:14:23 +0000 Subject: [PATCH] [Ada] Allow assignment to wide string. Given the following variable declaration... Www : Wide_String := "12345"; ... this patch allows the following assignment to work: (gdb) set variable www := "qwert" Without this patch, the debugger rejects the assignment because the size of the array elements are different: (gdb) set www := "asdfg" Incompatible types in assignment (on the lhs, we have an array of 2-bytes elements, and on the rhs, we have a standard 1-byte string). gdb/ChangeLog: * ada-lang.c (ada_same_array_size_p): New function. (ada_promote_array_of_integrals): New function. (coerce_for_assign): Add handling of arrays where the elements are integrals of a smaller size than the size of the target array element type. gdb/testsuite/ChangeLog: * gdb.ada/set_wstr: New testcase. --- gdb/ChangeLog | 8 ++++ gdb/ada-lang.c | 84 ++++++++++++++++++++++++++++++++-- gdb/testsuite/ChangeLog | 4 ++ gdb/testsuite/gdb.ada/set_wstr.exp | 74 ++++++++++++++++++++++++++++++ gdb/testsuite/gdb.ada/set_wstr/a.adb | 26 +++++++++++ gdb/testsuite/gdb.ada/set_wstr/pck.adb | 21 +++++++++ gdb/testsuite/gdb.ada/set_wstr/pck.ads | 19 ++++++++ 7 files changed, 233 insertions(+), 3 deletions(-) create mode 100644 gdb/testsuite/gdb.ada/set_wstr.exp create mode 100644 gdb/testsuite/gdb.ada/set_wstr/a.adb create mode 100644 gdb/testsuite/gdb.ada/set_wstr/pck.adb create mode 100644 gdb/testsuite/gdb.ada/set_wstr/pck.ads diff --git a/gdb/ChangeLog b/gdb/ChangeLog index 20ab7a9..55ad4d9 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,5 +1,13 @@ 2012-10-24 Joel Brobecker + * ada-lang.c (ada_same_array_size_p): New function. + (ada_promote_array_of_integrals): New function. + (coerce_for_assign): Add handling of arrays where the elements + are integrals of a smaller size than the size of the target + array element type. + +2012-10-24 Joel Brobecker + * doublest.c (convert_doublest_to_floatformat): Fix comparison against maximum exponent value. diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c index 9f329df..edef6bd 100644 --- a/gdb/ada-lang.c +++ b/gdb/ada-lang.c @@ -8629,6 +8629,72 @@ cast_from_fixed (struct type *type, struct value *arg) return value_from_double (type, val); } +/* Given two array types T1 and T2, return nonzero iff both arrays + contain the same number of elements. */ + +static int +ada_same_array_size_p (struct type *t1, struct type *t2) +{ + LONGEST lo1, hi1, lo2, hi2; + + /* Get the array bounds in order to verify that the size of + the two arrays match. */ + if (!get_array_bounds (t1, &lo1, &hi1) + || !get_array_bounds (t2, &lo2, &hi2)) + error (_("unable to determine array bounds")); + + /* To make things easier for size comparison, normalize a bit + the case of empty arrays by making sure that the difference + between upper bound and lower bound is always -1. */ + if (lo1 > hi1) + hi1 = lo1 - 1; + if (lo2 > hi2) + hi2 = lo2 - 1; + + return (hi1 - lo1 == hi2 - lo2); +} + +/* Assuming that VAL is an array of integrals, and TYPE represents + an array with the same number of elements, but with wider integral + elements, return an array "casted" to TYPE. In practice, this + means that the returned array is built by casting each element + of the original array into TYPE's (wider) element type. */ + +static struct value * +ada_promote_array_of_integrals (struct type *type, struct value *val) +{ + struct type *elt_type = TYPE_TARGET_TYPE (type); + LONGEST lo, hi; + struct value *res; + LONGEST i; + + /* Verify that both val and type are arrays of scalars, and + that the size of val's elements is smaller than the size + of type's element. */ + gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY); + gdb_assert (is_integral_type (TYPE_TARGET_TYPE (type))); + gdb_assert (TYPE_CODE (value_type (val)) == TYPE_CODE_ARRAY); + gdb_assert (is_integral_type (TYPE_TARGET_TYPE (value_type (val)))); + gdb_assert (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) + > TYPE_LENGTH (TYPE_TARGET_TYPE (value_type (val)))); + + if (!get_array_bounds (type, &lo, &hi)) + error (_("unable to determine array bounds")); + + res = allocate_value (type); + + /* Promote each array element. */ + for (i = 0; i < hi - lo + 1; i++) + { + struct value *elt = value_cast (elt_type, value_subscript (val, lo + i)); + + memcpy (value_contents_writeable (res) + (i * TYPE_LENGTH (elt_type)), + value_contents_all (elt), TYPE_LENGTH (elt_type)); + } + + return res; +} + /* Coerce VAL as necessary for assignment to an lval of type TYPE, and return the converted value. */ @@ -8653,9 +8719,21 @@ coerce_for_assign (struct type *type, struct value *val) if (TYPE_CODE (type2) == TYPE_CODE_ARRAY && TYPE_CODE (type) == TYPE_CODE_ARRAY) { - if (TYPE_LENGTH (type2) != TYPE_LENGTH (type) - || TYPE_LENGTH (TYPE_TARGET_TYPE (type2)) - != TYPE_LENGTH (TYPE_TARGET_TYPE (type2))) + if (!ada_same_array_size_p (type, type2)) + error (_("cannot assign arrays of different length")); + + if (is_integral_type (TYPE_TARGET_TYPE (type)) + && is_integral_type (TYPE_TARGET_TYPE (type2)) + && TYPE_LENGTH (TYPE_TARGET_TYPE (type2)) + < TYPE_LENGTH (TYPE_TARGET_TYPE (type))) + { + /* Allow implicit promotion of the array elements to + a wider type. */ + return ada_promote_array_of_integrals (type, val); + } + + if (TYPE_LENGTH (TYPE_TARGET_TYPE (type2)) + != TYPE_LENGTH (TYPE_TARGET_TYPE (type))) error (_("Incompatible types in assignment")); deprecated_set_value_type (val, type); } diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog index 633c0ab..5e769c2 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,5 +1,9 @@ 2012-10-24 Joel Brobecker + * gdb.ada/set_wstr: New testcase. + +2012-10-24 Joel Brobecker + * gdb.base/ldbl_e308.c, gdb.base/ldbl_e308.exp: New files. 2012-10-24 Joel Brobecker diff --git a/gdb/testsuite/gdb.ada/set_wstr.exp b/gdb/testsuite/gdb.ada/set_wstr.exp new file mode 100644 index 0000000..0a257be --- /dev/null +++ b/gdb/testsuite/gdb.ada/set_wstr.exp @@ -0,0 +1,74 @@ +# 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 a + +if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } { + return -1 +} + +clean_restart ${testfile} + +set bp_location [gdb_get_line_number "STOP" ${testdir}/a.adb] +if ![runto "a.adb:$bp_location" ] then { + perror "Couldn't run ${testfile}" + return +} + +# Verify that assigning to Nnn (a basic string) works... + +gdb_test "print nnn" \ + "= \"12345\"" \ + "print nnn before assignment" + +gdb_test_no_output "set variable nnn := \"qcyom\"" + +gdb_test "print nnn" \ + "= \"qcyom\"" \ + "print nnn after assignment" + +# Same with Www (a wide string)... + +gdb_test "print www" \ + "= \"12345\"" \ + "print www before assignment" + +gdb_test_no_output "set variable www := \"zenrk\"" + +gdb_test "print www" \ + "= \"zenrk\"" \ + "print www after assignment" + +# Same with Rws (a wide wide string)... + +gdb_test "print rws" \ + "= \"12345\"" \ + "print rws before assignment" + +gdb_test_no_output "set variable rws := \"ndhci\"" + +gdb_test "print rws" \ + "= \"ndhci\"" \ + "print rws after assignment" + +# Also, check that GDB doesn't get tricked if we assign to Www a +# string twice the length of Www. The debugger should reject the +# assignment, because the array lengths are different (the debugger +# used to get tricked because the array size was the same). + +gdb_test "set variable www := \"1#2#3#4#5#\"" \ + "cannot assign arrays of different length" diff --git a/gdb/testsuite/gdb.ada/set_wstr/a.adb b/gdb/testsuite/gdb.ada/set_wstr/a.adb new file mode 100644 index 0000000..e1b9bd8 --- /dev/null +++ b/gdb/testsuite/gdb.ada/set_wstr/a.adb @@ -0,0 +1,26 @@ +-- 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 A is + Nnn : String := "12345"; + Www : Wide_String := "12345"; + Rws : Wide_Wide_String := "12345"; +begin + Do_Nothing (Nnn'Address); -- STOP + Do_Nothing (Www'Address); + Do_Nothing (Rws'Address); +end A; diff --git a/gdb/testsuite/gdb.ada/set_wstr/pck.adb b/gdb/testsuite/gdb.ada/set_wstr/pck.adb new file mode 100644 index 0000000..1f7d45c --- /dev/null +++ b/gdb/testsuite/gdb.ada/set_wstr/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/set_wstr/pck.ads b/gdb/testsuite/gdb.ada/set_wstr/pck.ads new file mode 100644 index 0000000..c20c0d8 --- /dev/null +++ b/gdb/testsuite/gdb.ada/set_wstr/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.7.4