Index: sem_ch3.adb =================================================================== --- sem_ch3.adb (revision 213284) +++ sem_ch3.adb (working copy) @@ -12390,7 +12390,7 @@ Set_Etype (S, T); R := S; - Process_Range_Expr_In_Decl (R, T, Empty_List); + Process_Range_Expr_In_Decl (R, T); if not Error_Posted (S) and then @@ -19018,9 +19018,10 @@ procedure Process_Range_Expr_In_Decl (R : Node_Id; T : Entity_Id; - Check_List : List_Id := Empty_List; - R_Check_Off : Boolean := False; - In_Iter_Schm : Boolean := False) + Subtyp : Entity_Id := Empty; + Check_List : List_Id := Empty_List; + R_Check_Off : Boolean := False; + In_Iter_Schm : Boolean := False) is Lo, Hi : Node_Id; R_Checks : Check_Result; @@ -19142,8 +19143,71 @@ -- not supposed to occur, e.g. on default parameters of a call. if Expander_Active or GNATprove_Mode then - Force_Evaluation (Lo); - Force_Evaluation (Hi); + + -- If no subtype name, then just call Force_Evaluation to + -- create declarations as needed to deal with side effects. + -- Also ignore calls from within a record type, where we + -- have possible scoping issues. + + if No (Subtyp) or else Is_Record_Type (Current_Scope) then + Force_Evaluation (Lo); + Force_Evaluation (Hi); + + -- If a subtype is given, then we capture the bounds if they + -- are not known at compile time, using constant identifiers + -- xxxL and xxxH where xxx is the name of the subtype. No need + -- to do that if they are already references to constants. + + -- Historical note: We used to just do Force_Evaluation calls + -- in all cases, but it is better to capture the bounds with + -- proper non-serialized names, since these will be accesse + -- from other units, and hence may be public, and also we can + -- then expand 'First and 'Last references to be references to + -- these special names. + + else + if not Compile_Time_Known_Value (Lo) + and then not (Is_Entity_Name (Lo) + and then Is_Constant_Object (Entity (Lo))) + then + declare + Loc : constant Source_Ptr := Sloc (Lo); + Lov : constant Entity_Id := + Make_Defining_Identifier (Loc, + Chars => New_External_Name (Chars (Subtyp), 'L')); + begin + Insert_Action (R, + Make_Object_Declaration (Loc, + Defining_Identifier => Lov, + Object_Definition => + New_Occurrence_Of (Base_Type (T), Loc), + Constant_Present => True, + Expression => Relocate_Node (Lo))); + Rewrite (Lo, New_Occurrence_Of (Lov, Loc)); + end; + end if; + + if not Compile_Time_Known_Value (Hi) + and then not (Is_Entity_Name (Hi) + and then Is_Constant_Object (Entity (Hi))) + then + declare + Loc : constant Source_Ptr := Sloc (Hi); + Hiv : constant Entity_Id := + Make_Defining_Identifier (Loc, + Chars => New_External_Name (Chars (Subtyp), 'H')); + begin + Insert_Action (R, + Make_Object_Declaration (Loc, + Defining_Identifier => Hiv, + Object_Definition => + New_Occurrence_Of (Base_Type (T), Loc), + Constant_Present => True, + Expression => Relocate_Node (Hi))); + Rewrite (Hi, New_Occurrence_Of (Hiv, Loc)); + end; + end if; + end if; end if; -- We use a flag here instead of suppressing checks on the @@ -20567,7 +20631,7 @@ -- catch possible premature use in the bounds themselves. Set_Ekind (Def_Id, E_Void); - Process_Range_Expr_In_Decl (R, Subt); + Process_Range_Expr_In_Decl (R, Subt, Subtyp => Def_Id); Set_Ekind (Def_Id, Kind); end Set_Scalar_Range_For_Subtype; Index: sem_ch3.ads =================================================================== --- sem_ch3.ads (revision 213284) +++ sem_ch3.ads (working copy) @@ -264,9 +264,10 @@ procedure Process_Range_Expr_In_Decl (R : Node_Id; T : Entity_Id; - Check_List : List_Id := Empty_List; - R_Check_Off : Boolean := False; - In_Iter_Schm : Boolean := False); + Subtyp : Entity_Id := Empty; + Check_List : List_Id := Empty_List; + R_Check_Off : Boolean := False; + In_Iter_Schm : Boolean := False); -- Process a range expression that appears in a declaration context. The -- range is analyzed and resolved with the base type of the given type, and -- an appropriate check for expressions in non-static contexts made on the @@ -279,6 +280,9 @@ -- package. R_Check_Off is set to True when the call to Range_Check is to -- be skipped. In_Iter_Schm is True if Process_Range_Expr_In_Decl is called -- on the discrete subtype definition in an iteration scheme. + -- + -- If Subtyp is given, then the range is for the named subtype Subtyp, and + -- in this case the bounds are captured if necessary using this name. function Process_Subtype (S : Node_Id; Index: exp_attr.adb =================================================================== --- exp_attr.adb (revision 213263) +++ exp_attr.adb (working copy) @@ -2872,11 +2872,28 @@ Rewrite (N, Make_Attribute_Reference (Loc, Attribute_Name => Name_First, - Prefix => New_Occurrence_Of (Get_Index_Subtype (N), Loc))); + Prefix => + New_Occurrence_Of (Get_Index_Subtype (N), Loc))); Analyze_And_Resolve (N, Typ); + -- For access type, apply access check as needed + elsif Is_Access_Type (Ptyp) then Apply_Access_Check (N); + + -- For scalar type, if low bound is a reference to an entity, just + -- replace with a direct reference. Note that we can only have a + -- reference to a constant entity at this stage, anything else would + -- have already been rewritten. + + elsif Is_Scalar_Type (Ptyp) then + declare + Lo : constant Node_Id := Type_Low_Bound (Ptyp); + begin + if Is_Entity_Name (Lo) then + Rewrite (N, New_Occurrence_Of (Entity (Lo), Loc)); + end if; + end; end if; --------------- @@ -3535,8 +3552,24 @@ Prefix => New_Occurrence_Of (Get_Index_Subtype (N), Loc))); Analyze_And_Resolve (N, Typ); + -- For access type, apply access check as needed + elsif Is_Access_Type (Ptyp) then Apply_Access_Check (N); + + -- For scalar type, if low bound is a reference to an entity, just + -- replace with a direct reference. Note that we can only have a + -- reference to a constant entity at this stage, anything else would + -- have already been rewritten. + + elsif Is_Scalar_Type (Ptyp) then + declare + Hi : constant Node_Id := Type_High_Bound (Ptyp); + begin + if Is_Entity_Name (Hi) then + Rewrite (N, New_Occurrence_Of (Entity (Hi), Loc)); + end if; + end; end if; -------------- Index: sem_eval.adb =================================================================== --- sem_eval.adb (revision 213264) +++ sem_eval.adb (working copy) @@ -1240,16 +1240,22 @@ return Unknown; end if; - -- Replace types by base types for the case of entities which are not + -- Replace types by base types for the case of values which are not -- known to have valid representations. This takes care of properly -- dealing with invalid representations. - if not Assume_Valid and then not Assume_No_Invalid_Values then - if Is_Entity_Name (L) and then not Is_Known_Valid (Entity (L)) then + if not Assume_Valid then + if not (Is_Entity_Name (L) + and then (Is_Known_Valid (Entity (L)) + or else Assume_No_Invalid_Values)) + then Ltyp := Underlying_Type (Base_Type (Ltyp)); end if; - if Is_Entity_Name (R) and then not Is_Known_Valid (Entity (R)) then + if not (Is_Entity_Name (R) + and then (Is_Known_Valid (Entity (R)) + or else Assume_No_Invalid_Values)) + then Rtyp := Underlying_Type (Base_Type (Rtyp)); end if; end if; Index: exp_ch3.adb =================================================================== --- exp_ch3.adb (revision 213263) +++ exp_ch3.adb (working copy) @@ -3234,7 +3234,7 @@ begin if Nkind (S) = N_Range then - Process_Range_Expr_In_Decl (S, T, Check_List); + Process_Range_Expr_In_Decl (S, T, Check_List => Check_List); end if; end Constrain_Index; @@ -5844,9 +5844,14 @@ return; -- For discrete types, set the Is_Known_Valid flag if the - -- initializing value is known to be valid. + -- initializing value is known to be valid. Only do this for + -- source assignments, since otherwise we can end up turning + -- on the known valid flag prematurely from inserted code. - elsif Is_Discrete_Type (Typ) and then Expr_Known_Valid (Expr) then + elsif Comes_From_Source (N) + and then Is_Discrete_Type (Typ) + and then Expr_Known_Valid (Expr) + then Set_Is_Known_Valid (Def_Id); elsif Is_Access_Type (Typ) then