From 322131422949bce3246db4b2031a9032858080e4 Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Wed, 5 Dec 2001 01:48:56 +0000 Subject: [PATCH] * 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 --- gcc/ada/ChangeLog | 7 +++++++ gcc/ada/sem_attr.adb | 41 ++++++++++++++++++++++++++++++++++++----- 2 files changed, 43 insertions(+), 5 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8aa8b1670354..3b6f176baafb 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2001-12-04 Robert Dewar + + * 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 * 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 98b5fdf690b7..9cf41f92e4c0 100644 --- 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; -- 2.43.5