Commit 8e93ce66 by Eric Botcazou Committed by Eric Botcazou

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
parent 10c6ce78
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> 2018-07-17 Ed Schonberg <schonberg@adacore.com>
* sem_ch4.adb (Try_Object_Operation): Handle properly a prefixed call * sem_ch4.adb (Try_Object_Operation): Handle properly a prefixed call
......
...@@ -6705,65 +6705,44 @@ elaborate_reference (tree ref, Entity_Id gnat_entity, bool definition, ...@@ -6705,65 +6705,44 @@ elaborate_reference (tree ref, Entity_Id gnat_entity, bool definition,
the value passed against the list of choices. */ the value passed against the list of choices. */
static tree static tree
choices_to_gnu (tree operand, Node_Id choices) choices_to_gnu (tree gnu_operand, Node_Id gnat_choices)
{ {
Node_Id choice; tree gnu_result = boolean_false_node, gnu_type;
Node_Id gnat_temp;
tree result = boolean_false_node; gnu_operand = maybe_character_value (gnu_operand);
tree this_test, low = 0, high = 0, single = 0; 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: case N_Range:
low = gnat_to_gnu (Low_Bound (choice)); gnu_low = gnat_to_gnu (Low_Bound (gnat_choice));
high = gnat_to_gnu (High_Bound (choice)); gnu_high = gnat_to_gnu (High_Bound (gnat_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);
break; break;
case N_Subtype_Indication: case N_Subtype_Indication:
gnat_temp = Range_Expression (Constraint (choice)); gnu_low = gnat_to_gnu (Low_Bound (Range_Expression
low = gnat_to_gnu (Low_Bound (gnat_temp)); (Constraint (gnat_choice))));
high = gnat_to_gnu (High_Bound (gnat_temp)); gnu_high = gnat_to_gnu (High_Bound (Range_Expression
(Constraint (gnat_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);
break; break;
case N_Identifier: case N_Identifier:
case N_Expanded_Name: case N_Expanded_Name:
/* This represents either a subtype range, an enumeration /* This represents either a subtype range or a static value of
literal, or a constant Ekind says which. If an enumeration some kind; Ekind says which. */
literal or constant, fall through to the next case. */ if (Is_Type (Entity (gnat_choice)))
if (Ekind (Entity (choice)) != E_Enumeration_Literal
&& Ekind (Entity (choice)) != E_Constant)
{ {
tree type = gnat_to_gnu_type (Entity (choice)); tree gnu_type = get_unpadded_type (Entity (gnat_choice));
low = TYPE_MIN_VALUE (type); gnu_low = TYPE_MIN_VALUE (gnu_type);
high = TYPE_MAX_VALUE (type); gnu_high = TYPE_MAX_VALUE (gnu_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);
break; break;
} }
...@@ -6771,27 +6750,49 @@ choices_to_gnu (tree operand, Node_Id choices) ...@@ -6771,27 +6750,49 @@ choices_to_gnu (tree operand, Node_Id choices)
case N_Character_Literal: case N_Character_Literal:
case N_Integer_Literal: case N_Integer_Literal:
single = gnat_to_gnu (choice); gnu_low = gnat_to_gnu (gnat_choice);
this_test = build_binary_op (EQ_EXPR, boolean_type_node, operand,
single, true);
break; break;
case N_Others_Choice: case N_Others_Choice:
this_test = boolean_true_node;
break; break;
default: default:
gcc_unreachable (); gcc_unreachable ();
} }
if (result == boolean_false_node) /* Everything should be folded into constants at this point. */
result = this_test; 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 else
result = build_binary_op (TRUTH_ORIF_EXPR, boolean_type_node, result, gnu_result
this_test, true); = 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 /* Adjust PACKED setting as passed to gnat_to_gnu_field for a field of
......
...@@ -391,15 +391,13 @@ make_dummy_type (Entity_Id gnat_type) ...@@ -391,15 +391,13 @@ make_dummy_type (Entity_Id gnat_type)
SET_DUMMY_NODE (gnat_equiv, gnu_type); SET_DUMMY_NODE (gnat_equiv, gnu_type);
/* Create a debug type so that debug info consumers only see an unspecified /* Create a debug type so that debuggers only see an unspecified type. */
type. */
if (Needs_Debug_Info (gnat_type)) if (Needs_Debug_Info (gnat_type))
{ {
debug_type = make_node (LANG_TYPE); debug_type = make_node (LANG_TYPE);
SET_TYPE_DEBUG_TYPE (gnu_type, debug_type);
TYPE_NAME (debug_type) = TYPE_NAME (gnu_type); TYPE_NAME (debug_type) = TYPE_NAME (gnu_type);
TYPE_ARTIFICIAL (debug_type) = TYPE_ARTIFICIAL (gnu_type); TYPE_ARTIFICIAL (debug_type) = TYPE_ARTIFICIAL (gnu_type);
SET_TYPE_DEBUG_TYPE (gnu_type, debug_type);
} }
return gnu_type; return gnu_type;
...@@ -1073,7 +1071,9 @@ make_packable_type (tree type, bool in_record, unsigned int max_align) ...@@ -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); finish_record_type (new_type, nreverse (new_field_list), 2, false);
relate_alias_sets (new_type, type, ALIAS_SET_COPY); 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), SET_DECL_PARALLEL_TYPE (TYPE_STUB_DECL (new_type),
DECL_PARALLEL_TYPE (TYPE_STUB_DECL (type))); DECL_PARALLEL_TYPE (TYPE_STUB_DECL (type)));
...@@ -1417,7 +1417,7 @@ maybe_pad_type (tree type, tree size, unsigned int align, ...@@ -1417,7 +1417,7 @@ maybe_pad_type (tree type, tree size, unsigned int align,
} }
if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL) 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, /* 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 write a record that shows what we are a subtype of and also make a
......
2018-07-17 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/discr55.adb: New test.
2018-07-17 Rainer Orth <ro@CeBiTec.Uni-Bielefeld.DE> 2018-07-17 Rainer Orth <ro@CeBiTec.Uni-Bielefeld.DE>
* gcc.target/i386/vartrack-1.c (dg-options): Add * gcc.target/i386/vartrack-1.c (dg-options): Add
......
-- { 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;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment