From f80cddcb5d45179f285da0a56a36db694935148d Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Tue, 13 May 2008 08:46:18 +0000 Subject: [PATCH] re PR ada/24880 (infinite loop on conversion of integer type with size clause) PR ada/24880 PR ada/26635 * utils.c (convert) : When converting an additive expression to an integral type with lower precision, use NOP_EXPR directly in a couple of special cases. From-SVN: r135257 --- gcc/ada/ChangeLog | 8 ++++++++ gcc/ada/utils.c | 26 ++++++++++++++++++++++++- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gnat.dg/conv_integer.adb | 12 ++++++++++++ gcc/testsuite/gnat.dg/discr7.adb | 27 ++++++++++++++++++++++++++ 5 files changed, 77 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gnat.dg/conv_integer.adb create mode 100644 gcc/testsuite/gnat.dg/discr7.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5330ee53083..cffae3bc3a7 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2008-05-13 Eric Botcazou + + PR ada/24880 + PR ada/26635 + * utils.c (convert) : When converting an additive + expression to an integral type with lower precision, use NOP_EXPR + directly in a couple of special cases. + 2008-05-12 Samuel Tardieu Ed Schonberg diff --git a/gcc/ada/utils.c b/gcc/ada/utils.c index 202818db345..b4b38941ddb 100644 --- a/gcc/ada/utils.c +++ b/gcc/ada/utils.c @@ -3627,7 +3627,7 @@ convert (tree type, tree expr) if (TYPE_FAT_POINTER_P (type) && !TYPE_FAT_POINTER_P (etype)) return convert_to_fat_pointer (type, expr); - /* If we're converting between two aggregate types that are mere + /* If we are converting between two aggregate types that are mere variants, just make a VIEW_CONVERT_EXPR. */ else if (code == ecode && AGGREGATE_TYPE_P (type) @@ -3662,6 +3662,30 @@ convert (tree type, tree expr) /* ... fall through ... */ case ENUMERAL_TYPE: + /* If we are converting an additive expression to an integer type + with lower precision, be wary of the optimization that can be + applied by convert_to_integer. There are 2 problematic cases: + - if the first operand was originally of a biased type, + because we could be recursively called to convert it + to an intermediate type and thus rematerialize the + additive operator endlessly, + - if the expression contains a placeholder, because an + intermediate conversion that changes the sign could + be inserted and thus introduce an artificial overflow + at compile time when the placeholder is substituted. */ + if (code == INTEGER_TYPE + && ecode == INTEGER_TYPE + && TYPE_PRECISION (type) < TYPE_PRECISION (etype) + && (TREE_CODE (expr) == PLUS_EXPR || TREE_CODE (expr) == MINUS_EXPR)) + { + tree op0 = get_unwidened (TREE_OPERAND (expr, 0), type); + + if ((TREE_CODE (TREE_TYPE (op0)) == INTEGER_TYPE + && TYPE_BIASED_REPRESENTATION_P (TREE_TYPE (op0))) + || CONTAINS_PLACEHOLDER_P (expr)) + return build1 (NOP_EXPR, type, expr); + } + return fold (convert_to_integer (type, expr)); case POINTER_TYPE: diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 1586f486f50..e870fb4bac3 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2008-05-13 Eric Botcazou + + * gnat.dg/discr7.adb: New test + * gnat.dg/conv_integer.adb: Likewise. + 2008-05-12 Janis Johnson * gcc.c-torture/compile/pr11832.c: XFAIL for mips and powerpc-linux, diff --git a/gcc/testsuite/gnat.dg/conv_integer.adb b/gcc/testsuite/gnat.dg/conv_integer.adb new file mode 100644 index 00000000000..7693da0775a --- /dev/null +++ b/gcc/testsuite/gnat.dg/conv_integer.adb @@ -0,0 +1,12 @@ +-- { dg-do compile } +-- { dg-options "-gnatws" } + +procedure Conv_Integer is + S : constant := Integer'Size; + type Regoff_T is range -1 .. 2 ** (S-1); + for Regoff_T'Size use S; + B : Integer; + C : Regoff_T; +begin + B := Integer (C); +end; diff --git a/gcc/testsuite/gnat.dg/discr7.adb b/gcc/testsuite/gnat.dg/discr7.adb new file mode 100644 index 00000000000..3bb61cb12b6 --- /dev/null +++ b/gcc/testsuite/gnat.dg/discr7.adb @@ -0,0 +1,27 @@ +-- { dg-do compile } + +procedure Discr7 is + + subtype Index is Natural range 0..5; + type BitString is array(Index range <>) of Boolean; + pragma Pack(BitString); + + function Id (I : Integer) return Integer is + begin + return I; + end; + + type E(D : Index) is record + C : BitString(1..D); + end record; + + subtype E0 is E(Id(0)); + + function F return E0 is + begin + return E'(D=>0, C=>(1..0=>FALSE)); + end; + +begin + null; +end; -- 2.30.2