From 9ed0e4832cd4956012baf9fff96db6f61ecf3515 Mon Sep 17 00:00:00 2001 From: Thomas Quinot Date: Fri, 7 Nov 2008 10:17:40 +0000 Subject: [PATCH] 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 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/gcc-interface/trans.c | 9 +++++++-- gcc/testsuite/ChangeLog | 4 ++++ gcc/testsuite/gnat.dg/hyper_flat.adb | 17 +++++++++++++++++ 4 files changed, 33 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/hyper_flat.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3cb89a6cd21..8dadc3dfe9e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2008-11-07 Thomas Quinot + + * 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 * 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 005d517fda8..7a82004b2d2 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 ae35d29d436..824776d0459 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2008-11-07 Thomas Quinot + + * gnat.dg/hyper_flat.adb: New test. + 2008-11-07 Geert Bosch * 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 00000000000..6842edbf52a --- /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; -- 2.30.2