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: r262812

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 2375e80ae419d1438c5bc3ab83b23c1b64adf527..9e4f36a035bfdd22182f786a361594cb139e0c66 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  Ed Schonberg  <schonberg@adacore.com>
 
        * sem_ch4.adb (Try_Object_Operation): Handle properly a prefixed call

diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index 50d20e6e8ea878b6832cacd99396189e987f5d89..b1dc379c24771ad796d143c0e839434baf03f8b8 100644 (file)
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -6705,65 +6705,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;
            }
 
@@ -6771,27 +6750,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 a162069b46c50674ca574e77dfc4b357424399be..cc1fe770f2c023715cd2a4dddc923e91c1c23be1 100644 (file)
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -391,15 +391,13 @@ make_dummy_type (Entity_Id gnat_type)
 
   SET_DUMMY_NODE (gnat_equiv, gnu_type);
 
-  /* Create a debug type so that debug info consumers only see an unspecified
-     type.  */
+  /* Create a debug type so that debuggers only see an unspecified type.  */
   if (Needs_Debug_Info (gnat_type))
     {
       debug_type = make_node (LANG_TYPE);
-      SET_TYPE_DEBUG_TYPE (gnu_type, debug_type);
-
       TYPE_NAME (debug_type) = TYPE_NAME (gnu_type);
       TYPE_ARTIFICIAL (debug_type) = TYPE_ARTIFICIAL (gnu_type);
+      SET_TYPE_DEBUG_TYPE (gnu_type, debug_type);
     }
 
   return gnu_type;
@@ -1073,7 +1071,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)));
 
@@ -1417,7 +1417,7 @@ maybe_pad_type (tree type, tree size, unsigned int align,
     }
 
   if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL)
-    SET_TYPE_DEBUG_TYPE (record, type);
+    SET_TYPE_DEBUG_TYPE (record, maybe_debug_type (type));
 
   /* Unless debugging information isn't being written for the input type,
      write a record that shows what we are a subtype of and also make a

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 11f9ed3afa0fcb0cdcc56a55e8730c888963a5c5..d0001f0a84e83464a8233e7e4d2a83a79fb1c482 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-17  Rainer Orth  <ro@CeBiTec.Uni-Bielefeld.DE>
 
        * gcc.target/i386/vartrack-1.c (dg-options): Add

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;