trans.c (Attribute_to_gnu, [...]): Check for empty range in original base type, not converted result type.

* gcc-interface/trans.c (Attribute_to_gnu, case Attr_Length): Check
	for empty range in original base type, not converted result type.

From-SVN: r141670
This commit is contained in:
Thomas Quinot 2008-11-07 10:17:40 +00:00 committed by Eric Botcazou
parent f0f91b6438
commit 9ed0e4832c
4 changed files with 33 additions and 2 deletions

View File

@ -1,3 +1,8 @@
2008-11-07 Thomas Quinot <quinot@adacore.com>
* gcc-interface/trans.c (Attribute_to_gnu, case Attr_Length): Check
for empty range in original base type, not converted result type.
2008-11-07 Geert Bosch <bosch@adacore.com>
* gcc-interface/trans.c (build_binary_op_trapv): Convert arguments

View File

@ -1287,7 +1287,10 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
much rarer cases, for extremely large arrays we expect
never to encounter in practice. In addition, the former
computation required the use of potentially constraining
signed arithmetic while the latter doesn't. */
signed arithmetic while the latter doesn't. Note that the
comparison must be done in the original index base type,
otherwise the conversion of either bound to gnu_compute_type
may overflow. */
tree gnu_compute_type = get_base_type (gnu_result_type);
@ -1301,7 +1304,9 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
gnu_result
= build3
(COND_EXPR, gnu_compute_type,
build_binary_op (LT_EXPR, gnu_compute_type, hb, lb),
build_binary_op (LT_EXPR, get_base_type (index_type),
TYPE_MAX_VALUE (index_type),
TYPE_MIN_VALUE (index_type)),
convert (gnu_compute_type, integer_zero_node),
build_binary_op
(PLUS_EXPR, gnu_compute_type,

View File

@ -1,3 +1,7 @@
2008-11-07 Thomas Quinot <quinot@adacore.com>
* gnat.dg/hyper_flat.adb: New test.
2008-11-07 Geert Bosch <bosch@adacore.com>
* gnat.dg/test_8bitlong_overflow.adb: New test.

View File

@ -0,0 +1,17 @@
-- { dg-do run }
-- { dg-options "-gnatp" }
procedure Hyper_Flat is
type Unsigned is mod 2 ** 32;
x : Integer := 0;
pragma Volatile (X);
S : constant String := (1 .. X - 3 => 'A');
-- Hyper-flat null string
begin
if Unsigned'(S'Length) /= 0 then
raise Program_Error;
end if;
end;