diff options
| -rw-r--r-- | gcc/ada/cstand.adb | 19 | ||||
| -rw-r--r-- | gcc/ada/einfo.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/errout.adb | 15 | ||||
| -rw-r--r-- | gcc/ada/gen_il-gen-gen_entities.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_ch4.adb | 38 | ||||
| -rw-r--r-- | gcc/ada/sem_res.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/sem_type.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/stand.ads | 6 |
9 files changed, 50 insertions, 59 deletions
diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb index 3822d93..8b04e5e 100644 --- a/gcc/ada/cstand.adb +++ b/gcc/ada/cstand.adb @@ -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. diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index ca2ba20..546ef56 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.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. --- 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 -- -------------------------------------------------------- diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index 76a8268..73bcfc5 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -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 diff --git a/gcc/ada/gen_il-gen-gen_entities.adb b/gcc/ada/gen_il-gen-gen_entities.adb index d91faaa..cf34fb6 100644 --- a/gcc/ada/gen_il-gen-gen_entities.adb +++ b/gcc/ada/gen_il-gen-gen_entities.adb @@ -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 diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 158ad4d..d05fbcd 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -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; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 26204d3..951decb 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -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 diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 84612c3..bd91cec 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -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; diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index cbb00fd..5d51916 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -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)) diff --git a/gcc/ada/stand.ads b/gcc/ada/stand.ads index f322656..54df6a2 100644 --- a/gcc/ada/stand.ads +++ b/gcc/ada/stand.ads @@ -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; |