From 4e75e96f90f5a6aa8c8609f79318d65eacfebea7 Mon Sep 17 00:00:00 2001 From: charlet Date: Fri, 31 Aug 2007 10:24:10 +0000 Subject: [PATCH] 2007-08-31 Ed Schonberg * 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@127980 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/sem_ch3.adb | 20 ++++++++++++++++++-- gcc/ada/sem_ch4.adb | 32 ++++++++++++++++++++++++++++---- gcc/ada/sem_util.adb | 19 ------------------- gcc/ada/sem_util.ads | 5 ----- 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 -- 2.7.4