From patchwork Thu Sep 3 10:15:58 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Pierre-Marie de Rodat X-Patchwork-Id: 8560 Received: (qmail 27880 invoked by alias); 3 Sep 2015 10:16:07 -0000 Mailing-List: contact gdb-patches-help@sourceware.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Subscribe: List-Archive: List-Post: List-Help: , Sender: gdb-patches-owner@sourceware.org Delivered-To: mailing list gdb-patches@sourceware.org Received: (qmail 27868 invoked by uid 89); 3 Sep 2015 10:16:06 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-1.1 required=5.0 tests=AWL, BAYES_00, KAM_LAZY_DOMAIN_SECURITY, RCVD_IN_DNSWL_LOW autolearn=no version=3.3.2 X-HELO: smtp.eu.adacore.com Received: from mel.act-europe.fr (HELO smtp.eu.adacore.com) (194.98.77.210) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-GCM-SHA384 encrypted) ESMTPS; Thu, 03 Sep 2015 10:16:05 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id 4FD8A28F43D1; Thu, 3 Sep 2015 12:16:02 +0200 (CEST) Received: from smtp.eu.adacore.com ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id RmJtMr9497ZP; Thu, 3 Sep 2015 12:16:02 +0200 (CEST) Received: from cacatoes.localdomain (nat75-2-78-193-84-173.fbxo.proxad.net [78.193.84.173]) (using TLSv1.2 with cipher ECDHE-RSA-AES128-SHA256 (128/128 bits)) (No client certificate requested) by smtp.eu.adacore.com (Postfix) with ESMTPSA id 3866D28F43CE; Thu, 3 Sep 2015 12:16:02 +0200 (CEST) From: Pierre-Marie de Rodat To: gdb-patches@sourceware.org Cc: Pierre-Marie de Rodat Subject: [PATCH] [Ada] Make string_char_type a true TYPE_CODE_CHAR type in Ada Date: Thu, 3 Sep 2015 12:15:58 +0200 Message-Id: <1441275358-19855-1-git-send-email-derodat@adacore.com> X-IsSubscribed: yes Before this change, trying to call an overloaded function with at least one character literal in argument would fail. For instance, given these two functions: function F (C : Character) return Integer is begin return Character'Pos (C); end F; function F (I : Integer) return Integer is begin return -I; end F; We would get the following GDB session: (gdb) p f('A') $1 = -65 (gdb) p f(1) $1 = -1 This is wrong because the first call should select the first F function and thus return 65. The root problem is that ada-lang.c:ada_language_arch_info stores in string_char_type a type whose code is TYPE_CODE_INT instead of TYPE_CODE_CHAR. As a result, all parsed character literals are turned into integer values and during overload matching, the TYPE_CODE_CHAR formal rejects the TYPE_CODE_INT actual. This change turns string_char_type into a true TYPE_CODE_CHAR type in ada-lang.c so that we have instead the expected: (gdb) p f('A') $1 = 65 gdb/ChangeLog: * ada-lang.c (ada_language_arch_info): Create a TYPE_CODE_CHAR type instead of a TYPE_CODE_INT one for the string_char_type and the ada_primitive_type_char types. gdb/testsuite/ChangeLog: * gdb.ada/funcall_char.exp: New testcase. * gdb.ada/funcall_char/foo.adb: New file. Tested on x86_64-linux, no regression. --- gdb/ada-lang.c | 2 +- gdb/testsuite/gdb.ada/funcall_char.exp | 32 +++++++++++++++++++++++++++++ gdb/testsuite/gdb.ada/funcall_char/foo.adb | 33 ++++++++++++++++++++++++++++++ 3 files changed, 66 insertions(+), 1 deletion(-) create mode 100644 gdb/testsuite/gdb.ada/funcall_char.exp create mode 100644 gdb/testsuite/gdb.ada/funcall_char/foo.adb diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c index a7809ff..5604849 100644 --- a/gdb/ada-lang.c +++ b/gdb/ada-lang.c @@ -13775,7 +13775,7 @@ ada_language_arch_info (struct gdbarch *gdbarch, 0, "short_integer"); lai->string_char_type = lai->primitive_type_vector [ada_primitive_type_char] - = arch_integer_type (gdbarch, TARGET_CHAR_BIT, 0, "character"); + = arch_character_type (gdbarch, TARGET_CHAR_BIT, 0, "character"); lai->primitive_type_vector [ada_primitive_type_float] = arch_float_type (gdbarch, gdbarch_float_bit (gdbarch), "float", NULL); diff --git a/gdb/testsuite/gdb.ada/funcall_char.exp b/gdb/testsuite/gdb.ada/funcall_char.exp new file mode 100644 index 0000000..ee53966 --- /dev/null +++ b/gdb/testsuite/gdb.ada/funcall_char.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" + +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 "BREAK" ${testdir}/foo.adb] +runto "foo.adb:$bp_location" + +# Make sure we can call a function that takes a character with a character +# literal. If we cannot, then GDB will instead invoke the function that takes +# an integer and will return a negative number. +gdb_test "print f('A')" " = 65" diff --git a/gdb/testsuite/gdb.ada/funcall_char/foo.adb b/gdb/testsuite/gdb.ada/funcall_char/foo.adb new file mode 100644 index 0000000..b5c0506 --- /dev/null +++ b/gdb/testsuite/gdb.ada/funcall_char/foo.adb @@ -0,0 +1,33 @@ +-- 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 . + +procedure Foo is + + function F (C : Character) return Integer is + begin + return Character'Pos (C); + end F; + + function F (I : Integer) return Integer is + begin + return -I; + end F; + + I1 : constant Integer := F ('A'); -- BREAK + I2 : constant Integer := F (1); + +begin + null; +end Foo;