OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[Ada] Rename Any_Access into Universal_Access

Browse Source 
gcc/ada/

	* stand.ads (Any_Access): Delete.
	(Universal_Access): New entity.
	* einfo.ads: Remove obsolete reference to Any_Access.
	* gen_il-gen-gen_entities.adb: Likewise.
	* cstand.adb (Create_Standard): Do not create Any_Access and create
	Universal_Access as a full type instead.
	* errout.adb (Set_Msg_Insertion_Type_Reference): Do not deal with
	Any_Access and deal with Universal_Access instead.
	* sem_ch3.adb (Analyze_Object_Declaration): Replace Any_Access with
	Universal_Access.
	* sem_ch4.adb (Analyze_Null): Likewise.
	(Find_Non_Universal_Interpretations): Likewise.
	(Find_Equality_Types.Try_One_Interp): Likewise and avoid shadowing
	by renaming a local variable of the same name.
	* sem_res.adb (Make_Call_Into_Operato): Likewise.
	(Resolve_Equality_Op): Likewise.
	* sem_type.adb (Covers): Likewise.
	(Specific_Type): Likewise.
This commit is contained in:
Eric Botcazou 2021-12-03 19:43:23 +01:00 committed by Pierre-Marie de Rodat
parent f64a1bfadd
commit 7f08c07599
9 changed files with 50 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
gcc/ada/cstand.adb
View File

@ -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.

4
gcc/ada/einfo.ads
View File

@ -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.
-- Finally, the type Any_Access is used to label -null- during type
-- resolution. Any_Access is also replaced by the context type after
-- resolution.
--------------------------------------------------------
-- Description of Defined Attributes for Entity_Kinds --
--------------------------------------------------------

15
gcc/ada/errout.adb
View File

@ -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

5
gcc/ada/gen_il-gen-gen_entities.adb
View File

@ -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

4
gcc/ada/sem_ch3.adb
View File

@ -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;

38
gcc/ada/sem_ch4.adb
View File

@ -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

8
gcc/ada/sem_res.adb
View File

@ -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;

10
gcc/ada/sem_type.adb
View File

@ -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))

6
gcc/ada/stand.ads
View File

@ -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;