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 */
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);
;
primary : CHARLIT
- { write_int (pstate,
- convert_char_literal (type_qualifier, $1.val),
- (type_qualifier == NULL)
- ? $1.type : type_qualifier);
- }
+ {
+ pstate->push_new<ada_char_operation> ($1.type, $1.val);
+ }
;
primary : FLOAT
push_association<ada_name_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)
{
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<ada_wrapped_operation> (std::move (result));
+}
+
value *
ada_wrapped_operation::evaluate (struct type *expect_type,
struct expression *exp,
--- /dev/null
+# 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 <http://www.gnu.org/licenses/>.
+
+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"
--- /dev/null
+-- 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 <http://www.gnu.org/licenses/>.
+
+with Pck; use Pck;
+
+procedure Foo is
+ Gchar : Global_Enum_Type := Global_Enum_Type'(Overloaded('+'));
+begin
+ Do_Nothing (Gchar'Address); -- STOP
+end Foo;
--- /dev/null
+-- 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 <http://www.gnu.org/licenses/>.
+
+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;
--- /dev/null
+-- 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 <http://www.gnu.org/licenses/>.
+
+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;
projects / binutils-gdb.git / commitdiff