Commit 728936bb by Eric Botcazou Committed by Eric Botcazou

uintp.h (UI_Lt): Declare.

	* uintp.h (UI_Lt): Declare.
	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Array_Type>: Do the size
	computation in sizetype.
	<E_Array_Subtype>: Use unified handling for all index types.  Do not
	generate MAX_EXPR-based expressions, only COND_EXPR-based ones.  Add
	bypass for PATs.
	(annotate_value): Change test for negative values.
	(validate_size): Apply test for negative values on GNAT nodes.
	(set_rm_size): Likewise.
	* gcc-interface/misc.c (gnat_init): Set unsigned types for sizetypes.
	* gcc-interface/utils.c (rest_of_record_type_compilation): Change test
	for negative values.
	(max_size) <MINUS_EXPR>: Do not reassociate a COND_EXPR on the LHS.
	(builtin_type_for_size): Adjust definition of signed_size_type_node.
	* gcc-interface/utils2.c (compare_arrays): Optimize comparison of
	lengths against zero.

From-SVN: r158466
parent 1b78f575
2010-04-17 Eric Botcazou <ebotcazou@adacore.com> 2010-04-17 Eric Botcazou <ebotcazou@adacore.com>
* uintp.h (UI_Lt): Declare.
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Array_Type>: Do the size
computation in sizetype.
<E_Array_Subtype>: Use unified handling for all index types. Do not
generate MAX_EXPR-based expressions, only COND_EXPR-based ones. Add
bypass for PATs.
(annotate_value): Change test for negative values.
(validate_size): Apply test for negative values on GNAT nodes.
(set_rm_size): Likewise.
* gcc-interface/misc.c (gnat_init): Set unsigned types for sizetypes.
* gcc-interface/utils.c (rest_of_record_type_compilation): Change test
for negative values.
(max_size) <MINUS_EXPR>: Do not reassociate a COND_EXPR on the LHS.
(builtin_type_for_size): Adjust definition of signed_size_type_node.
* gcc-interface/utils2.c (compare_arrays): Optimize comparison of
lengths against zero.
2010-04-17 Eric Botcazou <ebotcazou@adacore.com>
* back-end.adb (Call_Back_End): Pass Standard_Character to gigi. * back-end.adb (Call_Back_End): Pass Standard_Character to gigi.
* gcc-interface/gigi.h (gigi): Add standard_character parameter. * gcc-interface/gigi.h (gigi): Add standard_character parameter.
(CHAR_TYPE_SIZE, SHORT_TYPE_SIZE, INT_TYPE_SIZE, LONG_TYPE_SIZE, (CHAR_TYPE_SIZE, SHORT_TYPE_SIZE, INT_TYPE_SIZE, LONG_TYPE_SIZE,
......
...@@ -2112,15 +2112,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -2112,15 +2112,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnat_base_index = Next_Index (gnat_base_index)) gnat_base_index = Next_Index (gnat_base_index))
{ {
tree gnu_index_type = get_unpadded_type (Etype (gnat_index)); tree gnu_index_type = get_unpadded_type (Etype (gnat_index));
const int prec_comp
= compare_tree_int (rm_size (gnu_index_type),
TYPE_PRECISION (sizetype));
const bool subrange_p = (prec_comp < 0
&& (TYPE_UNSIGNED (gnu_index_type)
|| !TYPE_UNSIGNED (sizetype)))
|| (prec_comp == 0
&& TYPE_UNSIGNED (gnu_index_type)
== TYPE_UNSIGNED (sizetype));
tree gnu_orig_min = TYPE_MIN_VALUE (gnu_index_type); tree gnu_orig_min = TYPE_MIN_VALUE (gnu_index_type);
tree gnu_orig_max = TYPE_MAX_VALUE (gnu_index_type); tree gnu_orig_max = TYPE_MAX_VALUE (gnu_index_type);
tree gnu_min = convert (sizetype, gnu_orig_min); tree gnu_min = convert (sizetype, gnu_orig_min);
...@@ -2129,7 +2120,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -2129,7 +2120,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
= get_unpadded_type (Etype (gnat_base_index)); = get_unpadded_type (Etype (gnat_base_index));
tree gnu_base_orig_min = TYPE_MIN_VALUE (gnu_base_index_type); tree gnu_base_orig_min = TYPE_MIN_VALUE (gnu_base_index_type);
tree gnu_base_orig_max = TYPE_MAX_VALUE (gnu_base_index_type); tree gnu_base_orig_max = TYPE_MAX_VALUE (gnu_base_index_type);
tree gnu_high, gnu_low; tree gnu_high;
/* See if the base array type is already flat. If it is, we /* See if the base array type is already flat. If it is, we
are probably compiling an ACATS test but it will cause the are probably compiling an ACATS test but it will cause the
...@@ -2145,8 +2136,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -2145,8 +2136,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* Similarly, if one of the values overflows in sizetype and the /* Similarly, if one of the values overflows in sizetype and the
range is null, use 1..0 for the sizetype bounds. */ range is null, use 1..0 for the sizetype bounds. */
else if (!subrange_p else if (TREE_CODE (gnu_min) == INTEGER_CST
&& TREE_CODE (gnu_min) == INTEGER_CST
&& TREE_CODE (gnu_max) == INTEGER_CST && TREE_CODE (gnu_max) == INTEGER_CST
&& (TREE_OVERFLOW (gnu_min) || TREE_OVERFLOW (gnu_max)) && (TREE_OVERFLOW (gnu_min) || TREE_OVERFLOW (gnu_max))
&& tree_int_cst_lt (gnu_orig_max, gnu_orig_min)) && tree_int_cst_lt (gnu_orig_max, gnu_orig_min))
...@@ -2159,8 +2149,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -2159,8 +2149,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* If the minimum and maximum values both overflow in sizetype, /* If the minimum and maximum values both overflow in sizetype,
but the difference in the original type does not overflow in but the difference in the original type does not overflow in
sizetype, ignore the overflow indication. */ sizetype, ignore the overflow indication. */
else if (!subrange_p else if (TREE_CODE (gnu_min) == INTEGER_CST
&& TREE_CODE (gnu_min) == INTEGER_CST
&& TREE_CODE (gnu_max) == INTEGER_CST && TREE_CODE (gnu_max) == INTEGER_CST
&& TREE_OVERFLOW (gnu_min) && TREE_OVERFLOW (gnu_max) && TREE_OVERFLOW (gnu_min) && TREE_OVERFLOW (gnu_max)
&& !TREE_OVERFLOW && !TREE_OVERFLOW
...@@ -2179,57 +2168,47 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -2179,57 +2168,47 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
deal with the "superflat" case. There are three ways to do deal with the "superflat" case. There are three ways to do
this. If we can prove that the array can never be superflat, this. If we can prove that the array can never be superflat,
we can just use the high bound of the index type. */ we can just use the high bound of the index type. */
else if (Nkind (gnat_index) == N_Range else if ((Nkind (gnat_index) == N_Range
&& cannot_be_superflat_p (gnat_index)) && cannot_be_superflat_p (gnat_index))
/* Packed Array Types are never superflat. */
|| Is_Packed_Array_Type (gnat_entity))
gnu_high = gnu_max; gnu_high = gnu_max;
/* Otherwise, if we can prove that the low bound minus one and /* Otherwise, if the high bound is constant but the low bound is
the high bound cannot overflow, we can just use the expression not, we use the expression (hb >= lb) ? lb : hb + 1 for the
MAX (hb, lb - 1). Similarly, if we can prove that the high lower bound. Note that the comparison must be done in the
bound plus one and the low bound cannot overflow, we can use original type to avoid any overflow during the conversion. */
the high bound as-is and MIN (hb + 1, lb) for the low bound. else if (TREE_CODE (gnu_max) == INTEGER_CST
Otherwise, we have to fall back to the most general expression && TREE_CODE (gnu_min) != INTEGER_CST)
(hb >= lb) ? hb : lb - 1. Note that the comparison must be
done in the original index type, to avoid any overflow during
the conversion. */
else
{ {
gnu_high = size_binop (MINUS_EXPR, gnu_min, size_one_node); gnu_high = gnu_max;
gnu_low = size_binop (PLUS_EXPR, gnu_max, size_one_node); gnu_min
= build_cond_expr (sizetype,
/* If gnu_high is a constant that has overflowed, the low build_binary_op (GE_EXPR,
bound is the smallest integer so cannot be the maximum. boolean_type_node,
If gnu_low is a constant that has overflowed, the high gnu_orig_max,
bound is the highest integer so cannot be the minimum. */ gnu_orig_min),
if ((TREE_CODE (gnu_high) == INTEGER_CST gnu_min,
&& TREE_OVERFLOW (gnu_high)) size_binop (PLUS_EXPR, gnu_max,
|| (TREE_CODE (gnu_low) == INTEGER_CST size_one_node));
&& TREE_OVERFLOW (gnu_low)))
gnu_high = gnu_max;
/* If the index type is a subrange and gnu_high a constant
that hasn't overflowed, we can use the maximum. */
else if (subrange_p && TREE_CODE (gnu_high) == INTEGER_CST)
gnu_high = size_binop (MAX_EXPR, gnu_max, gnu_high);
/* If the index type is a subrange and gnu_low a constant
that hasn't overflowed, we can use the minimum. */
else if (subrange_p && TREE_CODE (gnu_low) == INTEGER_CST)
{
gnu_high = gnu_max;
gnu_min = size_binop (MIN_EXPR, gnu_min, gnu_low);
}
else
gnu_high
= build_cond_expr (sizetype,
build_binary_op (GE_EXPR,
boolean_type_node,
gnu_orig_max,
gnu_orig_min),
gnu_max, gnu_high);
} }
/* Finally we use (hb >= lb) ? hb : lb - 1 for the upper bound
in all the other cases. Note that, here as well as above,
the condition used in the comparison must be equivalent to
the condition (length != 0). This is relied upon in order
to optimize array comparisons in compare_arrays. */
else
gnu_high
= build_cond_expr (sizetype,
build_binary_op (GE_EXPR,
boolean_type_node,
gnu_orig_max,
gnu_orig_min),
gnu_max,
size_binop (MINUS_EXPR, gnu_min,
size_one_node));
gnu_index_types[index] gnu_index_types[index]
= create_index_type (gnu_min, gnu_high, gnu_index_type, = create_index_type (gnu_min, gnu_high, gnu_index_type,
gnat_entity); gnat_entity);
...@@ -2299,7 +2278,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -2299,7 +2278,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
&& TREE_CODE (TREE_TYPE (gnu_index_type)) && TREE_CODE (TREE_TYPE (gnu_index_type))
!= INTEGER_TYPE) != INTEGER_TYPE)
|| TYPE_BIASED_REPRESENTATION_P (gnu_index_type) || TYPE_BIASED_REPRESENTATION_P (gnu_index_type)
|| prec_comp > 0) || compare_tree_int (rm_size (gnu_index_type),
TYPE_PRECISION (sizetype)) > 0)
need_index_type_struct = true; need_index_type_struct = true;
} }
...@@ -7128,9 +7108,11 @@ annotate_value (tree gnu_size) ...@@ -7128,9 +7108,11 @@ annotate_value (tree gnu_size)
this is in bitsizetype. */ this is in bitsizetype. */
gnu_size = convert (bitsizetype, gnu_size); gnu_size = convert (bitsizetype, gnu_size);
/* For a negative value, use NEGATE_EXPR of the opposite. Such values /* For a negative value, build NEGATE_EXPR of the opposite. Such values
appear in expressions containing aligning patterns. */ appear in expressions containing aligning patterns. Note that, since
if (tree_int_cst_sgn (gnu_size) < 0) sizetype is sign-extended but nonetheless unsigned, we don't directly
use tree_int_cst_sgn. */
if (TREE_INT_CST_HIGH (gnu_size) < 0)
{ {
tree op_size = fold_build1 (NEGATE_EXPR, bitsizetype, gnu_size); tree op_size = fold_build1 (NEGATE_EXPR, bitsizetype, gnu_size);
return annotate_value (build1 (NEGATE_EXPR, bitsizetype, op_size)); return annotate_value (build1 (NEGATE_EXPR, bitsizetype, op_size));
...@@ -7498,6 +7480,10 @@ validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object, ...@@ -7498,6 +7480,10 @@ validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object,
if (uint_size == No_Uint) if (uint_size == No_Uint)
return NULL_TREE; return NULL_TREE;
/* Ignore a negative size since that corresponds to our back-annotation. */
if (UI_Lt (uint_size, Uint_0))
return NULL_TREE;
/* Find the node to use for errors. */ /* Find the node to use for errors. */
if ((Ekind (gnat_object) == E_Component if ((Ekind (gnat_object) == E_Component
|| Ekind (gnat_object) == E_Discriminant) || Ekind (gnat_object) == E_Discriminant)
...@@ -7522,9 +7508,8 @@ validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object, ...@@ -7522,9 +7508,8 @@ validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object,
return NULL_TREE; return NULL_TREE;
} }
/* Ignore a negative size since that corresponds to our back-annotation. /* Ignore a zero size if it is not permitted. */
Also ignore a zero size if it is not permitted. */ if (!zero_ok && integer_zerop (size))
if (tree_int_cst_sgn (size) < 0 || (integer_zerop (size) && !zero_ok))
return NULL_TREE; return NULL_TREE;
/* The size of objects is always a multiple of a byte. */ /* The size of objects is always a multiple of a byte. */
...@@ -7611,6 +7596,10 @@ set_rm_size (Uint uint_size, tree gnu_type, Entity_Id gnat_entity) ...@@ -7611,6 +7596,10 @@ set_rm_size (Uint uint_size, tree gnu_type, Entity_Id gnat_entity)
if (uint_size == No_Uint) if (uint_size == No_Uint)
return; return;
/* Ignore a negative size since that corresponds to our back-annotation. */
if (UI_Lt (uint_size, Uint_0))
return;
/* Only issue an error if a Value_Size clause was explicitly given. /* Only issue an error if a Value_Size clause was explicitly given.
Otherwise, we'd be duplicating an error on the Size clause. */ Otherwise, we'd be duplicating an error on the Size clause. */
gnat_attr_node gnat_attr_node
...@@ -7627,15 +7616,13 @@ set_rm_size (Uint uint_size, tree gnu_type, Entity_Id gnat_entity) ...@@ -7627,15 +7616,13 @@ set_rm_size (Uint uint_size, tree gnu_type, Entity_Id gnat_entity)
return; return;
} }
/* Ignore a negative size since that corresponds to our back-annotation. /* Ignore a zero size unless a Value_Size clause exists, or a size clause
Also ignore a zero size unless a Value_Size clause exists, or a size exists, or this is an integer type, in which case the front-end will
clause exists, or this is an integer type, in which case the front-end have always set it. */
will have always set it. */ if (No (gnat_attr_node)
if (tree_int_cst_sgn (size) < 0 && integer_zerop (size)
|| (integer_zerop (size) && !Has_Size_Clause (gnat_entity)
&& No (gnat_attr_node) && !Is_Discrete_Or_Fixed_Point_Type (gnat_entity))
&& !Has_Size_Clause (gnat_entity)
&& !Is_Discrete_Or_Fixed_Point_Type (gnat_entity)))
return; return;
old_size = rm_size (gnu_type); old_size = rm_size (gnu_type);
......
...@@ -391,13 +391,16 @@ gnat_init (void) ...@@ -391,13 +391,16 @@ gnat_init (void)
/* Do little here, most of the standard declarations are set up after the /* Do little here, most of the standard declarations are set up after the
front-end has been run. Use the same `char' as C, this doesn't really front-end has been run. Use the same `char' as C, this doesn't really
matter since we'll use the explicit `unsigned char' for Character. */ matter since we'll use the explicit `unsigned char' for Character. */
build_common_tree_nodes (flag_signed_char, true); build_common_tree_nodes (flag_signed_char, false);
/* In Ada, we use a signed type for SIZETYPE. Use the signed type /* In Ada, we use the unsigned type corresponding to the width of Pmode as
corresponding to the width of Pmode. In most cases when ptr_mode SIZETYPE. In most cases when ptr_mode and Pmode differ, C will use the
and Pmode differ, C will use the width of ptr_mode for SIZETYPE. width of ptr_mode for SIZETYPE, but we get better code using the width
But we get far better code using the width of Pmode. */ of Pmode. Note that, although we manipulate negative offsets for some
size_type_node = gnat_type_for_mode (Pmode, 0); internal constructs and rely on compile time overflow detection in size
computations, using unsigned types for SIZETYPEs is fine since they are
treated specially by the middle-end, in particular sign-extended. */
size_type_node = gnat_type_for_mode (Pmode, 1);
set_sizetype (size_type_node); set_sizetype (size_type_node);
TYPE_NAME (sizetype) = get_identifier ("size_type"); TYPE_NAME (sizetype) = get_identifier ("size_type");
......
...@@ -839,11 +839,13 @@ rest_of_record_type_compilation (tree record_type) ...@@ -839,11 +839,13 @@ rest_of_record_type_compilation (tree record_type)
align = tree_low_cst (TREE_OPERAND (curpos, 1), 1); align = tree_low_cst (TREE_OPERAND (curpos, 1), 1);
/* An offset which is a bitwise AND with a negative power of 2 /* An offset which is a bitwise AND with a negative power of 2
means an alignment corresponding to this power of 2. */ means an alignment corresponding to this power of 2. Note
that, as sizetype is sign-extended but nonetheless unsigned,
we don't directly use tree_int_cst_sgn. */
offset = remove_conversions (offset, true); offset = remove_conversions (offset, true);
if (TREE_CODE (offset) == BIT_AND_EXPR if (TREE_CODE (offset) == BIT_AND_EXPR
&& host_integerp (TREE_OPERAND (offset, 1), 0) && host_integerp (TREE_OPERAND (offset, 1), 0)
&& tree_int_cst_sgn (TREE_OPERAND (offset, 1)) < 0) && TREE_INT_CST_HIGH (TREE_OPERAND (offset, 1)) < 0)
{ {
unsigned int pow unsigned int pow
= - tree_low_cst (TREE_OPERAND (offset, 1), 0); = - tree_low_cst (TREE_OPERAND (offset, 1), 0);
...@@ -2175,22 +2177,6 @@ max_size (tree exp, bool max_p) ...@@ -2175,22 +2177,6 @@ max_size (tree exp, bool max_p)
if (code == COMPOUND_EXPR) if (code == COMPOUND_EXPR)
return max_size (TREE_OPERAND (exp, 1), max_p); return max_size (TREE_OPERAND (exp, 1), max_p);
/* Calculate "(A ? B : C) - D" as "A ? B - D : C - D" which
may provide a tighter bound on max_size. */
if (code == MINUS_EXPR
&& TREE_CODE (TREE_OPERAND (exp, 0)) == COND_EXPR)
{
tree lhs = fold_build2 (MINUS_EXPR, type,
TREE_OPERAND (TREE_OPERAND (exp, 0), 1),
TREE_OPERAND (exp, 1));
tree rhs = fold_build2 (MINUS_EXPR, type,
TREE_OPERAND (TREE_OPERAND (exp, 0), 2),
TREE_OPERAND (exp, 1));
return fold_build2 (max_p ? MAX_EXPR : MIN_EXPR, type,
max_size (lhs, max_p),
max_size (rhs, max_p));
}
{ {
tree lhs = max_size (TREE_OPERAND (exp, 0), max_p); tree lhs = max_size (TREE_OPERAND (exp, 0), max_p);
tree rhs = max_size (TREE_OPERAND (exp, 1), tree rhs = max_size (TREE_OPERAND (exp, 1),
...@@ -4707,7 +4693,7 @@ builtin_type_for_size (int size, bool unsignedp) ...@@ -4707,7 +4693,7 @@ builtin_type_for_size (int size, bool unsignedp)
static void static void
install_builtin_elementary_types (void) install_builtin_elementary_types (void)
{ {
signed_size_type_node = size_type_node; signed_size_type_node = gnat_signed_type (size_type_node);
pid_type_node = integer_type_node; pid_type_node = integer_type_node;
void_list_node = build_void_list_node (); void_list_node = build_void_list_node ();
......
...@@ -351,14 +351,26 @@ compare_arrays (tree result_type, tree a1, tree a2) ...@@ -351,14 +351,26 @@ compare_arrays (tree result_type, tree a1, tree a2)
if (EXPR_P (comparison)) if (EXPR_P (comparison))
SET_EXPR_LOCATION (comparison, input_location); SET_EXPR_LOCATION (comparison, input_location);
this_a1_is_null = build_binary_op (EQ_EXPR, result_type, length1, /* If the length expression is of the form (cond ? val : 0), assume
size_zero_node); that cond is equivalent to (length != 0). That's guaranteed by
if (EXPR_P (this_a1_is_null)) construction of the array types in gnat_to_gnu_entity. */
if (TREE_CODE (length1) == COND_EXPR
&& integer_zerop (TREE_OPERAND (length1, 2)))
this_a1_is_null = invert_truthvalue (TREE_OPERAND (length1, 0));
else
this_a1_is_null = build_binary_op (EQ_EXPR, result_type, length1,
size_zero_node);
if (EXPR_P (this_a1_is_null))
SET_EXPR_LOCATION (this_a1_is_null, input_location); SET_EXPR_LOCATION (this_a1_is_null, input_location);
this_a2_is_null = build_binary_op (EQ_EXPR, result_type, length2, /* Likewise for the second array. */
size_zero_node); if (TREE_CODE (length2) == COND_EXPR
if (EXPR_P (this_a2_is_null)) && integer_zerop (TREE_OPERAND (length2, 2)))
this_a2_is_null = invert_truthvalue (TREE_OPERAND (length2, 0));
else
this_a2_is_null = build_binary_op (EQ_EXPR, result_type, length2,
size_zero_node);
if (EXPR_P (this_a2_is_null))
SET_EXPR_LOCATION (this_a2_is_null, input_location); SET_EXPR_LOCATION (this_a2_is_null, input_location);
} }
......
...@@ -75,6 +75,10 @@ typedef struct {const int *Array; Vector_Template *Bounds; } ...@@ -75,6 +75,10 @@ typedef struct {const int *Array; Vector_Template *Bounds; }
#define Vector_To_Uint uintp__vector_to_uint #define Vector_To_Uint uintp__vector_to_uint
extern Uint Vector_To_Uint (Int_Vector, Boolean); extern Uint Vector_To_Uint (Int_Vector, Boolean);
/* Compare integer values for less than. */
#define UI_Lt uintp__ui_lt
extern Boolean UI_Lt (Uint, Uint);
/* Universal integers are represented by the Uint type which is an index into /* Universal integers are represented by the Uint type which is an index into
the Uints_Ptr table containing Uint_Entry values. A Uint_Entry contains an the Uints_Ptr table containing Uint_Entry values. A Uint_Entry contains an
index and length for getting the "digits" of the universal integer from the index and length for getting the "digits" of the universal integer from the
......
2010-04-17 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/sizetype.adb: Rename into...
* gnat.dg/sizetype1.adb: ...this.
* gnat.dg/sizetype2.adb: New test.
2010-04-16 Richard Guenther <rguenther@suse.de> 2010-04-16 Richard Guenther <rguenther@suse.de>
PR tree-optimization/43572 PR tree-optimization/43572
......
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
with Interfaces.C; use Interfaces.C; with Interfaces.C; use Interfaces.C;
procedure Sizetype is procedure Sizetype1 is
TC_String : String(1..8) := "abcdefgh"; TC_String : String(1..8) := "abcdefgh";
TC_No_nul : constant char_array := To_C(TC_String, False); TC_No_nul : constant char_array := To_C(TC_String, False);
......
-- { dg-do run }
procedure Sizetype2 is
function Ident_Int (X : Integer) return Integer is
begin
return X;
end;
type A is array (Integer range <>) of Boolean;
subtype T1 is A (Ident_Int (- 6) .. Ident_Int (Integer'Last - 4));
subtype T2 is A (- 6 .. Ident_Int (Integer'Last - 4));
subtype T3 is A (Ident_Int (- 6) .. Integer'Last - 4);
begin
if T1'Size /= 17179869200 then
raise Program_Error;
end if;
if T2'Size /= 17179869200 then
raise Program_Error;
end if;
if T3'Size /= 17179869200 then
raise Program_Error;
end if;
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