decl.c (choices_to_gnu): Rename parameters.

	* gcc-interface/decl.c (choices_to_gnu): Rename parameters.  Deal with
	an operand of Character type.  Factor out range generation to the end.
	Check that the bounds are literals and convert them to the type of the
	operand before building the ranges.
	* gcc-interface/utils.c (make_dummy_type): Minor tweak.
	(make_packable_type): Propagate TYPE_DEBUG_TYPE.
	(maybe_pad_type): Likewise.

From-SVN: r262814

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index feee3e83293c73766b2f0e3e779ede1886e8224a..fe6c3e1e6ff9a0bddd0645102e2ca0848869ee78 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,13 @@
+2018-07-17  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gcc-interface/decl.c (choices_to_gnu): Rename parameters.  Deal with
+       an operand of Character type.  Factor out range generation to the end.
+       Check that the bounds are literals and convert them to the type of the
+       operand before building the ranges.
+       * gcc-interface/utils.c (make_dummy_type): Minor tweak.
+       (make_packable_type): Propagate TYPE_DEBUG_TYPE.
+       (maybe_pad_type): Likewise.
+
 2018-07-17  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Variable>: Deal with

diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index 1ea6a473434eea9eaf248632a548dc2278bacf9f..5bd76ef54bf6ad70f6df93c28cc8aeece8c2678d 100644 (file)
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -6875,65 +6875,44 @@ elaborate_reference (tree ref, Entity_Id gnat_entity, bool definition,
    the value passed against the list of choices.  */
 
 static tree
-choices_to_gnu (tree operand, Node_Id choices)
+choices_to_gnu (tree gnu_operand, Node_Id gnat_choices)
 {
-  Node_Id choice;
-  Node_Id gnat_temp;
-  tree result = boolean_false_node;
-  tree this_test, low = 0, high = 0, single = 0;
+  tree gnu_result = boolean_false_node, gnu_type;
+
+  gnu_operand = maybe_character_value (gnu_operand);
+  gnu_type = TREE_TYPE (gnu_operand);
 
-  for (choice = First (choices); Present (choice); choice = Next (choice))
+  for (Node_Id gnat_choice = First (gnat_choices);
+       Present (gnat_choice);
+       gnat_choice = Next (gnat_choice))
     {
-      switch (Nkind (choice))
+      tree gnu_low = NULL_TREE, gnu_high = NULL_TREE;
+      tree gnu_test;
+
+      switch (Nkind (gnat_choice))
        {
        case N_Range:
-         low = gnat_to_gnu (Low_Bound (choice));
-         high = gnat_to_gnu (High_Bound (choice));
-
-         this_test
-           = build_binary_op (TRUTH_ANDIF_EXPR, boolean_type_node,
-                              build_binary_op (GE_EXPR, boolean_type_node,
-                                               operand, low, true),
-                              build_binary_op (LE_EXPR, boolean_type_node,
-                                               operand, high, true),
-                              true);
-
+         gnu_low = gnat_to_gnu (Low_Bound (gnat_choice));
+         gnu_high = gnat_to_gnu (High_Bound (gnat_choice));
          break;
 
        case N_Subtype_Indication:
-         gnat_temp = Range_Expression (Constraint (choice));
-         low = gnat_to_gnu (Low_Bound (gnat_temp));
-         high = gnat_to_gnu (High_Bound (gnat_temp));
-
-         this_test
-           = build_binary_op (TRUTH_ANDIF_EXPR, boolean_type_node,
-                              build_binary_op (GE_EXPR, boolean_type_node,
-                                               operand, low, true),
-                              build_binary_op (LE_EXPR, boolean_type_node,
-                                               operand, high, true),
-                              true);
+         gnu_low = gnat_to_gnu (Low_Bound (Range_Expression
+                                           (Constraint (gnat_choice))));
+         gnu_high = gnat_to_gnu (High_Bound (Range_Expression
+                                             (Constraint (gnat_choice))));
          break;
 
        case N_Identifier:
        case N_Expanded_Name:
-         /* This represents either a subtype range, an enumeration
-            literal, or a constant  Ekind says which.  If an enumeration
-            literal or constant, fall through to the next case.  */
-         if (Ekind (Entity (choice)) != E_Enumeration_Literal
-             && Ekind (Entity (choice)) != E_Constant)
+         /* This represents either a subtype range or a static value of
+            some kind; Ekind says which.  */
+         if (Is_Type (Entity (gnat_choice)))
            {
-             tree type = gnat_to_gnu_type (Entity (choice));
-
-             low = TYPE_MIN_VALUE (type);
-             high = TYPE_MAX_VALUE (type);
-
-             this_test
-               = build_binary_op (TRUTH_ANDIF_EXPR, boolean_type_node,
-                                  build_binary_op (GE_EXPR, boolean_type_node,
-                                                   operand, low, true),
-                                  build_binary_op (LE_EXPR, boolean_type_node,
-                                                   operand, high, true),
-                                  true);
+             tree gnu_type = get_unpadded_type (Entity (gnat_choice));
+
+             gnu_low = TYPE_MIN_VALUE (gnu_type);
+             gnu_high = TYPE_MAX_VALUE (gnu_type);
              break;
            }
 
@@ -6941,27 +6920,49 @@ choices_to_gnu (tree operand, Node_Id choices)
 
        case N_Character_Literal:
        case N_Integer_Literal:
-         single = gnat_to_gnu (choice);
-         this_test = build_binary_op (EQ_EXPR, boolean_type_node, operand,
-                                      single, true);
+         gnu_low = gnat_to_gnu (gnat_choice);
          break;
 
        case N_Others_Choice:
-         this_test = boolean_true_node;
          break;
 
        default:
          gcc_unreachable ();
        }
 
-      if (result == boolean_false_node)
-       result = this_test;
+      /* Everything should be folded into constants at this point.  */
+      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);
+
+      if (gnu_low && gnu_high)
+       gnu_test
+         = build_binary_op (TRUTH_ANDIF_EXPR, boolean_type_node,
+                            build_binary_op (GE_EXPR, boolean_type_node,
+                                             gnu_operand, gnu_low, true),
+                            build_binary_op (LE_EXPR, boolean_type_node,
+                                             gnu_operand, gnu_high, true),
+                            true);
+      else if (gnu_low)
+       gnu_test
+         = build_binary_op (EQ_EXPR, boolean_type_node, gnu_operand, gnu_low,
+                            true);
+      else
+       gnu_test = boolean_true_node;
+
+      if (gnu_result == boolean_false_node)
+       gnu_result = gnu_test;
       else
-       result = build_binary_op (TRUTH_ORIF_EXPR, boolean_type_node, result,
-                                 this_test, true);
+       gnu_result
+         = build_binary_op (TRUTH_ORIF_EXPR, boolean_type_node, gnu_result,
+                            gnu_test, true);
     }
 
-  return result;
+  return gnu_result;
 }
 \f
 /* Adjust PACKED setting as passed to gnat_to_gnu_field for a field of

diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c
index cb2c4d22a41c5e7e8a2a770ef1bee36796ebd65e..b434d29bf63b72b15dbde1abe8a9aab4d0624131 100644 (file)
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -1036,7 +1036,9 @@ make_packable_type (tree type, bool in_record, unsigned int max_align)
 
   finish_record_type (new_type, nreverse (new_field_list), 2, false);
   relate_alias_sets (new_type, type, ALIAS_SET_COPY);
-  if (TYPE_STUB_DECL (type))
+  if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL)
+    SET_TYPE_DEBUG_TYPE (new_type, TYPE_DEBUG_TYPE (type));
+  else if (TYPE_STUB_DECL (type))
     SET_DECL_PARALLEL_TYPE (TYPE_STUB_DECL (new_type),
                            DECL_PARALLEL_TYPE (TYPE_STUB_DECL (type)));
 
@@ -1367,7 +1369,7 @@ maybe_pad_type (tree type, tree size, unsigned int align,
   finish_record_type (record, field, 1, false);
 
   if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL)
-    SET_TYPE_DEBUG_TYPE (record, type);
+    SET_TYPE_DEBUG_TYPE (record, maybe_debug_type (type));
 
   /* Set the RM size if requested.  */
   if (set_rm_size)

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 9fcb2c719b51f2751411f589b89d1ed36f2d2bd0..67b025aa5c3aa53df0ae62b91090e005e8ebf232 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2018-07-17  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/discr55.adb: New test.
+
 2018-07-16  Fritz Reese  <fritzoreese@gmail.com>
 
        PR fortran/83184

diff --git a/gcc/testsuite/gnat.dg/discr55.adb b/gcc/testsuite/gnat.dg/discr55.adb
new file mode 100644 (file)
index 0000000..0444672
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr55.adb
@@ -0,0 +1,16 @@
+-- { dg-do run }
+
+procedure Discr55 is
+
+  type Rec (C : Character) is record
+    case C is
+      when 'Z' .. Character'Val (128) => I : Integer;
+      when others                     => null;
+    end case;
+  end record;
+
+  R : Rec ('Z');
+
+begin
+  R.I := 0;
+end;