sem_ch3.adb: The predicate Is_Descendent_Of_Address is now an entity flag, for effiency.

2007-08-31  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb: The predicate Is_Descendent_Of_Address is now an entity
	flag, for effiency. It is called when analyzing arithmetic operators
	and also for actuals in calls that are universal_integers. The flag is
	set for the predefined type address, and for any type or subtype
	derived from it.

	* sem_ch4.adb (Analyze_One_Call): Reject an actual that is a
	Universal_Integer, when the formal is a descendent of address and the
	call appears in user code.
	(Analyze_Selected_Component): if the prefix is a private extension, the
	tag component is visible.

	* sem_util.ads, sem_util.adb: Remove Is_Descendent_Of_Address, now an
	entity flag.

From-SVN: r127980

4 files changed, 46 insertions, 30 deletions

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 5b66982..c581b62 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -35,6 +35,7 @@ with Exp_Ch3;  use Exp_Ch3;
 with Exp_Dist; use Exp_Dist;
 with Exp_Tss;  use Exp_Tss;
 with Exp_Util; use Exp_Util;
+with Fname;    use Fname;
 with Freeze;   use Freeze;
 with Itypes;   use Itypes;
 with Layout;   use Layout;
@@ -3380,8 +3381,9 @@ package body Sem_Ch3 is
 
       T := Etype (Id);
 
-      Set_Is_Immediately_Visible (Id, True);
-      Set_Depends_On_Private     (Id, Has_Private_Component (T));
+      Set_Is_Immediately_Visible   (Id, True);
+      Set_Depends_On_Private       (Id, Has_Private_Component (T));
+      Set_Is_Descendent_Of_Address (Id, Is_Descendent_Of_Address (T));
 
       if Is_Interface (T) then
          Set_Is_Interface (Id);
@@ -3783,6 +3785,15 @@ package body Sem_Ch3 is
          Generate_Definition (Def_Id);
       end if;
 
+      if Chars (Scope (Def_Id)) =  Name_System
+        and then Chars (Def_Id) = Name_Address
+        and then Is_Predefined_File_Name (Unit_File_Name (Get_Source_Unit (N)))
+      then
+         Set_Is_Descendent_Of_Address (Def_Id);
+         Set_Is_Descendent_Of_Address (Base_Type (Def_Id));
+         Set_Is_Descendent_Of_Address (Prev);
+      end if;
+
       Check_Eliminated (Def_Id);
    end Analyze_Type_Declaration;
 
@@ -4979,6 +4990,11 @@ package body Sem_Ch3 is
          end if;
       end if;
 
+      Set_Is_Descendent_Of_Address (Derived_Type,
+        Is_Descendent_Of_Address (Parent_Type));
+      Set_Is_Descendent_Of_Address (Implicit_Base,
+        Is_Descendent_Of_Address (Parent_Type));
+
       --  Set remaining type-specific fields, depending on numeric type
 
       if Is_Modular_Integer_Type (Parent_Type) then
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 6530cb4..3eec997 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -2136,6 +2136,8 @@ package body Sem_Ch4 is
             --  of the analysis of the call with the user-defined operation,
             --  because the parameter names may be wrong and yet the hiding
             --  takes place. Fixes b34014o.
+            --  The abstract operations on address do not hide the predefined
+            --  operator (this is the purpose of making them abstract).
 
             if Is_Overloaded (Name (N)) then
                declare
@@ -2146,6 +2148,11 @@ package body Sem_Ch4 is
                   Get_First_Interp (Name (N), I, It);
                   while Present (It.Nam) loop
                      if Ekind (It.Nam) /= E_Operator
+                        and then not
+                          (Is_Abstract_Subprogram (It.Nam)
+                            and then
+                              Is_Descendent_Of_Address
+                                 (Etype (First_Formal (It.Nam))))
                         and then Hides_Op (It.Nam, Nam)
                         and then
                           Has_Compatible_Type
@@ -2196,7 +2203,21 @@ package body Sem_Ch4 is
             if Nkind (Parent (Actual)) /= N_Parameter_Association
               or else Chars (Selector_Name (Parent (Actual))) = Chars (Formal)
             then
-               if Has_Compatible_Type (Actual, Etype (Formal)) then
+               --  The actual can be compatible with the formal, but we must
+               --  also check that the context is not an address type that is
+               --  visibly an integer type, as is the case in VMS_64. In this
+               --  case the use of literals is illegal, except in the body of
+               --  descendents of system, where arithmetic operations on
+               --  address are of course used.
+
+               if Has_Compatible_Type (Actual, Etype (Formal))
+                 and then
+                  (Etype (Actual) /= Universal_Integer
+                    or else not Is_Descendent_Of_Address (Etype (Formal))
+                    or else
+                      Is_Predefined_File_Name
+                        (Unit_File_Name (Get_Source_Unit (N))))
+               then
                   Next_Actual (Actual);
                   Next_Formal (Formal);
 
@@ -2889,9 +2910,12 @@ package body Sem_Ch4 is
             end if;
 
             --  If the prefix is a private extension, check only the visible
-            --  components of the partial view.
+            --  components of the partial view. This must include the tag,
+            --  wich can appear in expanded code in a tag check.
 
-            if Ekind (Type_To_Use) = E_Record_Type_With_Private then
+            if Ekind (Type_To_Use) = E_Record_Type_With_Private
+              and then  Chars (Selector_Name (N)) /= Name_uTag
+            then
                exit when Comp = Last_Entity (Type_To_Use);
             end if;
 
@@ -4855,7 +4879,7 @@ package body Sem_Ch4 is
                   exit;
 
                --  In Ada 2005, this operation does not participate in Overload
-               --  resolution. If the operation is defined in in a predefined
+               --  resolution. If the operation is defined in a predefined
                --  unit, it is one of the operations declared abstract in some
                --  variants of System, and it must be removed as well.
 
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 04fe93c..42a2fed 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -5421,25 +5421,6 @@ package body Sem_Util is
       raise Program_Error;
    end Is_Descendent_Of;
 
-   ------------------------------
-   -- Is_Descendent_Of_Address --
-   ------------------------------
-
-   function Is_Descendent_Of_Address (T1 : Entity_Id) return Boolean is
-   begin
-      --  If Address has not been loaded, answer must be False
-
-      if not RTU_Loaded (System) then
-         return False;
-
-      --  Otherwise we can get the entity we are interested in without
-      --  causing an unwanted dependency on System, and do the test.
-
-      else
-         return Is_Descendent_Of (T1, Base_Type (RTE (RE_Address)));
-      end if;
-   end Is_Descendent_Of_Address;
-
    --------------
    -- Is_False --
    --------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 42cd17d..5ae79eb 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -609,11 +609,6 @@ package Sem_Util is
    --  This is the RM definition, a type is a descendent of another type if it
    --  is the same type or is derived from a descendent of the other type.
 
-   function Is_Descendent_Of_Address (T1 : Entity_Id) return Boolean;
-   --  Returns True if type T1 is a descendent of Address or its base type.
-   --  Similar to calling Is_Descendent_Of with Base_Type (RTE (RE_Address))
-   --  except that it avoids creating an unconditional dependency on System.
-
    function Is_False (U : Uint) return Boolean;
    --  The argument is a Uint value which is the Boolean'Pos value of a
    --  Boolean operand (i.e. is either 0 for False, or 1 for True). This