sem_ch5.adb (One_Bound): Fix latent bug involving secondary stack

2008-08-22  Robert Dewar  <dewar@adacore.com>

	* sem_ch5.adb (One_Bound): Fix latent bug involving secondary stack

From-SVN: r139464

diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index e5954a921108ff331e71228f4d0c6f6e834d65cc..a26d4b703cd29d337326c16e0e1a13485e9a9caa 100644 (file)
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -1465,10 +1465,7 @@ package body Sem_Ch5 is
          function One_Bound
            (Original_Bound : Node_Id;
             Analyzed_Bound : Node_Id) return Node_Id;
-         --  Create one declaration followed by one assignment statement
-         --  to capture the value of bound. We create a separate assignment
-         --  in order to force the creation of a block in case the bound
-         --  contains a call that uses the secondary stack.
+         --  Capture value of bound and return captured value
 
          ---------------
          -- One_Bound --
@@ -1499,15 +1496,53 @@ package body Sem_Ch5 is
             then
                Analyze_And_Resolve (Original_Bound, Typ);
                return Original_Bound;
-
-            else
-               Analyze_And_Resolve (Original_Bound, Typ);
             end if;
 
+            --  Here we need to capture the value
+
+            Analyze_And_Resolve (Original_Bound, Typ);
+
             Id :=
               Make_Defining_Identifier (Loc,
                 Chars => New_Internal_Name ('S'));
 
+            --  Normally, the best approach is simply to generate a constant
+            --  declaration that captures the bound. However, there is a nasty
+            --  case where this is wrong. If the bound is complex, and has a
+            --  possible use of the secondary stack, we need to generate a
+            --  separate assignment statement to ensure the creation of a block
+            --  which will release the secondary stack.
+
+            --  We prefer the constant declaration, since it leaves us with a
+            --  proper trace of the value, useful in optimizations that get rid
+            --  of junk range checks.
+
+            --  Probably we want something like the Side_Effect_Free routine
+            --  in Exp_Util, but for now, we just optimize the cases of 'Last
+            --  and 'First applied to an entity, since these are the important
+            --  cases for range check optimizations.
+
+            if Nkind (Original_Bound) = N_Attribute_Reference
+              and then (Attribute_Name (Original_Bound) = Name_First
+                          or else
+                        Attribute_Name (Original_Bound) = Name_Last)
+              and then Is_Entity_Name (Prefix (Original_Bound))
+            then
+               Decl :=
+                 Make_Object_Declaration (Loc,
+                   Defining_Identifier => Id,
+                   Constant_Present    => True,
+                   Object_Definition   => New_Occurrence_Of (Typ, Loc),
+                   Expression          => Relocate_Node (Original_Bound));
+
+               Insert_Before (Parent (N), Decl);
+               Analyze (Decl);
+               Rewrite (Original_Bound, New_Occurrence_Of (Id, Loc));
+               return Expression (Decl);
+            end if;
+
+            --  Here we make a declaration with a separate assignment statement
+
             Decl :=
               Make_Object_Declaration (Loc,
                 Defining_Identifier => Id,