@@ -1191,15 +1191,6 @@ package body CStand is
pragma Assert (not Known_Esize (Any_Id));
pragma Assert (not Known_Alignment (Any_Id));
- Any_Access := New_Standard_Entity ("an access type");
- Mutate_Ekind (Any_Access, E_Access_Type);
- Set_Scope (Any_Access, Standard_Standard);
- Set_Etype (Any_Access, Any_Access);
- Init_Size (Any_Access, System_Address_Size);
- Set_Elem_Alignment (Any_Access);
- Set_Directly_Designated_Type
- (Any_Access, Any_Type);
-
Any_Character := New_Standard_Entity ("a character type");
Mutate_Ekind (Any_Character, E_Enumeration_Type);
Set_Scope (Any_Character, Standard_Standard);
@@ -1416,6 +1407,16 @@ package body CStand is
Set_Size_Known_At_Compile_Time
(Universal_Fixed);
+ Universal_Access := New_Standard_Entity ("universal_access");
+ Decl := New_Node (N_Full_Type_Declaration, Stloc);
+ Set_Defining_Identifier (Decl, Universal_Access);
+ Mutate_Ekind (Universal_Access, E_Access_Type);
+ Set_Etype (Universal_Access, Universal_Access);
+ Set_Scope (Universal_Access, Standard_Standard);
+ Init_Size (Universal_Access, System_Address_Size);
+ Set_Elem_Alignment (Universal_Access);
+ Set_Directly_Designated_Type (Universal_Access, Any_Type);
+
-- Create type declaration for Duration, using a 64-bit size. The
-- delta and size values depend on the mode set in system.ads.
@@ -4864,10 +4864,6 @@ package Einfo is
-- associated with an access attribute. After resolution a specific access
-- type will be established as determined by the context.
-
--------------------------------------------------------
-- Description of Defined Attributes for Entity_Kinds --
--------------------------------------------------------
@@ -3622,8 +3622,7 @@ package body Errout is
Set_Msg_Str ("exception name");
return;
- elsif Error_Msg_Node_1 = Any_Access
- or else Error_Msg_Node_1 = Any_Array
+ elsif Error_Msg_Node_1 = Any_Array
or else Error_Msg_Node_1 = Any_Boolean
or else Error_Msg_Node_1 = Any_Character
or else Error_Msg_Node_1 = Any_Composite
@@ -3640,17 +3639,21 @@ package body Errout is
Set_Msg_Name_Buffer;
return;
- elsif Error_Msg_Node_1 = Universal_Real then
- Set_Msg_Str ("type universal real");
- return;
-
elsif Error_Msg_Node_1 = Universal_Integer then
Set_Msg_Str ("type universal integer");
return;
+ elsif Error_Msg_Node_1 = Universal_Real then
+ Set_Msg_Str ("type universal real");
+ return;
+
elsif Error_Msg_Node_1 = Universal_Fixed then
Set_Msg_Str ("type universal fixed");
return;
+
+ elsif Error_Msg_Node_1 = Universal_Access then
+ Set_Msg_Str ("type universal access");
+ return;
end if;
-- Special case of anonymous array
@@ -652,10 +652,7 @@ begin -- Gen_IL.Gen.Gen_Entities
Cc (E_Access_Type, Access_Kind);
-- An access type created by an access type declaration with no all
- -- keyword present. Note that the predefined type Any_Access, which
- -- has E_Access_Type Ekind, is used to label NULL in the upwards pass
- -- of type analysis, to be replaced by the true access type in the
- -- downwards resolution pass.
+ -- keyword present.
Cc (E_Access_Subtype, Access_Kind);
-- An access subtype created by a subtype declaration for any access
@@ -4409,9 +4409,9 @@ package body Sem_Ch3 is
-- If E is null and has been replaced by an N_Raise_Constraint_Error
-- node (which was marked already-analyzed), we need to set the type
- -- to something other than Any_Access in order to keep gigi happy.
+ -- to something else than Universal_Access to keep gigi happy.
- if Etype (E) = Any_Access then
+ if Etype (E) = Universal_Access then
Set_Etype (E, T);
end if;
@@ -239,8 +239,7 @@ package body Sem_Ch4 is
-- operand types. If one of the operands has a universal interpretation,
-- the legality check uses some compatible non-universal interpretation of
-- the other operand. N can be an operator node, or a function call whose
- -- name is an operator designator. Any_Access, which is the initial type of
- -- the literal NULL, is a universal type for the purpose of this routine.
+ -- name is an operator designator.
function Find_Primitive_Operation (N : Node_Id) return Boolean;
-- Find candidate interpretations for the name Obj.Proc when it appears in
@@ -3273,7 +3272,7 @@ package body Sem_Ch4 is
procedure Analyze_Null (N : Node_Id) is
begin
- Set_Etype (N, Any_Access);
+ Set_Etype (N, Universal_Access);
end Analyze_Null;
----------------------
@@ -6678,14 +6677,9 @@ package body Sem_Ch4 is
return;
end if;
- if T1 = Universal_Integer or else T1 = Universal_Real
-
- -- If the left operand of an equality operator is null, the visibility
- -- of the operator must be determined from the interpretation of the
- -- right operand. This processing must be done for Any_Access, which
- -- is the internal representation of the type of the literal null.
-
- or else T1 = Any_Access
+ if T1 = Universal_Integer
+ or else T1 = Universal_Real
+ or else T1 = Universal_Access
then
if not Is_Overloaded (R) then
Add_One_Interp (N, Op_Id, Standard_Boolean, Base_Type (Etype (R)));
@@ -6770,7 +6764,7 @@ package body Sem_Ch4 is
-- operator.
-- This is because the expected type for Obj'Access in a call to
-- the Standard."=" operator whose formals are of type
- -- Universal_Access is Universal_Integer, and Universal_Access
+ -- Universal_Access is Universal_Access, and Universal_Access
-- doesn't have a designated type. For more detail see RM 6.4.1(3)
-- and 3.10.2.
-- This procedure assumes that the context is a universal_access.
@@ -6992,7 +6986,7 @@ package body Sem_Ch4 is
--------------------
procedure Try_One_Interp (T1 : Entity_Id) is
- Universal_Access : Boolean;
+ Anonymous_Access : Boolean;
Bas : Entity_Id;
begin
@@ -7013,7 +7007,7 @@ package body Sem_Ch4 is
-- In Ada 2005, the equality operator for anonymous access types
-- is declared in Standard, and preference rules apply to it.
- Universal_Access := Is_Anonymous_Access_Type (T1)
+ Anonymous_Access := Is_Anonymous_Access_Type (T1)
or else References_Anonymous_Access_Type (R, T1);
if Present (Scop) then
@@ -7028,7 +7022,7 @@ package body Sem_Ch4 is
or else In_Instance
or else T1 = Universal_Integer
or else T1 = Universal_Real
- or else T1 = Any_Access
+ or else T1 = Universal_Access
or else T1 = Any_String
or else T1 = Any_Composite
or else (Ekind (T1) = E_Access_Subprogram_Type
@@ -7036,7 +7030,7 @@ package body Sem_Ch4 is
then
null;
- elsif Scop /= Standard_Standard or else not Universal_Access then
+ elsif Scop /= Standard_Standard or else not Anonymous_Access then
-- The scope does not contain an operator for the type
@@ -7057,7 +7051,7 @@ package body Sem_Ch4 is
then
null;
- elsif not Universal_Access then
+ elsif not Anonymous_Access then
-- Save candidate type for subsequent error message, if any
if not Is_Limited_Type (T1) then
@@ -7070,7 +7064,7 @@ package body Sem_Ch4 is
-- Ada 2005 (AI-230): Keep restriction imposed by Ada 83 and 95:
-- Do not allow anonymous access types in equality operators.
- if Ada_Version < Ada_2005 and then Universal_Access then
+ if Ada_Version < Ada_2005 and then Anonymous_Access then
return;
end if;
@@ -7091,7 +7085,7 @@ package body Sem_Ch4 is
-- Finally, also check for RM 4.5.2 (9.6/2).
if T1 /= Standard_Void_Type
- and then (Universal_Access
+ and then (Anonymous_Access
or else
Has_Compatible_Type (R, T1, For_Comparison => True))
@@ -7109,7 +7103,7 @@ package body Sem_Ch4 is
or else not Is_Tagged_Type (T1)
or else Chars (Op_Id) = Name_Op_Eq)
- and then (not Universal_Access
+ and then (not Anonymous_Access
or else Check_Access_Object_Types (R, T1))
then
if Found
@@ -7124,14 +7118,14 @@ package body Sem_Ch4 is
else
T_F := It.Typ;
- Is_Universal_Access := Universal_Access;
+ Is_Universal_Access := Anonymous_Access;
end if;
else
Found := True;
T_F := T1;
I_F := Index;
- Is_Universal_Access := Universal_Access;
+ Is_Universal_Access := Anonymous_Access;
end if;
if not Analyzed (L) then
@@ -1774,12 +1774,12 @@ package body Sem_Res is
elsif Opnd_Type = Universal_Real then
Orig_Type := Type_In_P (Is_Real_Type'Access);
+ elsif Opnd_Type = Universal_Access then
+ Orig_Type := Type_In_P (Is_Definite_Access_Type'Access);
+
elsif Opnd_Type = Any_String then
Orig_Type := Type_In_P (Is_String_Type'Access);
- elsif Opnd_Type = Any_Access then
- Orig_Type := Type_In_P (Is_Definite_Access_Type'Access);
-
elsif Opnd_Type = Any_Composite then
Orig_Type := Type_In_P (Is_Composite_Type'Access);
@@ -8748,7 +8748,7 @@ package body Sem_Res is
Set_Etype (N, Any_Type);
return;
- elsif T = Any_Access
+ elsif T = Universal_Access
or else Ekind (T) in E_Allocator_Type | E_Access_Attribute_Type
then
T := Find_Unique_Access_Type;
@@ -915,10 +915,10 @@ package body Sem_Type is
elsif (T2 = Universal_Integer and then Is_Integer_Type (T1))
or else (T2 = Universal_Real and then Is_Real_Type (T1))
or else (T2 = Universal_Fixed and then Is_Fixed_Point_Type (T1))
+ or else (T2 = Universal_Access and then Is_Access_Type (T1))
or else (T2 = Any_Fixed and then Is_Fixed_Point_Type (T1))
or else (T2 = Any_Character and then Is_Character_Type (T1))
or else (T2 = Any_String and then Is_String_Type (T1))
- or else (T2 = Any_Access and then Is_Access_Type (T1))
then
return True;
@@ -1215,7 +1215,7 @@ package body Sem_Type is
and then Is_Access_Type (T2)
and then Designated_Type (T1) = Designated_Type (T2))
or else
- (T1 = Any_Access
+ (T1 = Universal_Access
and then Is_Access_Type (Underlying_Type (T2)))
or else
(T2 = Any_Composite
@@ -3388,12 +3388,12 @@ package body Sem_Type is
elsif T1 = Any_Character and then Is_Character_Type (T2) then
return B2;
- elsif T1 = Any_Access
+ elsif T1 = Universal_Access
and then (Is_Access_Type (T2) or else Is_Remote_Access (T2))
then
return T2;
- elsif T2 = Any_Access
+ elsif T2 = Universal_Access
and then (Is_Access_Type (T1) or else Is_Remote_Access (T1))
then
return T1;
@@ -3401,7 +3401,7 @@ package body Sem_Type is
-- In an instance, the specific type may have a private view. Use full
-- view to check legality.
- elsif T2 = Any_Access
+ elsif T2 = Universal_Access
and then Is_Private_Type (T1)
and then Present (Full_View (T1))
and then Is_Access_Type (Full_View (T1))
@@ -375,9 +375,6 @@ package Stand is
-- them the type is still Any_Type, the node has no possible interpretation
-- and an error can be emitted (and Any_Type will be propagated upwards).
- Any_Access : Entity_Id;
- -- Used to resolve the overloaded literal NULL
-
Any_Array : Entity_Id;
-- Used to represent some unknown array type
@@ -451,6 +448,9 @@ package Stand is
-- universal integer and universal real, it is never used for runtime
-- calculations).
+ Universal_Access : Entity_Id;
+ -- Entity for universal access type. It is only used for the literal null
+
Standard_Integer_8 : Entity_Id;
Standard_Integer_16 : Entity_Id;
Standard_Integer_32 : Entity_Id;