* gcc-interface/trans.c (Case_Statement_to_gnu): Deal with characters.
authorEric Botcazou <ebotcazou@adacore.com>
Sat, 11 Jun 2016 11:53:11 +0000 (11:53 +0000)
committerEric Botcazou <ebotcazou@gcc.gnu.org>
Sat, 11 Jun 2016 11:53:11 +0000 (11:53 +0000)
From-SVN: r237326

gcc/ada/ChangeLog
gcc/ada/gcc-interface/trans.c
gcc/testsuite/ChangeLog
gcc/testsuite/gnat.dg/case_character.adb [new file with mode: 0644]

index ec42a8b9496a0ec0afbfabad851adbfe3ded0f2d..f37a42075a8aa999dc55f30543c20421ba70b145 100644 (file)
@@ -1,3 +1,7 @@
+2016-06-11  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gcc-interface/trans.c (Case_Statement_to_gnu): Deal with characters.
+
 2016-06-11  Pierre-Marie de Rodat  <derodat@adacore.com>
 
        * gcc-interface/decl.c (gnat_to_gnu_entity): Do not clobber
index fb17cb2c3812f862472c5c43692391d7b70c435e..dd40dbeb2076f6faa03b4ad2b9201c7ebbd2d031 100644 (file)
@@ -2472,13 +2472,15 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
 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;
 }
index 2b31ceb51917188bf52698e42cc9ab8d44809d22..62d3450c76716032511f106374842d0d20a20b77 100644 (file)
@@ -1,3 +1,7 @@
+2016-06-11  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/case_character.adb: New test.
+
 2016-06-11  Segher Boessenkool  <segher@kernel.crashing.org>
 
        PR middle-end/71310
diff --git a/gcc/testsuite/gnat.dg/case_character.adb b/gcc/testsuite/gnat.dg/case_character.adb
new file mode 100644 (file)
index 0000000..59c9b66
--- /dev/null
@@ -0,0 +1,19 @@
+-- { 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;