diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/trans.c | 9 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 4 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/hyper_flat.adb | 17 |
4 files changed, 33 insertions, 2 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3cb89a6..8dadc3d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -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 diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 005d517..7a82004 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -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, diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index ae35d29..824776d 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -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. diff --git a/gcc/testsuite/gnat.dg/hyper_flat.adb b/gcc/testsuite/gnat.dg/hyper_flat.adb new file mode 100644 index 0000000..6842edb --- /dev/null +++ b/gcc/testsuite/gnat.dg/hyper_flat.adb @@ -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; |