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:
parent
f0f91b6438
commit
9ed0e4832c
@ -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
|
||||
|
@ -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,
|
||||
|
@ -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.
|
||||
|
17
gcc/testsuite/gnat.dg/hyper_flat.adb
Normal file
17
gcc/testsuite/gnat.dg/hyper_flat.adb
Normal 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;
|
Loading…
Reference in New Issue
Block a user