diff --git a/gdb/ada-exp.h b/gdb/ada-exp.h index e600ec224e5..594abe067e8 100644 --- a/gdb/ada-exp.h +++ b/gdb/ada-exp.h @@ -742,6 +742,35 @@ private: operation_up m_val; }; +/* A character constant expression. This is a separate operation so + that it can participate in resolution, so that TYPE'(CST) can + work correctly for enums with character enumerators. */ +class ada_char_operation : public long_const_operation, + public ada_resolvable +{ +public: + + using long_const_operation::long_const_operation; + + bool resolve (struct expression *exp, + bool deprocedure_p, + bool parse_completion, + innermost_block_tracker *tracker, + struct type *context_type) override + { + /* This should never be called, because this class also implements + 'replace'. */ + gdb_assert_not_reached ("unexpected call"); + } + + operation_up replace (operation_up &&owner, + struct expression *exp, + bool deprocedure_p, + bool parse_completion, + innermost_block_tracker *tracker, + struct type *context_type) override; +}; + } /* namespace expr */ #endif /* ADA_EXP_H */ diff --git a/gdb/ada-exp.y b/gdb/ada-exp.y index afa085ec50f..a0b8b7df8ce 100644 --- a/gdb/ada-exp.y +++ b/gdb/ada-exp.y @@ -91,8 +91,6 @@ static void write_name_assoc (struct parser_state *, struct stoken); static const struct block *block_lookup (const struct block *, const char *); -static LONGEST convert_char_literal (struct type *, LONGEST); - static void write_ambiguous_var (struct parser_state *, const struct block *, const char *, int); @@ -869,11 +867,9 @@ primary : INT ; primary : CHARLIT - { write_int (pstate, - convert_char_literal (type_qualifier, $1.val), - (type_qualifier == NULL) - ? $1.type : type_qualifier); - } + { + pstate->push_new ($1.type, $1.val); + } ; primary : FLOAT @@ -1718,43 +1714,6 @@ write_name_assoc (struct parser_state *par_state, struct stoken name) push_association (ada_pop ()); } -/* Convert the character literal whose ASCII value would be VAL to the - appropriate value of type TYPE, if there is a translation. - Otherwise return VAL. Hence, in an enumeration type ('A', 'B'), - the literal 'A' (VAL == 65), returns 0. */ - -static LONGEST -convert_char_literal (struct type *type, LONGEST val) -{ - char name[7]; - int f; - - if (type == NULL) - return val; - type = check_typedef (type); - if (type->code () != TYPE_CODE_ENUM) - return val; - - if ((val >= 'a' && val <= 'z') || (val >= '0' && val <= '9')) - xsnprintf (name, sizeof (name), "Q%c", (int) val); - else - xsnprintf (name, sizeof (name), "QU%02x", (int) val); - size_t len = strlen (name); - for (f = 0; f < type->num_fields (); f += 1) - { - /* Check the suffix because an enum constant in a package will - have a name like "pkg__QUxx". This is safe enough because we - already have the correct type, and because mangling means - there can't be clashes. */ - const char *ename = TYPE_FIELD_NAME (type, f); - size_t elen = strlen (ename); - - if (elen >= len && strcmp (name, ename + elen - len) == 0) - return TYPE_FIELD_ENUMVAL (type, f); - } - return val; -} - static struct type * type_int (struct parser_state *par_state) { diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c index a435543861c..1038ccbb316 100644 --- a/gdb/ada-lang.c +++ b/gdb/ada-lang.c @@ -10114,6 +10114,66 @@ ada_resolvable::replace (operation_up &&owner, return std::move (owner); } +/* Convert the character literal whose ASCII value would be VAL to the + appropriate value of type TYPE, if there is a translation. + Otherwise return VAL. Hence, in an enumeration type ('A', 'B'), + the literal 'A' (VAL == 65), returns 0. */ + +static LONGEST +convert_char_literal (struct type *type, LONGEST val) +{ + char name[7]; + int f; + + if (type == NULL) + return val; + type = check_typedef (type); + if (type->code () != TYPE_CODE_ENUM) + return val; + + if ((val >= 'a' && val <= 'z') || (val >= '0' && val <= '9')) + xsnprintf (name, sizeof (name), "Q%c", (int) val); + else + xsnprintf (name, sizeof (name), "QU%02x", (int) val); + size_t len = strlen (name); + for (f = 0; f < type->num_fields (); f += 1) + { + /* Check the suffix because an enum constant in a package will + have a name like "pkg__QUxx". This is safe enough because we + already have the correct type, and because mangling means + there can't be clashes. */ + const char *ename = TYPE_FIELD_NAME (type, f); + size_t elen = strlen (ename); + + if (elen >= len && strcmp (name, ename + elen - len) == 0) + return TYPE_FIELD_ENUMVAL (type, f); + } + return val; +} + +/* See ada-exp.h. */ + +operation_up +ada_char_operation::replace (operation_up &&owner, + struct expression *exp, + bool deprocedure_p, + bool parse_completion, + innermost_block_tracker *tracker, + struct type *context_type) +{ + operation_up result = std::move (owner); + + if (context_type != nullptr && context_type->code () == TYPE_CODE_ENUM) + { + gdb_assert (result.get () == this); + std::get<0> (m_storage) = context_type; + std::get<1> (m_storage) + = convert_char_literal (context_type, std::get<1> (m_storage)); + } + + return make_operation (std::move (result)); +} + value * ada_wrapped_operation::evaluate (struct type *expect_type, struct expression *exp, diff --git a/gdb/testsuite/gdb.ada/char_enum_overload.exp b/gdb/testsuite/gdb.ada/char_enum_overload.exp new file mode 100644 index 00000000000..2cd93f82854 --- /dev/null +++ b/gdb/testsuite/gdb.ada/char_enum_overload.exp @@ -0,0 +1,34 @@ +# Copyright 2021 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 foo + +if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } { + return -1 +} + +clean_restart ${testfile} + +set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb] +runto "foo.adb:$bp_location" + +gdb_test "print pck.Global_Enum_Type'(Overloaded('+'))" "= 1 'Y'" \ + "call correct overload" +gdb_test "print pck.Global_Enum_Type'('+')" " = 2 '\\+'" \ + "use enum constant" diff --git a/gdb/testsuite/gdb.ada/char_enum_overload/foo.adb b/gdb/testsuite/gdb.ada/char_enum_overload/foo.adb new file mode 100644 index 00000000000..ee0a0aa4f0e --- /dev/null +++ b/gdb/testsuite/gdb.ada/char_enum_overload/foo.adb @@ -0,0 +1,22 @@ +-- Copyright 2021 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 + Gchar : Global_Enum_Type := Global_Enum_Type'(Overloaded('+')); +begin + Do_Nothing (Gchar'Address); -- STOP +end Foo; diff --git a/gdb/testsuite/gdb.ada/char_enum_overload/pck.adb b/gdb/testsuite/gdb.ada/char_enum_overload/pck.adb new file mode 100644 index 00000000000..6aba048fd8f --- /dev/null +++ b/gdb/testsuite/gdb.ada/char_enum_overload/pck.adb @@ -0,0 +1,31 @@ +-- Copyright 2021 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 Overloaded (Value : Global_Enum_Type) is + begin + null; + end Overloaded; + + function Overloaded (Value : Character) return Global_Enum_Type is + begin + return 'Y'; + end Overloaded; + + procedure Do_Nothing (A : System.Address) is + begin + null; + end Do_Nothing; +end Pck; diff --git a/gdb/testsuite/gdb.ada/char_enum_overload/pck.ads b/gdb/testsuite/gdb.ada/char_enum_overload/pck.ads new file mode 100644 index 00000000000..7dc478f774b --- /dev/null +++ b/gdb/testsuite/gdb.ada/char_enum_overload/pck.ads @@ -0,0 +1,25 @@ +-- Copyright 2021 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 + type Global_Enum_Type is ('x', 'Y', '+'); + + procedure Overloaded (Value : Global_Enum_Type); + function Overloaded (Value : Character) return Global_Enum_Type; + + procedure Do_Nothing (A : System.Address); +end Pck;