This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] Fix wrong code for case statement on character
- From: Eric Botcazou <ebotcazou at adacore dot com>
- To: gcc-patches at gcc dot gnu dot org
- Date: Sat, 11 Jun 2016 13:55:59 +0200
- Subject: [Ada] Fix wrong code for case statement on character
- Authentication-results: sourceware.org; auth=none
This fixes a regression present on the mainline and 6 branch, whereby the
compiler generates wrong code for a case statement whose expression is of the
standard Character type and which contains a large range of values among other
things.
Tested on x86_64-suse-linux, applied on the mainline and 6 branch.
2016-06-11 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/trans.c (Case_Statement_to_gnu): Deal with characters.
2016-06-11 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/case_character.adb: New test.
--
Eric Botcazou
Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c (revision 237323)
+++ gcc-interface/trans.c (working copy)
@@ -2472,13 +2472,15 @@ Attribute_to_gnu (Node_Id gnat_node, tre
static tree
Case_Statement_to_gnu (Node_Id gnat_node)
{
- tree gnu_result, gnu_expr, gnu_label;
+ tree gnu_result, gnu_expr, gnu_type, gnu_label;
Node_Id gnat_when;
location_t end_locus;
bool may_fallthru = false;
gnu_expr = gnat_to_gnu (Expression (gnat_node));
gnu_expr = convert (get_base_type (TREE_TYPE (gnu_expr)), gnu_expr);
+ gnu_expr = maybe_character_value (gnu_expr);
+ gnu_type = TREE_TYPE (gnu_expr);
/* We build a SWITCH_EXPR that contains the code with interspersed
CASE_LABEL_EXPRs for each label. */
@@ -2548,6 +2550,11 @@ Case_Statement_to_gnu (Node_Id gnat_node
gcc_assert (!gnu_low || TREE_CODE (gnu_low) == INTEGER_CST);
gcc_assert (!gnu_high || TREE_CODE (gnu_high) == INTEGER_CST);
+ if (gnu_low && TREE_TYPE (gnu_low) != gnu_type)
+ gnu_low = convert (gnu_type, gnu_low);
+ if (gnu_high && TREE_TYPE (gnu_high) != gnu_type)
+ gnu_high = convert (gnu_type, gnu_high);
+
add_stmt_with_node (build_case_label (gnu_low, gnu_high, label),
gnat_choice);
choices_added_p = true;
@@ -2579,8 +2586,8 @@ Case_Statement_to_gnu (Node_Id gnat_node
/* Now emit a definition of the label the cases branch to, if any. */
if (may_fallthru)
add_stmt (build1 (LABEL_EXPR, void_type_node, gnu_label));
- gnu_result = build3 (SWITCH_EXPR, TREE_TYPE (gnu_expr), gnu_expr,
- end_stmt_group (), NULL_TREE);
+ gnu_result
+ = build3 (SWITCH_EXPR, gnu_type, gnu_expr, end_stmt_group (), NULL_TREE);
return gnu_result;
}
-- { dg-do run }
procedure Case_Character is
function Test (C : Character) return Integer is
begin
case C is
when ASCII.HT | ' ' .. Character'Last => return 1;
when others => return 0;
end case;
end;
begin
if Test ('A') /= 1 then
raise Program_Error;
end if;
end;