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.
2012-10-24 Joel Brobecker <brobecker@adacore.com>
+ * 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 <brobecker@adacore.com>
+
* doublest.c (convert_doublest_to_floatformat): Fix comparison
against maximum exponent value.
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. */
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);
}
2012-10-24 Joel Brobecker <brobecker@adacore.com>
+ * gdb.ada/set_wstr: New testcase.
+
+2012-10-24 Joel Brobecker <brobecker@adacore.com>
+
* gdb.base/ldbl_e308.c, gdb.base/ldbl_e308.exp: New files.
2012-10-24 Joel Brobecker <brobecker@adacore.com>
--- /dev/null
+# 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 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"
--- /dev/null
+-- 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 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;
--- /dev/null
+-- 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;
--- /dev/null
+-- 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;
projects / platform / upstream / binutils.git / commitdiff