diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -12017,31 +12017,23 @@ package body Exp_Util is -- renaming is handled by the front end, as the back end may balk at -- the nonstandard representation (see Evaluation_Required in Exp_Ch8). - elsif Nkind (Exp) in N_Indexed_Component | N_Selected_Component - and then Has_Non_Standard_Rep (Etype (Prefix (Exp))) - then - Def_Id := Build_Temporary (Loc, 'R', Exp); - Res := New_Occurrence_Of (Def_Id, Loc); - - Insert_Action (Exp, - Make_Object_Renaming_Declaration (Loc, - Defining_Identifier => Def_Id, - Subtype_Mark => New_Occurrence_Of (Exp_Type, Loc), - Name => Relocate_Node (Exp))); + elsif (Nkind (Exp) in N_Indexed_Component | N_Selected_Component + and then Has_Non_Standard_Rep (Etype (Prefix (Exp)))) - -- For an expression that denotes a name, we can use a renaming scheme. - -- This is needed for correctness in the case of a volatile object of - -- a nonvolatile type because the Make_Reference call of the "default" - -- approach would generate an illegal access value (an access value - -- cannot designate such an object - see Analyze_Reference). + -- For an expression that denotes a name, we can use a renaming + -- scheme. This is needed for correctness in the case of a volatile + -- object of a nonvolatile type because the Make_Reference call of the + -- "default" approach would generate an illegal access value (an + -- access value cannot designate such an object - see + -- Analyze_Reference). - elsif Is_Name_Reference (Exp) + or else (Is_Name_Reference (Exp) - -- We skip using this scheme if we have an object of a volatile - -- type and we do not have Name_Req set true (see comments for - -- Side_Effect_Free). + -- We skip using this scheme if we have an object of a volatile + -- type and we do not have Name_Req set true (see comments for + -- Side_Effect_Free). - and then (Name_Req or else not Treat_As_Volatile (Exp_Type)) + and then (Name_Req or else not Treat_As_Volatile (Exp_Type))) then Def_Id := Build_Temporary (Loc, 'R', Exp); Res := New_Occurrence_Of (Def_Id, Loc); diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -4451,7 +4451,9 @@ package body Sem_Attr is -- Has_Same_Storage -- ---------------------- - when Attribute_Has_Same_Storage => + when Attribute_Has_Same_Storage + | Attribute_Overlaps_Storage + => Check_E1; -- The arguments must be objects of any type @@ -5563,21 +5565,6 @@ package body Sem_Attr is end if; end Old; - ---------------------- - -- Overlaps_Storage -- - ---------------------- - - when Attribute_Overlaps_Storage => - Check_E1; - - -- Both arguments must be objects of any type - - Analyze_And_Resolve (P); - Analyze_And_Resolve (E1); - Check_Object_Reference (P); - Check_Object_Reference (E1); - Set_Etype (N, Standard_Boolean); - ------------ -- Output -- ------------ diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -1361,36 +1361,15 @@ package body Sem_Prag is when E_Generic_In_Out_Parameter | E_In_Out_Parameter + | E_Out_Parameter | E_Variable => - -- When pragma Global is present it determines the mode of - -- the object. - - if Global_Seen then - - -- A variable has mode IN when its type is unconstrained - -- or tagged because array bounds, discriminants or tags - -- can be read. - - Item_Is_Input := - Appears_In (Subp_Inputs, Item_Id) - or else Is_Unconstrained_Or_Tagged_Item (Item_Id); - - Item_Is_Output := Appears_In (Subp_Outputs, Item_Id); - - -- Otherwise the variable has a default IN OUT mode - - else - Item_Is_Input := True; - Item_Is_Output := True; - end if; - - when E_Out_Parameter => - -- An OUT parameter of the related subprogram; it cannot -- appear in Global. - if Scope (Item_Id) = Spec_Id then + if Adjusted_Kind = E_Out_Parameter + and then Scope (Item_Id) = Spec_Id + then -- The parameter has mode IN if its type is unconstrained -- or tagged because array bounds, discriminants or tags @@ -1401,8 +1380,8 @@ package body Sem_Prag is Item_Is_Output := True; - -- An OUT parameter of an enclosing subprogram; it can - -- appear in Global and behaves as a read-write variable. + -- A parameter of an enclosing subprogram; it can appear + -- in Global and behaves as a read-write variable. else -- When pragma Global is present it determines the mode @@ -1411,8 +1390,8 @@ package body Sem_Prag is if Global_Seen then -- A variable has mode IN when its type is - -- unconstrained or tagged because array - -- bounds, discriminants or tags can be read. + -- unconstrained or tagged because array bounds, + -- discriminants, or tags can be read. Item_Is_Input := Appears_In (Subp_Inputs, Item_Id) diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -798,44 +798,30 @@ package body Sem_Util is -- in effect we treat discriminant components as regular -- components. - elsif Nkind (E) = N_Selected_Component - and then Ekind (Etype (E)) = E_Anonymous_Access_Type - and then Ekind (Etype (Pre)) /= E_Anonymous_Access_Type - and then (not (Nkind (Selector_Name (E)) in N_Has_Entity - and then Ekind (Entity (Selector_Name (E))) - = E_Discriminant) - - -- The alternative accessibility models both treat - -- discriminants as regular components. - - or else (No_Dynamic_Accessibility_Checks_Enabled (E) - and then Allow_Alt_Model)) - then - -- When restriction No_Dynamic_Accessibility_Checks is active - -- and -gnatd_b set, the level is that of the designated type. - - if Allow_Alt_Model - and then No_Dynamic_Accessibility_Checks_Enabled (E) - and then Debug_Flag_Underscore_B - then - return Make_Level_Literal - (Typ_Access_Level (Etype (E))); - end if; + elsif + (Nkind (E) = N_Selected_Component + and then Ekind (Etype (E)) = E_Anonymous_Access_Type + and then Ekind (Etype (Pre)) /= E_Anonymous_Access_Type + and then (not (Nkind (Selector_Name (E)) in N_Has_Entity + and then Ekind (Entity (Selector_Name (E))) + = E_Discriminant) - -- Otherwise proceed normally + -- The alternative accessibility models both treat + -- discriminants as regular components. - return Make_Level_Literal - (Typ_Access_Level (Etype (Prefix (E)))); + or else (No_Dynamic_Accessibility_Checks_Enabled (E) + and then Allow_Alt_Model))) - -- Similar to the previous case - arrays featuring components of - -- anonymous access components get their corresponding level from - -- their containing type's declaration. + -- Arrays featuring components of anonymous access components + -- get their corresponding level from their containing type's + -- declaration. - elsif Nkind (E) = N_Indexed_Component - and then Ekind (Etype (E)) = E_Anonymous_Access_Type - and then Ekind (Etype (Pre)) in Array_Kind - and then Ekind (Component_Type (Base_Type (Etype (Pre)))) - = E_Anonymous_Access_Type + or else + (Nkind (E) = N_Indexed_Component + and then Ekind (Etype (E)) = E_Anonymous_Access_Type + and then Ekind (Etype (Pre)) in Array_Kind + and then Ekind (Component_Type (Base_Type (Etype (Pre)))) + = E_Anonymous_Access_Type) then -- When restriction No_Dynamic_Accessibility_Checks is active -- and -gnatd_b set, the level is that of the designated type. diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb --- a/gcc/ada/sprint.adb +++ b/gcc/ada/sprint.adb @@ -3132,7 +3132,9 @@ package body Sprint is when N_Real_Literal => Write_Ureal_With_Col_Check_Sloc (Realval (Node)); - when N_Real_Range_Specification => + when N_Real_Range_Specification + | N_Signed_Integer_Type_Definition + => Write_Str_With_Col_Check_Sloc ("range "); Sprint_Node (Low_Bound (Node)); Write_Str (" .. "); @@ -3248,12 +3250,6 @@ package body Sprint is Write_Indent_Str ("end select;"); - when N_Signed_Integer_Type_Definition => - Write_Str_With_Col_Check_Sloc ("range "); - Sprint_Node (Low_Bound (Node)); - Write_Str (" .. "); - Sprint_Node (High_Bound (Node)); - when N_Single_Protected_Declaration => Write_Indent_Str_Sloc ("protected "); Write_Id (Defining_Identifier (Node));