aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/ada/ChangeLog10
-rw-r--r--gcc/ada/gcc-interface/decl.c111
-rw-r--r--gcc/ada/gcc-interface/utils.c12
-rw-r--r--gcc/testsuite/ChangeLog4
-rw-r--r--gcc/testsuite/gnat.dg/discr55.adb16
5 files changed, 92 insertions, 61 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 2375e80a..9e4f36a 100644
--- 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 50d20e6..b1dc379 100644
--- 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;
}
/* 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 a162069..cc1fe77 100644
--- 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 11f9ed3..d0001f0 100644
--- 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
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;
generated by cgit v1.1 at 2025-04-03 14:27:12 +0000