diff options
Diffstat (limited to 'gcc/ada/exp_ch8.adb')
| -rw-r--r-- | gcc/ada/exp_ch8.adb | 95 |
1 files changed, 59 insertions, 36 deletions
diff --git a/gcc/ada/exp_ch8.adb b/gcc/ada/exp_ch8.adb index a0e9d4cf1be..3b5c7d3ae64 100644 --- a/gcc/ada/exp_ch8.adb +++ b/gcc/ada/exp_ch8.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -239,8 +239,52 @@ package body Exp_Ch8 is ---------------------------------------------- procedure Expand_N_Subprogram_Renaming_Declaration (N : Node_Id) is + Loc : constant Source_Ptr := Sloc (N); + Id : constant Entity_Id := Defining_Entity (N); + + function Build_Body_For_Renaming return Node_Id; + -- Build and return the body for the renaming declaration of an equality + -- or inequality operator. + + ----------------------------- + -- Build_Body_For_Renaming -- + ----------------------------- + + function Build_Body_For_Renaming return Node_Id is + Body_Id : Entity_Id; + Decl : Node_Id; + + begin + Set_Alias (Id, Empty); + Set_Has_Completion (Id, False); + Rewrite (N, + Make_Subprogram_Declaration (Sloc (N), + Specification => Specification (N))); + Set_Has_Delayed_Freeze (Id); + + Body_Id := Make_Defining_Identifier (Sloc (N), Chars (Id)); + Set_Debug_Info_Needed (Body_Id); + + Decl := + Make_Subprogram_Body (Loc, + Specification => + Make_Function_Specification (Loc, + Defining_Unit_Name => Body_Id, + Parameter_Specifications => Copy_Parameter_List (Id), + Result_Definition => + New_Occurrence_Of (Standard_Boolean, Loc)), + Declarations => Empty_List, + Handled_Statement_Sequence => Empty); + + return Decl; + end Build_Body_For_Renaming; + + -- Local variables + Nam : constant Node_Id := Name (N); + -- Start of processing for Expand_N_Subprogram_Renaming_Declaration + begin -- When the prefix of the name is a function call, we must force the -- call to be made by removing side effects from the call, since we @@ -259,25 +303,24 @@ package body Exp_Ch8 is Force_Evaluation (Prefix (Nam)); end if; - -- Check whether this is a renaming of a predefined equality on an - -- untagged record type (AI05-0123). + -- Handle cases where we build a body for a renamed equality if Is_Entity_Name (Nam) and then Chars (Entity (Nam)) = Name_Op_Eq and then Scope (Entity (Nam)) = Standard_Standard - and then Ada_Version >= Ada_2012 then declare - Loc : constant Source_Ptr := Sloc (N); - Id : constant Entity_Id := Defining_Entity (N); - Typ : constant Entity_Id := Etype (First_Formal (Id)); - - Decl : Node_Id; - Body_Id : constant Entity_Id := - Make_Defining_Identifier (Sloc (N), Chars (Id)); + Left : constant Entity_Id := First_Formal (Id); + Right : constant Entity_Id := Next_Formal (Left); + Typ : constant Entity_Id := Etype (Left); + Decl : Node_Id; begin - if Is_Record_Type (Typ) + -- Check whether this is a renaming of a predefined equality on an + -- untagged record type (AI05-0123). + + if Ada_Version >= Ada_2012 + and then Is_Record_Type (Typ) and then not Is_Tagged_Type (Typ) and then not Is_Frozen (Typ) then @@ -288,23 +331,7 @@ package body Exp_Ch8 is -- declaration, and the body is inserted at the end of the -- current declaration list to prevent premature freezing. - Set_Alias (Id, Empty); - Set_Has_Completion (Id, False); - Rewrite (N, - Make_Subprogram_Declaration (Sloc (N), - Specification => Specification (N))); - Set_Has_Delayed_Freeze (Id); - - Decl := Make_Subprogram_Body (Loc, - Specification => - Make_Function_Specification (Loc, - Defining_Unit_Name => Body_Id, - Parameter_Specifications => - Copy_Parameter_List (Id), - Result_Definition => - New_Occurrence_Of (Standard_Boolean, Loc)), - Declarations => Empty_List, - Handled_Statement_Sequence => Empty); + Decl := Build_Body_For_Renaming; Set_Handled_Statement_Sequence (Decl, Make_Handled_Sequence_Of_Statements (Loc, @@ -313,16 +340,12 @@ package body Exp_Ch8 is Expression => Expand_Record_Equality (Id, - Typ => Typ, - Lhs => - Make_Identifier (Loc, Chars (First_Formal (Id))), - Rhs => - Make_Identifier - (Loc, Chars (Next_Formal (First_Formal (Id)))), + Typ => Typ, + Lhs => Make_Identifier (Loc, Chars (Left)), + Rhs => Make_Identifier (Loc, Chars (Right)), Bodies => Declarations (Decl)))))); Append (Decl, List_Containing (N)); - Set_Debug_Info_Needed (Body_Id); end if; end; end if; |