sem_ch8.adb (Analyze_Subprogram_Renaming): In a generic...

2005-03-08  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch8.adb (Analyze_Subprogram_Renaming): In a generic, if this is
	a renaming a body, check that the renamed subprogram in not intrinsic.
	(Find_Direct_Name): If several use_visible entities hide
	each other, and the context is a predefined file compiled through
	rtsfind, keep only the entity that comes from a predefined file.

From-SVN: r96507

1 files changed, 44 insertions, 7 deletions

diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index f5090e4..d890026 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -1271,12 +1271,6 @@ package body Sem_Ch8 is
          Set_Corresponding_Spec (N, Rename_Spec);
          Set_Corresponding_Body (Unit_Declaration_Node (Rename_Spec), New_S);
 
-         --  The body is created when the entity is frozen. If the context
-         --  is generic, freeze_all is not invoked, so we need to indicate
-         --  that the entity has a completion.
-
-         Set_Has_Completion (Rename_Spec, Inside_A_Generic);
-
          if Ada_Version = Ada_83 and then Comes_From_Source (N) then
             Error_Msg_N ("(Ada 83) renaming cannot serve as a body", N);
          end if;
@@ -1286,10 +1280,13 @@ package body Sem_Ch8 is
          Set_Public_Status (New_S);
 
          --  Indicate that the entity in the declaration functions like
-         --  the corresponding body, and is not a new entity.
+         --  the corresponding body, and is not a new entity. The body will
+         --  be constructed later at the freeze point, so indicate that
+         --  the completion has not been seen yet.
 
          Set_Ekind (New_S, E_Subprogram_Body);
          New_S := Rename_Spec;
+         Set_Has_Completion (Rename_Spec, False);
 
       else
          Generate_Definition (New_S);
@@ -1407,6 +1404,22 @@ package body Sem_Ch8 is
 
             Check_Frozen_Renaming (N, Rename_Spec);
 
+            --  Check explicitly that renamed entity is not intrinsic, because
+            --  in in a generic the renamed body is not built. In this case,
+            --  the renaming_as_body is a completion.
+
+            if Inside_A_Generic then
+               if Is_Frozen (Rename_Spec)
+                 and then Is_Intrinsic_Subprogram (Old_S)
+               then
+                  Error_Msg_N
+                    ("subprogram in renaming_as_body cannot be intrinsic",
+                       Name (N));
+               end if;
+
+               Set_Has_Completion (Rename_Spec);
+            end if;
+
          elsif Ekind (Old_S) /= E_Operator then
             Check_Mode_Conformant (New_S, Old_S);
 
@@ -3134,6 +3147,30 @@ package body Sem_Ch8 is
                Nvis_Messages;
                return;
 
+            elsif
+              Is_Predefined_File_Name (Unit_File_Name (Current_Sem_Unit))
+            then
+               --  A use-clause in the body of a system file creates a
+               --  conflict with some entity in a user scope, while rtsfind
+               --  is active. Keep only the entity that comes from another
+               --  predefined unit.
+
+               E2 := E;
+               while Present (E2) loop
+                  if Is_Predefined_File_Name
+                    (Unit_File_Name (Get_Source_Unit (Sloc (E2))))
+                  then
+                     E := E2;
+                     goto Found;
+                  end if;
+
+                  E2 := Homonym (E2);
+               end loop;
+
+               --  Entity must exist because predefined unit is correct.
+
+               raise Program_Error;
+
             else
                Nvis_Messages;
                return;