2004-05-17 Steve Kargl <kargls@comcast.net>

[pf3gnuchains/gcc-fork.git] / gcc / ada / exp_ch7.adb

diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 2a683a2..4266585 100644 (file)
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -37,10 +37,8 @@ with Exp_Ch11; use Exp_Ch11;
 with Exp_Dbug; use Exp_Dbug;
 with Exp_Tss;  use Exp_Tss;
 with Exp_Util; use Exp_Util;
-with Fname;    use Fname;
 with Freeze;   use Freeze;
 with Hostparm; use Hostparm;
-with Lib;      use Lib;
 with Nlists;   use Nlists;
 with Nmake;    use Nmake;
 with Opt;      use Opt;
@@ -708,6 +706,7 @@ package body Exp_Ch7 is
               or else Ekind (E) = E_Constant)
            and then Has_Simple_Protected_Object (Etype (E))
            and then not Has_Task (Etype (E))
+           and then Nkind (Parent (E)) /= N_Object_Renaming_Declaration
          then
             declare
                Typ : constant Entity_Id := Etype (E);
@@ -818,28 +817,16 @@ package body Exp_Ch7 is
    begin
       if Is_Derived_Type (Typ)
         and then Comes_From_Source (E)
-        and then Is_Overriding_Operation (E)
-        and then
-          (not Is_Predefined_File_Name
-                     (Unit_File_Name (Get_Source_Unit (Root_Type (Typ)))))
+        and then not Is_Overriding_Operation (E)
       then
-         --  We know that the explicit operation on the type overrode
+         --  We know that the explicit operation on the type does not override
          --  the inherited operation of the parent, and that the derivation
          --  is from a private type that is not visibly controlled.
 
          Parent_Type := Etype (Typ);
          Op := Find_Prim_Op (Parent_Type, Name_Of (Prim));
 
-         if Present (Op)
-            and then Is_Hidden (Op)
-            and then Scope (Scope (Typ)) /= Scope (Op)
-            and then not In_Open_Scopes (Scope (Typ))
-         then
-            --  If the parent operation is not visible, and the derived
-            --  type is not declared in a child unit, then the explicit
-            --  operation does not override, and we must use the operation
-            --  of the parent.
-
+         if Present (Op) then
             E := Op;
 
             --  Wrap the object to be initialized into the proper
@@ -2193,7 +2180,6 @@ package body Exp_Ch7 is
       Spec         : Node_Id;
       Name         : Node_Id;
       Param        : Node_Id;
-      Unlock       : Node_Id;
       Param_Type   : Entity_Id;
       Pid          : Entity_Id := Empty;
       Cancel_Param : Entity_Id;
@@ -2274,50 +2260,53 @@ package body Exp_Ch7 is
                         Selector_Name =>
                           Make_Identifier (Loc, Name_uObject)),
                     Attribute_Name => Name_Unchecked_Access))));
-         end if;
 
-         --  Unlock (_object._object'Access);
+         else
+            --  Unlock (_object._object'Access);
 
-         --  _object is the record used to implement the protected object.
-         --  It is a parameter to the protected subprogram.
+            --  object is the record used to implement the protected object.
+            --  It is a parameter to the protected subprogram.
 
-         --  If the protected object is controlled (i.e it has entries or
-         --  needs finalization for interrupt handling), call Unlock_Entries,
-         --  except if the protected object follows the ravenscar profile, in
-         --  which case call Unlock_Entry, otherwise call the simplified
-         --  version, Unlock.
+            --  If the protected object is controlled (i.e it has entries or
+            --  needs finalization for interrupt handling), call
+            --  Unlock_Entries, except if the protected object follows the
+            --  ravenscar profile, in which case call Unlock_Entry, otherwise
+            --  call the simplified version, Unlock.
 
-         if Has_Entries (Pid)
-           or else Has_Interrupt_Handler (Pid)
-           or else (Has_Attach_Handler (Pid) and then not Restricted_Profile)
-         then
-            if Abort_Allowed
-              or else Restriction_Active (No_Entry_Queue) = False
-              or else Number_Entries (Pid) > 1
+            if Has_Entries (Pid)
+              or else Has_Interrupt_Handler (Pid)
+              or else (Has_Attach_Handler (Pid)
+                         and then not Restricted_Profile)
             then
-               Unlock := New_Reference_To (RTE (RE_Unlock_Entries), Loc);
+               if Abort_Allowed
+                 or else Restriction_Active (No_Entry_Queue) = False
+                 or else Number_Entries (Pid) > 1
+               then
+                  Name := New_Reference_To (RTE (RE_Unlock_Entries), Loc);
+               else
+                  Name := New_Reference_To (RTE (RE_Unlock_Entry), Loc);
+               end if;
+
             else
-               Unlock := New_Reference_To (RTE (RE_Unlock_Entry), Loc);
+               Name := New_Reference_To (RTE (RE_Unlock), Loc);
             end if;
 
-         else
-            Unlock := New_Reference_To (RTE (RE_Unlock), Loc);
+            Append_To (Stmt,
+              Make_Procedure_Call_Statement (Loc,
+                Name => Name,
+                Parameter_Associations => New_List (
+                  Make_Attribute_Reference (Loc,
+                    Prefix =>
+                      Make_Selected_Component (Loc,
+                        Prefix =>
+                          New_Reference_To (Defining_Identifier (Param), Loc),
+                        Selector_Name =>
+                          Make_Identifier (Loc, Name_uObject)),
+                    Attribute_Name => Name_Unchecked_Access))));
          end if;
 
-         Append_To (Stmt,
-           Make_Procedure_Call_Statement (Loc,
-             Name => Unlock,
-             Parameter_Associations => New_List (
-               Make_Attribute_Reference (Loc,
-                 Prefix =>
-                   Make_Selected_Component (Loc,
-                     Prefix =>
-                       New_Reference_To (Defining_Identifier (Param), Loc),
-                     Selector_Name =>
-                       Make_Identifier (Loc, Name_uObject)),
-                 Attribute_Name => Name_Unchecked_Access))));
-
          if Abort_Allowed then
+
             --  Abort_Undefer;
 
             Append_To (Stmt,