* sem_attr.adb:

	(Compile_Time_Known_Attribute): New procedure.
	(Eval_Attribute, case Size): Use Compile_Time_Known_Attribute to ensure
	 proper range check.

From-SVN: r47646

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 8aa8b16703546f191b70bc3495ac279c35004df2..3b6f176baafbf41262c2178d0232ada6a6c884c2 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2001-12-04  Robert Dewar <dewar@gnat.com>
+
+       * sem_attr.adb:
+       (Compile_Time_Known_Attribute): New procedure.
+       (Eval_Attribute, case Size): Use Compile_Time_Known_Attribute to ensure
+        proper range check.
+
 2001-12-04  Ed Schonberg <schonber@gnat.com>
 
        * sem_ch7.adb (New_Private_Type): Set Is_Tagged_Type flag before 

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 98b5fdf690b7f7ea40f13cc5f92575c558eda4ed..9cf41f92e4c0b658f7e1e241eba74dd56ced1d89 100644 (file)
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -3682,6 +3682,11 @@ package body Sem_Attr is
       --  any, of the attribute, are in a non-static context. This procedure
       --  performs the required additional checks.
 
+      procedure Compile_Time_Known_Attribute (N : Node_Id; Val : Uint);
+      --  This procedure is called when the attribute N has a non-static
+      --  but compile time known value given by Val. It includes the
+      --  necessary checks for out of range values.
+
       procedure Float_Attribute_Universal_Integer
         (IEEES_Val : Int;
          IEEEL_Val : Int;
@@ -3755,6 +3760,34 @@ package body Sem_Attr is
          end loop;
       end Check_Expressions;
 
+      ----------------------------------
+      -- Compile_Time_Known_Attribute --
+      ----------------------------------
+
+      procedure Compile_Time_Known_Attribute (N : Node_Id; Val : Uint) is
+         T : constant Entity_Id := Etype (N);
+
+      begin
+         Fold_Uint (N, Val);
+         Set_Is_Static_Expression (N, False);
+
+         --  Check that result is in bounds of the type if it is static
+
+         if Is_In_Range (N, T) then
+            null;
+
+         elsif Is_Out_Of_Range (N, T) then
+            Apply_Compile_Time_Constraint_Error
+              (N, "value not in range of}?");
+
+         elsif not Range_Checks_Suppressed (T) then
+            Enable_Range_Check (N);
+
+         else
+            Set_Do_Range_Check (N, False);
+         end if;
+      end Compile_Time_Known_Attribute;
+
       ---------------------------------------
       -- Float_Attribute_Universal_Integer --
       ---------------------------------------
@@ -4065,8 +4098,7 @@ package body Sem_Attr is
             if Is_Entity_Name (P)
               and then Known_Esize (Entity (P))
             then
-               Fold_Uint (N, Esize (Entity (P)));
-               Set_Is_Static_Expression (N, False);
+               Compile_Time_Known_Attribute (N, Esize (Entity (P)));
                return;
 
             else
@@ -4178,8 +4210,7 @@ package body Sem_Attr is
         and then (not Is_Generic_Type (P_Entity))
         and then Known_Static_RM_Size (P_Entity)
       then
-         Fold_Uint (N, RM_Size (P_Entity));
-         Set_Is_Static_Expression (N, False);
+         Compile_Time_Known_Attribute (N, RM_Size (P_Entity));
          return;
 
       --  No other cases are foldable (they certainly aren't static, and at
@@ -6270,6 +6301,7 @@ package body Sem_Attr is
                end if;
 
                if Is_Tagged_Type (Designated_Type (Typ)) then
+
                   --  If the attribute is in the context of an access
                   --  parameter, then the prefix is allowed to be of
                   --  the class-wide type (by AI-127).
@@ -6278,7 +6310,6 @@ package body Sem_Attr is
                      if not Covers (Designated_Type (Typ), Nom_Subt)
                        and then not Covers (Nom_Subt, Designated_Type (Typ))
                      then
-
                         declare
                            Desig : Entity_Id;