Imported Upstream version 4.8.1

[platform/upstream/gcc48.git] / gcc / ada / exp_ch8.adb

diff --git a/gcc/ada/exp_ch8.adb b/gcc/ada/exp_ch8.adb
index a0e9d4c..3b5c7d3 100644 (file)
--- 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;