[Ada] fix issue with non private system.address handling
Arnaud Charlet
charlet@adacore.com
Mon Sep 10 08:44:00 GMT 2007
Manually tested on alpha-openvms
Tested on i686-linux, committed on trunk
On VMS_64 address types are visibly integer types, but arithmetic operations on
them are abstract, to prevent spurious ambiguities when integer literals appear
in an address context. For operators, we remove abstract interpretations during
the first pass of overload resolution. The current patch rejects literals that
appear as actuals in call to user-defined subprograms that have a formal that
is a descendent of address. This removes further spurious ambiguities in more
obscure cases.
See gnat.dg/addr3.adb
Also:
Tag checks on assignments to class-wide objects generate explicit references to
the tag component of the object. This component must be treated as visible even
though the only visible source components of a private extension are its
discriminants.
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.
-------------- next part --------------
Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb (revision 127923)
+++ sem_ch3.adb (working copy)
@@ -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
Index: sem_ch4.adb
===================================================================
--- sem_ch4.adb (revision 127923)
+++ sem_ch4.adb (working copy)
@@ -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.
Index: sem_util.ads
===================================================================
--- sem_util.ads (revision 127923)
+++ sem_util.ads (working copy)
@@ -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
Index: sem_util.adb
===================================================================
--- sem_util.adb (revision 127923)
+++ sem_util.adb (working copy)
@@ -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 --
--------------
More information about the Gcc-patches
mailing list