Commit 815b5368 by Eric Botcazou Committed by Eric Botcazou

gigi.h (gigi_checking_assert): New macro.

	* gcc-interface/gigi.h (gigi_checking_assert): New macro.
	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Modular_Integer_Type>:
	Remove redundant test and adjust comments.  Minor tweaks.
	* gcc-interface/trans.c (Call_to_gnu): Do not generate range checks,
	instead assert that the Do_Range_Check flag is not set.  Adjust call
	to convert_with_check.
	(gnat_to_gnu): Likewise.
	(assoc_to_constructor): Likewise.
	(pos_to_constructor): Likewise.  Remove GNAT_COMPONENT_TYPE parameter.
	(emit_range_check): Delete.
	(convert_with_check): Remove RANGE_P parameter and adjust.  Do a single
	overflow check for modular types.

From-SVN: r275174
parent 3eefaaa9
2019-08-30 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/gigi.h (gigi_checking_assert): New macro.
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Modular_Integer_Type>:
Remove redundant test and adjust comments. Minor tweaks.
* gcc-interface/trans.c (Call_to_gnu): Do not generate range checks,
instead assert that the Do_Range_Check flag is not set. Adjust call
to convert_with_check.
(gnat_to_gnu): Likewise.
(assoc_to_constructor): Likewise.
(pos_to_constructor): Likewise. Remove GNAT_COMPONENT_TYPE parameter.
(emit_range_check): Delete.
(convert_with_check): Remove RANGE_P parameter and adjust. Do a single
overflow check for modular types.
2019-08-23 Jakub Jelinek <jakub@redhat.com> 2019-08-23 Jakub Jelinek <jakub@redhat.com>
PR middle-end/91283 PR middle-end/91283
......
...@@ -447,13 +447,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -447,13 +447,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
If we are not defining it, it must be a type or an entity that is defined If we are not defining it, it must be a type or an entity that is defined
elsewhere or externally, otherwise we should have defined it already. */ elsewhere or externally, otherwise we should have defined it already. */
gcc_assert (definition gcc_assert (definition
|| type_annotate_only
|| is_type || is_type
|| kind == E_Discriminant || kind == E_Discriminant
|| kind == E_Component || kind == E_Component
|| kind == E_Label || kind == E_Label
|| (kind == E_Constant && Present (Full_View (gnat_entity))) || (kind == E_Constant && Present (Full_View (gnat_entity)))
|| Is_Public (gnat_entity)); || Is_Public (gnat_entity)
|| type_annotate_only);
/* Get the name of the entity and set up the line number and filename of /* Get the name of the entity and set up the line number and filename of
the original definition for use in any decl we make. Make sure we do the original definition for use in any decl we make. Make sure we do
...@@ -1758,34 +1758,29 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -1758,34 +1758,29 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
case E_Modular_Integer_Type: case E_Modular_Integer_Type:
{ {
/* For modular types, make the unsigned type of the proper number
of bits and then set up the modulus, if required. */
tree gnu_modulus, gnu_high = NULL_TREE;
/* Packed Array Impl. Types are supposed to be subtypes only. */ /* Packed Array Impl. Types are supposed to be subtypes only. */
gcc_assert (!Is_Packed_Array_Impl_Type (gnat_entity)); gcc_assert (!Is_Packed_Array_Impl_Type (gnat_entity));
/* For modular types, make the unsigned type of the proper number
of bits and then set up the modulus, if required. */
gnu_type = make_unsigned_type (esize); gnu_type = make_unsigned_type (esize);
/* Get the modulus in this type. If it overflows, assume it is because /* Get the modulus in this type. If the modulus overflows, assume
it is equal to 2**Esize. Note that there is no overflow checking that this is because it was equal to 2**Esize. Note that there
done on unsigned type, so we detect the overflow by looking for is no overflow checking done on unsigned types, so we detect the
a modulus of zero, which is otherwise invalid. */ overflow by looking for a modulus of zero, which is invalid. */
gnu_modulus = UI_To_gnu (Modulus (gnat_entity), gnu_type); tree gnu_modulus = UI_To_gnu (Modulus (gnat_entity), gnu_type);
/* If the modulus is not 2**Esize, then this also means that the upper
bound of the type, i.e. modulus - 1, is not maximal, so we create an
extra subtype to carry it and set the modulus on the base type. */
if (!integer_zerop (gnu_modulus)) if (!integer_zerop (gnu_modulus))
{ {
TYPE_NAME (gnu_type) = create_concat_name (gnat_entity, "UMT");
TYPE_MODULAR_P (gnu_type) = 1; TYPE_MODULAR_P (gnu_type) = 1;
SET_TYPE_MODULUS (gnu_type, gnu_modulus); SET_TYPE_MODULUS (gnu_type, gnu_modulus);
gnu_high = fold_build2 (MINUS_EXPR, gnu_type, gnu_modulus, tree gnu_high = fold_build2 (MINUS_EXPR, gnu_type, gnu_modulus,
build_int_cst (gnu_type, 1)); build_int_cst (gnu_type, 1));
}
/* If the upper bound is not maximal, make an extra subtype. */
if (gnu_high
&& !tree_int_cst_equal (gnu_high, TYPE_MAX_VALUE (gnu_type)))
{
TYPE_NAME (gnu_type) = create_concat_name (gnat_entity, "UMT");
gnu_type gnu_type
= create_extra_subtype (gnu_type, TYPE_MIN_VALUE (gnu_type), = create_extra_subtype (gnu_type, TYPE_MIN_VALUE (gnu_type),
gnu_high); gnu_high);
...@@ -2987,8 +2982,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -2987,8 +2982,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
|| Present (Record_Extension_Part (record_definition))) || Present (Record_Extension_Part (record_definition)))
record_definition = Record_Extension_Part (record_definition); record_definition = Record_Extension_Part (record_definition);
gcc_assert (type_annotate_only gcc_assert (Present (Parent_Subtype (gnat_entity))
|| Present (Parent_Subtype (gnat_entity))); || type_annotate_only);
} }
/* Make a node for the record. If we are not defining the record, /* Make a node for the record. If we are not defining the record,
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
* * * *
* C Header File * * C Header File *
* * * *
* Copyright (C) 1992-2018, Free Software Foundation, Inc. * * Copyright (C) 1992-2019, Free Software Foundation, Inc. *
* * * *
* GNAT is free software; you can redistribute it and/or modify it under * * GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- * * terms of the GNU General Public License as published by the Free Soft- *
...@@ -1054,6 +1054,12 @@ extern void enumerate_modes (void (*f) (const char *, int, int, int, int, int, ...@@ -1054,6 +1054,12 @@ extern void enumerate_modes (void (*f) (const char *, int, int, int, int, int,
} }
#endif #endif
/* Use gigi_checking_assert to test invariants in code generation mode.
It's effective only if the compiler is configured with more checking
than the release mode and can be disabled by means of -fchecking. */
#define gigi_checking_assert(EXPR) \
gcc_checking_assert ((EXPR) || type_annotate_only)
/* If EXP's type is a VECTOR_TYPE, return EXP converted to the associated /* If EXP's type is a VECTOR_TYPE, return EXP converted to the associated
TYPE_REPRESENTATIVE_ARRAY. */ TYPE_REPRESENTATIVE_ARRAY. */
......
...@@ -231,14 +231,13 @@ static enum gimplify_status gnat_gimplify_stmt (tree *); ...@@ -231,14 +231,13 @@ static enum gimplify_status gnat_gimplify_stmt (tree *);
static void elaborate_all_entities (Node_Id); static void elaborate_all_entities (Node_Id);
static void process_freeze_entity (Node_Id); static void process_freeze_entity (Node_Id);
static void process_decls (List_Id, List_Id, Node_Id, bool, bool); static void process_decls (List_Id, List_Id, Node_Id, bool, bool);
static tree emit_range_check (tree, Node_Id, Node_Id);
static tree emit_check (tree, tree, int, Node_Id); static tree emit_check (tree, tree, int, Node_Id);
static tree build_unary_op_trapv (enum tree_code, tree, tree, Node_Id); static tree build_unary_op_trapv (enum tree_code, tree, tree, Node_Id);
static tree build_binary_op_trapv (enum tree_code, tree, tree, tree, Node_Id); static tree build_binary_op_trapv (enum tree_code, tree, tree, tree, Node_Id);
static tree convert_with_check (Entity_Id, tree, bool, bool, bool, Node_Id); static tree convert_with_check (Entity_Id, tree, bool, bool, Node_Id);
static bool addressable_p (tree, tree); static bool addressable_p (tree, tree);
static tree assoc_to_constructor (Entity_Id, Node_Id, tree); static tree assoc_to_constructor (Entity_Id, Node_Id, tree);
static tree pos_to_constructor (Node_Id, tree, Entity_Id); static tree pos_to_constructor (Node_Id, tree);
static void validate_unchecked_conversion (Node_Id); static void validate_unchecked_conversion (Node_Id);
static Node_Id adjust_for_implicit_deref (Node_Id); static Node_Id adjust_for_implicit_deref (Node_Id);
static tree maybe_implicit_deref (tree); static tree maybe_implicit_deref (tree);
...@@ -5407,11 +5406,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, ...@@ -5407,11 +5406,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
else else
gnu_actual = convert (gnu_actual_type, gnu_actual); gnu_actual = convert (gnu_actual_type, gnu_actual);
/* Make sure that the actual is in range of the formal's type. */ gigi_checking_assert (!Do_Range_Check (gnat_actual));
if (Ekind (gnat_formal) != E_Out_Parameter
&& Do_Range_Check (gnat_actual))
gnu_actual
= emit_range_check (gnu_actual, gnat_formal_type, gnat_actual);
/* First see if the parameter is passed by reference. */ /* First see if the parameter is passed by reference. */
if (is_true_formal_parm && DECL_BY_REF_P (gnu_formal)) if (is_true_formal_parm && DECL_BY_REF_P (gnu_formal))
...@@ -5655,12 +5650,15 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, ...@@ -5655,12 +5650,15 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
conversion node and not from the inner Expression. */ conversion node and not from the inner Expression. */
if (Nkind (gnat_actual) == N_Type_Conversion) if (Nkind (gnat_actual) == N_Type_Conversion)
{ {
const Node_Id gnat_expr = Expression (gnat_actual);
gigi_checking_assert (!Do_Range_Check (gnat_expr));
gnu_result gnu_result
= convert_with_check = convert_with_check (Etype (gnat_expr), gnu_result,
(Etype (Expression (gnat_actual)), gnu_result, Do_Overflow_Check (gnat_actual),
Do_Overflow_Check (gnat_actual), Float_Truncate (gnat_actual),
Do_Range_Check (Expression (gnat_actual)), gnat_actual);
Float_Truncate (gnat_actual), gnat_actual);
if (!Is_Composite_Type (Underlying_Type (Etype (gnat_formal)))) if (!Is_Composite_Type (Underlying_Type (Etype (gnat_formal))))
gnu_actual = convert (TREE_TYPE (gnu_result), gnu_actual); gnu_actual = convert (TREE_TYPE (gnu_result), gnu_actual);
...@@ -5676,10 +5674,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, ...@@ -5676,10 +5674,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
No_Truncation (gnat_actual)); No_Truncation (gnat_actual));
else else
{ {
if (Do_Range_Check (gnat_actual)) gigi_checking_assert (!Do_Range_Check (gnat_actual));
gnu_result
= emit_range_check (gnu_result, Etype (gnat_actual),
gnat_actual);
if (!(!TREE_CONSTANT (TYPE_SIZE (TREE_TYPE (gnu_actual))) if (!(!TREE_CONSTANT (TYPE_SIZE (TREE_TYPE (gnu_actual)))
&& TREE_CONSTANT (TYPE_SIZE (TREE_TYPE (gnu_result))))) && TREE_CONSTANT (TYPE_SIZE (TREE_TYPE (gnu_result)))))
...@@ -5736,11 +5731,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, ...@@ -5736,11 +5731,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
Node_Id gnat_parent = Parent (gnat_node); Node_Id gnat_parent = Parent (gnat_node);
enum tree_code op_code; enum tree_code op_code;
/* If range check is needed, emit code to generate it. */ gigi_checking_assert (!Do_Range_Check (gnat_node));
if (Do_Range_Check (gnat_node))
gnu_call
= emit_range_check (gnu_call, Etype (Name (gnat_parent)),
gnat_parent);
/* ??? If the return type has variable size, then force the return /* ??? If the return type has variable size, then force the return
slot optimization as we would not be able to create a temporary. slot optimization as we would not be able to create a temporary.
...@@ -7043,10 +7034,9 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -7043,10 +7034,9 @@ gnat_to_gnu (Node_Id gnat_node)
&& (!type_annotate_only && (!type_annotate_only
|| Compile_Time_Known_Value (Expression (gnat_node)))) || Compile_Time_Known_Value (Expression (gnat_node))))
{ {
gigi_checking_assert (!Do_Range_Check (Expression (gnat_node)));
gnu_expr = gnat_to_gnu (Expression (gnat_node)); gnu_expr = gnat_to_gnu (Expression (gnat_node));
if (Do_Range_Check (Expression (gnat_node)))
gnu_expr
= emit_range_check (gnu_expr, Etype (gnat_temp), gnat_node);
if (type_annotate_only && TREE_CODE (gnu_expr) == ERROR_MARK) if (type_annotate_only && TREE_CODE (gnu_expr) == ERROR_MARK)
gnu_expr = NULL_TREE; gnu_expr = NULL_TREE;
...@@ -7396,8 +7386,7 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -7396,8 +7386,7 @@ gnat_to_gnu (Node_Id gnat_node)
gnu_aggr_type); gnu_aggr_type);
else if (TREE_CODE (gnu_aggr_type) == ARRAY_TYPE) else if (TREE_CODE (gnu_aggr_type) == ARRAY_TYPE)
gnu_result = pos_to_constructor (First (Expressions (gnat_node)), gnu_result = pos_to_constructor (First (Expressions (gnat_node)),
gnu_aggr_type, gnu_aggr_type);
Component_Type (Etype (gnat_node)));
else if (TREE_CODE (gnu_aggr_type) == COMPLEX_TYPE) else if (TREE_CODE (gnu_aggr_type) == COMPLEX_TYPE)
gnu_result gnu_result
= build_binary_op = build_binary_op
...@@ -7436,10 +7425,11 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -7436,10 +7425,11 @@ gnat_to_gnu (Node_Id gnat_node)
if (kind == N_Qualified_Expression && Is_Tagged_Type (Etype (gnat_node))) if (kind == N_Qualified_Expression && Is_Tagged_Type (Etype (gnat_node)))
used_types_insert (gnu_result_type); used_types_insert (gnu_result_type);
gigi_checking_assert (!Do_Range_Check (Expression (gnat_node)));
gnu_result gnu_result
= convert_with_check (Etype (gnat_node), gnu_expr, = convert_with_check (Etype (gnat_node), gnu_expr,
Do_Overflow_Check (gnat_node), Do_Overflow_Check (gnat_node),
Do_Range_Check (Expression (gnat_node)),
kind == N_Type_Conversion kind == N_Type_Conversion
&& Float_Truncate (gnat_node), gnat_node); && Float_Truncate (gnat_node), gnat_node);
break; break;
...@@ -7749,10 +7739,9 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -7749,10 +7739,9 @@ gnat_to_gnu (Node_Id gnat_node)
gnat_temp = Expression (gnat_node); gnat_temp = Expression (gnat_node);
/* The Expression operand can either be an N_Identifier or /* The expression can be either an N_Identifier or an Expanded_Name,
Expanded_Name, which must represent a type, or a which must represent a type, or a N_Qualified_Expression, which
N_Qualified_Expression, which contains both the object type and an contains both the type and an initial value for the object. */
initial value for the object. */
if (Nkind (gnat_temp) == N_Identifier if (Nkind (gnat_temp) == N_Identifier
|| Nkind (gnat_temp) == N_Expanded_Name) || Nkind (gnat_temp) == N_Expanded_Name)
gnu_type = gnat_to_gnu_type (Entity (gnat_temp)); gnu_type = gnat_to_gnu_type (Entity (gnat_temp));
...@@ -7765,9 +7754,8 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -7765,9 +7754,8 @@ gnat_to_gnu (Node_Id gnat_node)
gnu_init = gnat_to_gnu (Expression (gnat_temp)); gnu_init = gnat_to_gnu (Expression (gnat_temp));
gnu_init = maybe_unconstrained_array (gnu_init); gnu_init = maybe_unconstrained_array (gnu_init);
if (Do_Range_Check (Expression (gnat_temp)))
gnu_init gigi_checking_assert (!Do_Range_Check (Expression (gnat_temp)));
= emit_range_check (gnu_init, gnat_desig_type, gnat_temp);
if (Is_Elementary_Type (gnat_desig_type) if (Is_Elementary_Type (gnat_desig_type)
|| Is_Constrained (gnat_desig_type)) || Is_Constrained (gnat_desig_type))
...@@ -7873,10 +7861,7 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -7873,10 +7861,7 @@ gnat_to_gnu (Node_Id gnat_node)
else else
gnu_rhs = maybe_unconstrained_array (gnat_to_gnu (gnat_expr)); gnu_rhs = maybe_unconstrained_array (gnat_to_gnu (gnat_expr));
/* If range check is needed, emit code to generate it. */ gigi_checking_assert (!Do_Range_Check (gnat_expr));
if (Do_Range_Check (gnat_expr))
gnu_rhs = emit_range_check (gnu_rhs, Etype (Name (gnat_node)),
gnat_node);
/* If an outer atomic access is required on the LHS, build the load- /* If an outer atomic access is required on the LHS, build the load-
modify-store sequence. */ modify-store sequence. */
...@@ -10086,58 +10071,6 @@ build_binary_op_trapv (enum tree_code code, tree gnu_type, tree left, ...@@ -10086,58 +10071,6 @@ build_binary_op_trapv (enum tree_code code, tree gnu_type, tree left,
return emit_check (check, gnu_expr, CE_Overflow_Check_Failed, gnat_node); return emit_check (check, gnu_expr, CE_Overflow_Check_Failed, gnat_node);
} }
/* Emit code for a range check. GNU_EXPR is the expression to be checked,
GNAT_RANGE_TYPE the gnat type or subtype containing the bounds against
which we have to check. GNAT_NODE is the GNAT node conveying the source
location for which the error should be signaled. */
static tree
emit_range_check (tree gnu_expr, Entity_Id gnat_range_type, Node_Id gnat_node)
{
tree gnu_range_type = get_unpadded_type (gnat_range_type);
tree gnu_compare_type = get_base_type (TREE_TYPE (gnu_expr));
/* If GNU_EXPR has GNAT_RANGE_TYPE as its base type, no check is needed.
This can for example happen when translating 'Val or 'Value. */
if (gnu_compare_type == gnu_range_type)
return gnu_expr;
/* Range checks can only be applied to types with ranges. */
gcc_assert (INTEGRAL_TYPE_P (gnu_range_type)
|| SCALAR_FLOAT_TYPE_P (gnu_range_type));
/* If GNU_EXPR has an integral type that is narrower than GNU_RANGE_TYPE,
we can't do anything since we might be truncating the bounds. No
check is needed in this case. */
if (INTEGRAL_TYPE_P (TREE_TYPE (gnu_expr))
&& (TYPE_PRECISION (gnu_compare_type)
< TYPE_PRECISION (get_base_type (gnu_range_type))))
return gnu_expr;
/* Checked expressions must be evaluated only once. */
gnu_expr = gnat_protect_expr (gnu_expr);
/* Note that the form of the check is
(not (expr >= lo)) or (not (expr <= hi))
the reason for this slightly convoluted form is that NaNs
are not considered to be in range in the float case. */
return emit_check
(build_binary_op (TRUTH_ORIF_EXPR, boolean_type_node,
invert_truthvalue
(build_binary_op (GE_EXPR, boolean_type_node,
convert (gnu_compare_type, gnu_expr),
convert (gnu_compare_type,
TYPE_MIN_VALUE
(gnu_range_type)))),
invert_truthvalue
(build_binary_op (LE_EXPR, boolean_type_node,
convert (gnu_compare_type, gnu_expr),
convert (gnu_compare_type,
TYPE_MAX_VALUE
(gnu_range_type))))),
gnu_expr, CE_Range_Check_Failed, gnat_node);
}
/* GNU_COND contains the condition corresponding to an index, overflow or /* GNU_COND contains the condition corresponding to an index, overflow or
range check of value GNU_EXPR. Build a COND_EXPR that returns GNU_EXPR range check of value GNU_EXPR. Build a COND_EXPR that returns GNU_EXPR
if GNU_COND is false and raises a CONSTRAINT_ERROR if GNU_COND is true. if GNU_COND is false and raises a CONSTRAINT_ERROR if GNU_COND is true.
...@@ -10169,14 +10102,13 @@ emit_check (tree gnu_cond, tree gnu_expr, int reason, Node_Id gnat_node) ...@@ -10169,14 +10102,13 @@ emit_check (tree gnu_cond, tree gnu_expr, int reason, Node_Id gnat_node)
} }
/* Return an expression that converts GNU_EXPR to GNAT_TYPE, doing overflow /* Return an expression that converts GNU_EXPR to GNAT_TYPE, doing overflow
checks if OVERFLOW_P is true and range checks if RANGE_P is true. checks if OVERFLOW_P is true. If TRUNCATE_P is true, do a fp-to-integer
If TRUNCATE_P true, do a float-to-integer conversion with truncation, conversion with truncation, otherwise round. GNAT_NODE is the GNAT node
otherwise round. GNAT_NODE is the GNAT node conveying the source location conveying the source location for which the error should be signaled. */
for which the error should be signaled. */
static tree static tree
convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflow_p, convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflow_p,
bool range_p, bool truncate_p, Node_Id gnat_node) bool truncate_p, Node_Id gnat_node)
{ {
tree gnu_type = get_unpadded_type (gnat_type); tree gnu_type = get_unpadded_type (gnat_type);
tree gnu_base_type = get_base_type (gnu_type); tree gnu_base_type = get_base_type (gnu_type);
...@@ -10187,8 +10119,7 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflow_p, ...@@ -10187,8 +10119,7 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflow_p,
/* If we are not doing any checks, the output is an integral type and the /* If we are not doing any checks, the output is an integral type and the
input is not a floating-point type, just do the conversion. This is input is not a floating-point type, just do the conversion. This is
required for packed array types and is simpler in all cases anyway. */ required for packed array types and is simpler in all cases anyway. */
if (!range_p if (!overflow_p
&& !overflow_p
&& INTEGRAL_TYPE_P (gnu_base_type) && INTEGRAL_TYPE_P (gnu_base_type)
&& !FLOAT_TYPE_P (gnu_in_base_type)) && !FLOAT_TYPE_P (gnu_in_base_type))
return convert (gnu_type, gnu_expr); return convert (gnu_type, gnu_expr);
...@@ -10221,7 +10152,13 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflow_p, ...@@ -10221,7 +10152,13 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflow_p,
tree gnu_in_lb = TYPE_MIN_VALUE (gnu_in_base_type); tree gnu_in_lb = TYPE_MIN_VALUE (gnu_in_base_type);
tree gnu_in_ub = TYPE_MAX_VALUE (gnu_in_base_type); tree gnu_in_ub = TYPE_MAX_VALUE (gnu_in_base_type);
tree gnu_out_lb = TYPE_MIN_VALUE (gnu_base_type); tree gnu_out_lb = TYPE_MIN_VALUE (gnu_base_type);
tree gnu_out_ub = TYPE_MAX_VALUE (gnu_base_type); tree gnu_out_ub
= (TREE_CODE (gnu_base_type) == INTEGER_TYPE
&& TYPE_MODULAR_P (gnu_base_type))
? fold_build2 (MINUS_EXPR, gnu_base_type,
TYPE_MODULUS (gnu_base_type),
build_int_cst (gnu_base_type, 1))
: TYPE_MAX_VALUE (gnu_base_type);
/* Convert the lower bounds to signed types, so we're sure we're /* Convert the lower bounds to signed types, so we're sure we're
comparing them properly. Likewise, convert the upper bounds comparing them properly. Likewise, convert the upper bounds
...@@ -10346,14 +10283,6 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflow_p, ...@@ -10346,14 +10283,6 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflow_p,
else else
gnu_result = convert (gnu_base_type, gnu_result); gnu_result = convert (gnu_base_type, gnu_result);
/* Finally, do the range check if requested. Note that if the result type
is a modular type, the range check is actually an overflow check. */
if (range_p
|| (overflow_p
&& TREE_CODE (gnu_base_type) == INTEGER_TYPE
&& TYPE_MODULAR_P (gnu_base_type)))
gnu_result = emit_range_check (gnu_result, gnat_type, gnat_node);
return convert (gnu_type, gnu_result); return convert (gnu_type, gnu_result);
} }
...@@ -10682,7 +10611,8 @@ assoc_to_constructor (Entity_Id gnat_entity, Node_Id gnat_assoc, tree gnu_type) ...@@ -10682,7 +10611,8 @@ assoc_to_constructor (Entity_Id gnat_entity, Node_Id gnat_assoc, tree gnu_type)
for (; Present (gnat_assoc); gnat_assoc = Next (gnat_assoc)) for (; Present (gnat_assoc); gnat_assoc = Next (gnat_assoc))
{ {
Node_Id gnat_field = First (Choices (gnat_assoc)); const Node_Id gnat_field = First (Choices (gnat_assoc));
const Node_Id gnat_expr = Expression (gnat_assoc);
tree gnu_field = gnat_to_gnu_field_decl (Entity (gnat_field)); tree gnu_field = gnat_to_gnu_field_decl (Entity (gnat_field));
tree gnu_expr = gnat_to_gnu (Expression (gnat_assoc)); tree gnu_expr = gnat_to_gnu (Expression (gnat_assoc));
...@@ -10702,11 +10632,9 @@ assoc_to_constructor (Entity_Id gnat_entity, Node_Id gnat_assoc, tree gnu_type) ...@@ -10702,11 +10632,9 @@ assoc_to_constructor (Entity_Id gnat_entity, Node_Id gnat_assoc, tree gnu_type)
&& Is_Unchecked_Union (gnat_entity)) && Is_Unchecked_Union (gnat_entity))
continue; continue;
/* Before assigning a value in an aggregate make sure range checks gigi_checking_assert (!Do_Range_Check (gnat_expr));
are done if required. Then convert to the type of the field. */
if (Do_Range_Check (Expression (gnat_assoc)))
gnu_expr = emit_range_check (gnu_expr, Etype (gnat_field), Empty);
/* Convert to the type of the field. */
gnu_expr = convert (TREE_TYPE (gnu_field), gnu_expr); gnu_expr = convert (TREE_TYPE (gnu_field), gnu_expr);
/* Add the field and expression to the list. */ /* Add the field and expression to the list. */
...@@ -10727,13 +10655,10 @@ assoc_to_constructor (Entity_Id gnat_entity, Node_Id gnat_assoc, tree gnu_type) ...@@ -10727,13 +10655,10 @@ assoc_to_constructor (Entity_Id gnat_entity, Node_Id gnat_assoc, tree gnu_type)
/* Build a possibly nested constructor for array aggregates. GNAT_EXPR is /* Build a possibly nested constructor for array aggregates. GNAT_EXPR is
the first element of an array aggregate. It may itself be an aggregate. the first element of an array aggregate. It may itself be an aggregate.
GNU_ARRAY_TYPE is the GCC type corresponding to the array aggregate. GNU_ARRAY_TYPE is the GCC type corresponding to the array aggregate. */
GNAT_COMPONENT_TYPE is the type of the array component; it is needed
for range checking. */
static tree static tree
pos_to_constructor (Node_Id gnat_expr, tree gnu_array_type, pos_to_constructor (Node_Id gnat_expr, tree gnu_array_type)
Entity_Id gnat_component_type)
{ {
tree gnu_index = TYPE_MIN_VALUE (TYPE_DOMAIN (gnu_array_type)); tree gnu_index = TYPE_MIN_VALUE (TYPE_DOMAIN (gnu_array_type));
vec<constructor_elt, va_gc> *gnu_expr_vec = NULL; vec<constructor_elt, va_gc> *gnu_expr_vec = NULL;
...@@ -10749,8 +10674,7 @@ pos_to_constructor (Node_Id gnat_expr, tree gnu_array_type, ...@@ -10749,8 +10674,7 @@ pos_to_constructor (Node_Id gnat_expr, tree gnu_array_type,
&& TREE_CODE (TREE_TYPE (gnu_array_type)) == ARRAY_TYPE && TREE_CODE (TREE_TYPE (gnu_array_type)) == ARRAY_TYPE
&& TYPE_MULTI_ARRAY_P (TREE_TYPE (gnu_array_type))) && TYPE_MULTI_ARRAY_P (TREE_TYPE (gnu_array_type)))
gnu_expr = pos_to_constructor (First (Expressions (gnat_expr)), gnu_expr = pos_to_constructor (First (Expressions (gnat_expr)),
TREE_TYPE (gnu_array_type), TREE_TYPE (gnu_array_type));
gnat_component_type);
else else
{ {
/* If the expression is a conversion to an unconstrained array type, /* If the expression is a conversion to an unconstrained array type,
...@@ -10762,10 +10686,7 @@ pos_to_constructor (Node_Id gnat_expr, tree gnu_array_type, ...@@ -10762,10 +10686,7 @@ pos_to_constructor (Node_Id gnat_expr, tree gnu_array_type,
else else
gnu_expr = gnat_to_gnu (gnat_expr); gnu_expr = gnat_to_gnu (gnat_expr);
/* Before assigning the element to the array, make sure it is gigi_checking_assert (!Do_Range_Check (gnat_expr));
in range. */
if (Do_Range_Check (gnat_expr))
gnu_expr = emit_range_check (gnu_expr, gnat_component_type, Empty);
} }
CONSTRUCTOR_APPEND_ELT (gnu_expr_vec, gnu_index, CONSTRUCTOR_APPEND_ELT (gnu_expr_vec, gnu_index,
......
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