sem_ch8.adb: Minor error msg rewording
2006-10-31 Robert Dewar <dewar@adacore.com> Hristian Kirtchev <kirtchev@adacore.com> Javier Miranda <miranda@adacore.com> Ed Schonberg <schonberg@adacore.com> * sem_ch8.adb: Minor error msg rewording (Undefined): When checking for misspellings, invert arguments (to get expected and found set right) (Analyze_Subprogram_Renaming): Propagate Is_Pure, Is_Preelaborated (Analyze_Generic_Renaming): Same fix (Use_One_Package): Do not take into account the internal entities of abstract interfaces during the analysis of entities that are marked as potentially use-visible. (Find_Type): Handle the case of an attribute reference for implementation defined attribute Stub_Type (simply let the analysis of the attribute reference rewrite it). (Use_One_Type, End_Use_Type): Reject a reference to a limited view of a type that appears in a Use_Type clause. (Analyze_Object_Renaming): Add support for renaming of the Priority attribute. (Find_Type): In Ada 2005, a task type can be used within its own body, when it appears in an access definition. (Analyze_Object_Renaming): Remove warning on null_exclusion. (Analyze_Object_Renaming): Introduce checks for required null exclusion in a formal object declaration or in a subtype declaration. (Analyze_Subprogram_Renaming): Add call to Check_Null_Exclusion. (Check_Null_Exclusion): New local routine to Analyze_Subprogram_Renaming. Check whether the formals and return profile of a renamed subprogram have required null exclusions when their counterparts of the renaming already impose them. (In_Generic_Scope): New local routine to Analyze_Object_Renaming. Determine whether an entity is inside a generic scope. (In_Open_Scope): First pass of documentation update. (Find_Expanded_Name): Add support for shadow entities associated with limited withed packages. This is required to handle nested packages. (Analyze_Package_Renaming): Remove the restriction imposed by AI-217 that makes a renaming of a limited withed package illegal. From-SVN: r118306
This commit is contained in:
parent
3b75bcab98
commit
923fa078d5
|
@ -646,6 +646,9 @@ package body Sem_Ch8 is
|
||||||
Set_Renamed_Object (New_P, Old_P);
|
Set_Renamed_Object (New_P, Old_P);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
Set_Is_Pure (New_P, Is_Pure (Old_P));
|
||||||
|
Set_Is_Preelaborated (New_P, Is_Preelaborated (Old_P));
|
||||||
|
|
||||||
Set_Etype (New_P, Etype (Old_P));
|
Set_Etype (New_P, Etype (Old_P));
|
||||||
Set_Has_Completion (New_P);
|
Set_Has_Completion (New_P);
|
||||||
|
|
||||||
|
@ -655,7 +658,6 @@ package body Sem_Ch8 is
|
||||||
|
|
||||||
Check_Library_Unit_Renaming (N, Old_P);
|
Check_Library_Unit_Renaming (N, Old_P);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
end Analyze_Generic_Renaming;
|
end Analyze_Generic_Renaming;
|
||||||
|
|
||||||
-----------------------------
|
-----------------------------
|
||||||
|
@ -669,6 +671,31 @@ package body Sem_Ch8 is
|
||||||
T : Entity_Id;
|
T : Entity_Id;
|
||||||
T2 : Entity_Id;
|
T2 : Entity_Id;
|
||||||
|
|
||||||
|
function In_Generic_Scope (E : Entity_Id) return Boolean;
|
||||||
|
-- Determine whether entity E is inside a generic cope
|
||||||
|
|
||||||
|
----------------------
|
||||||
|
-- In_Generic_Scope --
|
||||||
|
----------------------
|
||||||
|
|
||||||
|
function In_Generic_Scope (E : Entity_Id) return Boolean is
|
||||||
|
S : Entity_Id;
|
||||||
|
|
||||||
|
begin
|
||||||
|
S := Scope (E);
|
||||||
|
while Present (S) and then S /= Standard_Standard loop
|
||||||
|
if Is_Generic_Unit (S) then
|
||||||
|
return True;
|
||||||
|
end if;
|
||||||
|
|
||||||
|
S := Scope (S);
|
||||||
|
end loop;
|
||||||
|
|
||||||
|
return False;
|
||||||
|
end In_Generic_Scope;
|
||||||
|
|
||||||
|
-- Start of processing for Analyze_Object_Renaming
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Nam = Error then
|
if Nam = Error then
|
||||||
return;
|
return;
|
||||||
|
@ -719,10 +746,6 @@ package body Sem_Ch8 is
|
||||||
then
|
then
|
||||||
Error_Msg_N ("(Ada 2005): the renamed object is not "
|
Error_Msg_N ("(Ada 2005): the renamed object is not "
|
||||||
& "access-to-constant ('R'M 8.5.1(6))", N);
|
& "access-to-constant ('R'M 8.5.1(6))", N);
|
||||||
|
|
||||||
elsif Null_Exclusion_Present (Access_Definition (N)) then
|
|
||||||
Error_Msg_N ("(Ada 2005): null-excluding attribute ignored "
|
|
||||||
& "('R'M 8.5.1(6))?", N);
|
|
||||||
end if;
|
end if;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
@ -746,14 +769,80 @@ package body Sem_Ch8 is
|
||||||
return;
|
return;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
-- Ada 2005 (AI-327)
|
||||||
|
|
||||||
|
if Ada_Version >= Ada_05
|
||||||
|
and then Nkind (Nam) = N_Attribute_Reference
|
||||||
|
and then Attribute_Name (Nam) = Name_Priority
|
||||||
|
then
|
||||||
|
null;
|
||||||
|
|
||||||
|
elsif Ada_Version >= Ada_05
|
||||||
|
and then Nkind (Nam) in N_Has_Entity
|
||||||
|
then
|
||||||
|
declare
|
||||||
|
Error_Node : Node_Id;
|
||||||
|
Nam_Decl : Node_Id;
|
||||||
|
Nam_Ent : Entity_Id;
|
||||||
|
Subtyp_Decl : Node_Id;
|
||||||
|
|
||||||
|
begin
|
||||||
|
if Nkind (Nam) = N_Attribute_Reference then
|
||||||
|
Nam_Ent := Entity (Prefix (Nam));
|
||||||
|
else
|
||||||
|
Nam_Ent := Entity (Nam);
|
||||||
|
end if;
|
||||||
|
|
||||||
|
Nam_Decl := Parent (Nam_Ent);
|
||||||
|
Subtyp_Decl := Parent (Etype (Nam_Ent));
|
||||||
|
|
||||||
|
if Has_Null_Exclusion (N)
|
||||||
|
and then not Has_Null_Exclusion (Nam_Decl)
|
||||||
|
then
|
||||||
|
-- Ada 2005 (AI-423): If the object name denotes a generic
|
||||||
|
-- formal object of a generic unit G, and the object renaming
|
||||||
|
-- declaration occurs within the body of G or within the body
|
||||||
|
-- of a generic unit declared within the declarative region
|
||||||
|
-- of G, then the declaration of the formal object of G shall
|
||||||
|
-- have a null exclusion.
|
||||||
|
|
||||||
|
if Is_Formal_Object (Nam_Ent)
|
||||||
|
and then In_Generic_Scope (Id)
|
||||||
|
then
|
||||||
|
if Present (Subtype_Mark (Nam_Decl)) then
|
||||||
|
Error_Node := Subtype_Mark (Nam_Decl);
|
||||||
|
else
|
||||||
|
pragma Assert
|
||||||
|
(Ada_Version >= Ada_05
|
||||||
|
and then Present (Access_Definition (Nam_Decl)));
|
||||||
|
|
||||||
|
Error_Node := Access_Definition (Nam_Decl);
|
||||||
|
end if;
|
||||||
|
|
||||||
|
Error_Msg_N ("null-exclusion required in formal " &
|
||||||
|
"object declaration", Error_Node);
|
||||||
|
|
||||||
|
-- Ada 2005 (AI-423): Otherwise, the subtype of the object
|
||||||
|
-- name shall exclude null.
|
||||||
|
|
||||||
|
elsif Nkind (Subtyp_Decl) = N_Subtype_Declaration
|
||||||
|
and then not Has_Null_Exclusion (Subtyp_Decl)
|
||||||
|
then
|
||||||
|
Error_Msg_N ("subtype must have null-exclusion",
|
||||||
|
Subtyp_Decl);
|
||||||
|
end if;
|
||||||
|
end if;
|
||||||
|
end;
|
||||||
|
end if;
|
||||||
|
|
||||||
Set_Ekind (Id, E_Variable);
|
Set_Ekind (Id, E_Variable);
|
||||||
Init_Size_Align (Id);
|
Init_Size_Align (Id);
|
||||||
|
|
||||||
if T = Any_Type or else Etype (Nam) = Any_Type then
|
if T = Any_Type or else Etype (Nam) = Any_Type then
|
||||||
return;
|
return;
|
||||||
|
|
||||||
-- Verify that the renamed entity is an object or a function call.
|
-- Verify that the renamed entity is an object or a function call. It
|
||||||
-- It may have been rewritten in several ways.
|
-- may have been rewritten in several ways.
|
||||||
|
|
||||||
elsif Is_Object_Reference (Nam) then
|
elsif Is_Object_Reference (Nam) then
|
||||||
if Comes_From_Source (N)
|
if Comes_From_Source (N)
|
||||||
|
@ -777,9 +866,9 @@ package body Sem_Ch8 is
|
||||||
and then Is_Function_Attribute_Name
|
and then Is_Function_Attribute_Name
|
||||||
(Attribute_Name (Original_Node (Nam))))
|
(Attribute_Name (Original_Node (Nam))))
|
||||||
|
|
||||||
-- Weird but legal, equivalent to renaming a function call
|
-- Weird but legal, equivalent to renaming a function call.
|
||||||
-- Illegal if the literal is the result of constant-folding
|
-- Illegal if the literal is the result of constant-folding an
|
||||||
-- an attribute reference that is not a function.
|
-- attribute reference that is not a function.
|
||||||
|
|
||||||
or else (Is_Entity_Name (Nam)
|
or else (Is_Entity_Name (Nam)
|
||||||
and then Ekind (Entity (Nam)) = E_Enumeration_Literal
|
and then Ekind (Entity (Nam)) = E_Enumeration_Literal
|
||||||
|
@ -791,14 +880,20 @@ package body Sem_Ch8 is
|
||||||
then
|
then
|
||||||
null;
|
null;
|
||||||
|
|
||||||
else
|
elsif Nkind (Nam) = N_Type_Conversion then
|
||||||
if Nkind (Nam) = N_Type_Conversion then
|
Error_Msg_N
|
||||||
Error_Msg_N
|
("renaming of conversion only allowed for tagged types", Nam);
|
||||||
("renaming of conversion only allowed for tagged types", Nam);
|
|
||||||
|
|
||||||
else
|
-- Ada 2005 (AI-327)
|
||||||
Error_Msg_N ("expect object name in renaming", Nam);
|
|
||||||
end if;
|
elsif Ada_Version >= Ada_05
|
||||||
|
and then Nkind (Nam) = N_Attribute_Reference
|
||||||
|
and then Attribute_Name (Nam) = Name_Priority
|
||||||
|
then
|
||||||
|
null;
|
||||||
|
|
||||||
|
else
|
||||||
|
Error_Msg_N ("expect object name in renaming", Nam);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
Set_Etype (Id, T2);
|
Set_Etype (Id, T2);
|
||||||
|
@ -826,8 +921,8 @@ package body Sem_Ch8 is
|
||||||
return;
|
return;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- Apply Text_IO kludge here, since we may be renaming one of
|
-- Apply Text_IO kludge here, since we may be renaming one of the
|
||||||
-- the children of Text_IO
|
-- children of Text_IO
|
||||||
|
|
||||||
Text_IO_Kludge (Name (N));
|
Text_IO_Kludge (Name (N));
|
||||||
|
|
||||||
|
@ -847,14 +942,6 @@ package body Sem_Ch8 is
|
||||||
Error_Msg_N
|
Error_Msg_N
|
||||||
("expect package name in renaming", Name (N));
|
("expect package name in renaming", Name (N));
|
||||||
|
|
||||||
-- Ada 2005 (AI-50217): Limited withed packages cannot be renamed
|
|
||||||
|
|
||||||
elsif Ekind (Old_P) = E_Package
|
|
||||||
and then From_With_Type (Old_P)
|
|
||||||
then
|
|
||||||
Error_Msg_N
|
|
||||||
("limited withed package cannot be renamed", Name (N));
|
|
||||||
|
|
||||||
elsif Ekind (Old_P) /= E_Package
|
elsif Ekind (Old_P) /= E_Package
|
||||||
and then not (Ekind (Old_P) = E_Generic_Package
|
and then not (Ekind (Old_P) = E_Generic_Package
|
||||||
and then In_Open_Scopes (Old_P))
|
and then In_Open_Scopes (Old_P))
|
||||||
|
@ -875,9 +962,9 @@ package body Sem_Ch8 is
|
||||||
Set_Etype (New_P, Standard_Void_Type);
|
Set_Etype (New_P, Standard_Void_Type);
|
||||||
|
|
||||||
else
|
else
|
||||||
-- Entities in the old package are accessible through the
|
-- Entities in the old package are accessible through the renaming
|
||||||
-- renaming entity. The simplest implementation is to have
|
-- entity. The simplest implementation is to have both packages share
|
||||||
-- both packages share the entity list.
|
-- the entity list.
|
||||||
|
|
||||||
Set_Ekind (New_P, E_Package);
|
Set_Ekind (New_P, E_Package);
|
||||||
Set_Etype (New_P, Standard_Void_Type);
|
Set_Etype (New_P, Standard_Void_Type);
|
||||||
|
@ -1128,16 +1215,30 @@ package body Sem_Ch8 is
|
||||||
---------------------------------
|
---------------------------------
|
||||||
|
|
||||||
procedure Analyze_Subprogram_Renaming (N : Node_Id) is
|
procedure Analyze_Subprogram_Renaming (N : Node_Id) is
|
||||||
Spec : constant Node_Id := Specification (N);
|
Formal_Spec : constant Node_Id := Corresponding_Formal_Spec (N);
|
||||||
Save_AV : constant Ada_Version_Type := Ada_Version;
|
Is_Actual : constant Boolean := Present (Formal_Spec);
|
||||||
Save_AV_Exp : constant Ada_Version_Type := Ada_Version_Explicit;
|
Inst_Node : Node_Id := Empty;
|
||||||
Nam : constant Node_Id := Name (N);
|
Nam : constant Node_Id := Name (N);
|
||||||
New_S : Entity_Id;
|
New_S : Entity_Id;
|
||||||
Old_S : Entity_Id := Empty;
|
Old_S : Entity_Id := Empty;
|
||||||
Rename_Spec : Entity_Id;
|
Rename_Spec : Entity_Id;
|
||||||
Formal_Spec : constant Node_Id := Corresponding_Formal_Spec (N);
|
Save_AV : constant Ada_Version_Type := Ada_Version;
|
||||||
Is_Actual : constant Boolean := Present (Formal_Spec);
|
Save_AV_Exp : constant Ada_Version_Type := Ada_Version_Explicit;
|
||||||
Inst_Node : Node_Id := Empty;
|
Spec : constant Node_Id := Specification (N);
|
||||||
|
|
||||||
|
procedure Check_Null_Exclusion
|
||||||
|
(Ren : Entity_Id;
|
||||||
|
Sub : Entity_Id);
|
||||||
|
-- Ada 2005 (AI-423): Given renaming Ren of subprogram Sub, check the
|
||||||
|
-- following AI rules:
|
||||||
|
-- o If Ren is a renaming of a formal subprogram and one of its
|
||||||
|
-- parameters has a null exclusion, then the corresponding formal
|
||||||
|
-- in Sub must also have one. Otherwise the subtype of the Sub's
|
||||||
|
-- formal parameter must exclude null.
|
||||||
|
-- o If Ren is a renaming of a formal function and its retrun
|
||||||
|
-- profile has a null exclusion, then Sub's return profile must
|
||||||
|
-- have one. Otherwise the subtype of Sub's return profile must
|
||||||
|
-- exclude null.
|
||||||
|
|
||||||
function Original_Subprogram (Subp : Entity_Id) return Entity_Id;
|
function Original_Subprogram (Subp : Entity_Id) return Entity_Id;
|
||||||
-- Find renamed entity when the declaration is a renaming_as_body
|
-- Find renamed entity when the declaration is a renaming_as_body
|
||||||
|
@ -1146,6 +1247,50 @@ package body Sem_Ch8 is
|
||||||
-- occurs before the subprogram it completes is frozen, and renaming
|
-- occurs before the subprogram it completes is frozen, and renaming
|
||||||
-- indirectly renames the subprogram itself.(Defect Report 8652/0027).
|
-- indirectly renames the subprogram itself.(Defect Report 8652/0027).
|
||||||
|
|
||||||
|
--------------------------
|
||||||
|
-- Check_Null_Exclusion --
|
||||||
|
--------------------------
|
||||||
|
|
||||||
|
procedure Check_Null_Exclusion
|
||||||
|
(Ren : Entity_Id;
|
||||||
|
Sub : Entity_Id)
|
||||||
|
is
|
||||||
|
Ren_Formal : Entity_Id := First_Formal (Ren);
|
||||||
|
Sub_Formal : Entity_Id := First_Formal (Sub);
|
||||||
|
|
||||||
|
begin
|
||||||
|
-- Parameter check
|
||||||
|
|
||||||
|
while Present (Ren_Formal)
|
||||||
|
and then Present (Sub_Formal)
|
||||||
|
loop
|
||||||
|
if Has_Null_Exclusion (Parent (Ren_Formal))
|
||||||
|
and then
|
||||||
|
not (Has_Null_Exclusion (Parent (Sub_Formal))
|
||||||
|
or else Can_Never_Be_Null (Etype (Sub_Formal)))
|
||||||
|
then
|
||||||
|
Error_Msg_N ("null-exclusion required in parameter profile",
|
||||||
|
Parent (Sub_Formal));
|
||||||
|
end if;
|
||||||
|
|
||||||
|
Next_Formal (Ren_Formal);
|
||||||
|
Next_Formal (Sub_Formal);
|
||||||
|
end loop;
|
||||||
|
|
||||||
|
-- Return profile check
|
||||||
|
|
||||||
|
if Nkind (Parent (Ren)) = N_Function_Specification
|
||||||
|
and then Nkind (Parent (Sub)) = N_Function_Specification
|
||||||
|
and then Has_Null_Exclusion (Parent (Ren))
|
||||||
|
and then
|
||||||
|
not (Has_Null_Exclusion (Parent (Sub))
|
||||||
|
or else Can_Never_Be_Null (Etype (Sub)))
|
||||||
|
then
|
||||||
|
Error_Msg_N ("null-exclusion required in return profile",
|
||||||
|
Result_Definition (Parent (Sub)));
|
||||||
|
end if;
|
||||||
|
end Check_Null_Exclusion;
|
||||||
|
|
||||||
-------------------------
|
-------------------------
|
||||||
-- Original_Subprogram --
|
-- Original_Subprogram --
|
||||||
-------------------------
|
-------------------------
|
||||||
|
@ -1332,7 +1477,7 @@ package body Sem_Ch8 is
|
||||||
and then In_Open_Scopes (Scope (Hidden))
|
and then In_Open_Scopes (Scope (Hidden))
|
||||||
and then Is_Immediately_Visible (Hidden)
|
and then Is_Immediately_Visible (Hidden)
|
||||||
and then Comes_From_Source (Hidden)
|
and then Comes_From_Source (Hidden)
|
||||||
and then Hidden /= Old_S
|
and then Hidden /= Old_S
|
||||||
then
|
then
|
||||||
Error_Msg_Sloc := Sloc (Hidden);
|
Error_Msg_Sloc := Sloc (Hidden);
|
||||||
Error_Msg_N ("?default subprogram is resolved " &
|
Error_Msg_N ("?default subprogram is resolved " &
|
||||||
|
@ -1411,7 +1556,7 @@ package body Sem_Ch8 is
|
||||||
Error_Msg_N ("(Ada 83) renaming cannot serve as a body", N);
|
Error_Msg_N ("(Ada 83) renaming cannot serve as a body", N);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
Set_Convention (New_S, Convention (Rename_Spec));
|
Set_Convention (New_S, Convention (Rename_Spec));
|
||||||
Check_Fully_Conformant (New_S, Rename_Spec);
|
Check_Fully_Conformant (New_S, Rename_Spec);
|
||||||
Set_Public_Status (New_S);
|
Set_Public_Status (New_S);
|
||||||
|
|
||||||
|
@ -1500,7 +1645,18 @@ package body Sem_Ch8 is
|
||||||
-- in this case, so we must indicate the declaration is complete as is.
|
-- in this case, so we must indicate the declaration is complete as is.
|
||||||
|
|
||||||
if No (Rename_Spec) then
|
if No (Rename_Spec) then
|
||||||
Set_Has_Completion (New_S);
|
Set_Has_Completion (New_S);
|
||||||
|
Set_Is_Pure (New_S, Is_Pure (Entity (Nam)));
|
||||||
|
Set_Is_Preelaborated (New_S, Is_Preelaborated (Entity (Nam)));
|
||||||
|
|
||||||
|
-- Ada 2005 (AI-423): Check the consistency of null exclusions
|
||||||
|
-- between a subprogram and its renaming.
|
||||||
|
|
||||||
|
if Ada_Version >= Ada_05 then
|
||||||
|
Check_Null_Exclusion
|
||||||
|
(Ren => New_S,
|
||||||
|
Sub => Entity (Nam));
|
||||||
|
end if;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- Find the renamed entity that matches the given specification. Disable
|
-- Find the renamed entity that matches the given specification. Disable
|
||||||
|
@ -1940,7 +2096,7 @@ package body Sem_Ch8 is
|
||||||
Use_One_Type (Id);
|
Use_One_Type (Id);
|
||||||
|
|
||||||
if Nkind (Parent (N)) = N_Compilation_Unit then
|
if Nkind (Parent (N)) = N_Compilation_Unit then
|
||||||
if Nkind (Id) = N_Identifier then
|
if Nkind (Id) = N_Identifier then
|
||||||
Error_Msg_N ("type is not directly visible", Id);
|
Error_Msg_N ("type is not directly visible", Id);
|
||||||
|
|
||||||
elsif Is_Child_Unit (Scope (Entity (Id)))
|
elsif Is_Child_Unit (Scope (Entity (Id)))
|
||||||
|
@ -2664,7 +2820,9 @@ package body Sem_Ch8 is
|
||||||
|
|
||||||
T := Entity (Id);
|
T := Entity (Id);
|
||||||
|
|
||||||
if T = Any_Type then
|
if T = Any_Type
|
||||||
|
or else From_With_Type (T)
|
||||||
|
then
|
||||||
null;
|
null;
|
||||||
|
|
||||||
-- Note that the use_Type clause may mention a subtype of the
|
-- Note that the use_Type clause may mention a subtype of the
|
||||||
|
@ -2977,7 +3135,7 @@ package body Sem_Ch8 is
|
||||||
Nkind (Parent (Parent (N))) = N_Use_Package_Clause
|
Nkind (Parent (Parent (N))) = N_Use_Package_Clause
|
||||||
then
|
then
|
||||||
Error_Msg_NE
|
Error_Msg_NE
|
||||||
("\possibly missing with_clause for&", N, Ent);
|
("\possible missing with_clause for&", N, Ent);
|
||||||
end if;
|
end if;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
@ -3147,7 +3305,7 @@ package body Sem_Ch8 is
|
||||||
Get_Name_String (N);
|
Get_Name_String (N);
|
||||||
|
|
||||||
if Is_Bad_Spelling_Of
|
if Is_Bad_Spelling_Of
|
||||||
(Name_Buffer (1 .. Name_Len), S)
|
(S, Name_Buffer (1 .. Name_Len))
|
||||||
then
|
then
|
||||||
Ematch := E;
|
Ematch := E;
|
||||||
exit;
|
exit;
|
||||||
|
@ -3668,23 +3826,51 @@ package body Sem_Ch8 is
|
||||||
|
|
||||||
Id := Current_Entity (Selector);
|
Id := Current_Entity (Selector);
|
||||||
|
|
||||||
while Present (Id) loop
|
declare
|
||||||
|
Is_New_Candidate : Boolean;
|
||||||
|
|
||||||
if Scope (Id) = P_Name then
|
begin
|
||||||
Candidate := Id;
|
while Present (Id) loop
|
||||||
|
if Scope (Id) = P_Name then
|
||||||
|
Candidate := Id;
|
||||||
|
Is_New_Candidate := True;
|
||||||
|
|
||||||
if Is_Child_Unit (Id) then
|
-- Ada 2005 (AI-217): Handle shadow entities associated with types
|
||||||
exit when Is_Visible_Child_Unit (Id)
|
-- declared in limited-withed nested packages. We don't need to
|
||||||
or else Is_Immediately_Visible (Id);
|
-- handle E_Incomplete_Subtype entities because the entities in
|
||||||
|
-- the limited view are always E_Incomplete_Type entities (see
|
||||||
|
-- Build_Limited_Views). Regarding the expression used to evaluate
|
||||||
|
-- the scope, it is important to note that the limited view also
|
||||||
|
-- has shadow entities associated nested packages. For this reason
|
||||||
|
-- the correct scope of the entity is the scope of the real entity
|
||||||
|
|
||||||
|
elsif From_With_Type (Id)
|
||||||
|
and then Is_Type (Id)
|
||||||
|
and then Ekind (Id) = E_Incomplete_Type
|
||||||
|
and then Present (Non_Limited_View (Id))
|
||||||
|
and then Scope (Non_Limited_View (Id)) = P_Name
|
||||||
|
then
|
||||||
|
Candidate := Non_Limited_View (Id);
|
||||||
|
Is_New_Candidate := True;
|
||||||
|
|
||||||
else
|
else
|
||||||
exit when not Is_Hidden (Id)
|
Is_New_Candidate := False;
|
||||||
or else Is_Immediately_Visible (Id);
|
|
||||||
end if;
|
end if;
|
||||||
end if;
|
|
||||||
|
|
||||||
Id := Homonym (Id);
|
if Is_New_Candidate then
|
||||||
end loop;
|
if Is_Child_Unit (Id) then
|
||||||
|
exit when Is_Visible_Child_Unit (Id)
|
||||||
|
or else Is_Immediately_Visible (Id);
|
||||||
|
|
||||||
|
else
|
||||||
|
exit when not Is_Hidden (Id)
|
||||||
|
or else Is_Immediately_Visible (Id);
|
||||||
|
end if;
|
||||||
|
end if;
|
||||||
|
|
||||||
|
Id := Homonym (Id);
|
||||||
|
end loop;
|
||||||
|
end;
|
||||||
|
|
||||||
if No (Id)
|
if No (Id)
|
||||||
and then (Ekind (P_Name) = E_Procedure
|
and then (Ekind (P_Name) = E_Procedure
|
||||||
|
@ -4041,11 +4227,6 @@ package body Sem_Ch8 is
|
||||||
-- but is a reasonable heuristic on the use of nested generics.
|
-- but is a reasonable heuristic on the use of nested generics.
|
||||||
-- The proper solution requires a full renaming model.
|
-- The proper solution requires a full renaming model.
|
||||||
|
|
||||||
function Within (Inner, Outer : Entity_Id) return Boolean;
|
|
||||||
-- Determine whether a candidate subprogram is defined within
|
|
||||||
-- the enclosing instance. If yes, it has precedence over outer
|
|
||||||
-- candidates.
|
|
||||||
|
|
||||||
function Is_Visible_Operation (Op : Entity_Id) return Boolean;
|
function Is_Visible_Operation (Op : Entity_Id) return Boolean;
|
||||||
-- If the renamed entity is an implicit operator, check whether it is
|
-- If the renamed entity is an implicit operator, check whether it is
|
||||||
-- visible because its operand type is properly visible. This
|
-- visible because its operand type is properly visible. This
|
||||||
|
@ -4053,6 +4234,15 @@ package body Sem_Ch8 is
|
||||||
-- source in a renaming declaration or a formal subprogram instance,
|
-- source in a renaming declaration or a formal subprogram instance,
|
||||||
-- but not to default generic actuals with a name.
|
-- but not to default generic actuals with a name.
|
||||||
|
|
||||||
|
function Report_Overload return Entity_Id;
|
||||||
|
-- List possible interpretations, and specialize message in the
|
||||||
|
-- case of a generic actual.
|
||||||
|
|
||||||
|
function Within (Inner, Outer : Entity_Id) return Boolean;
|
||||||
|
-- Determine whether a candidate subprogram is defined within
|
||||||
|
-- the enclosing instance. If yes, it has precedence over outer
|
||||||
|
-- candidates.
|
||||||
|
|
||||||
------------------------
|
------------------------
|
||||||
-- Enclosing_Instance --
|
-- Enclosing_Instance --
|
||||||
------------------------
|
------------------------
|
||||||
|
@ -4149,7 +4339,6 @@ package body Sem_Ch8 is
|
||||||
|
|
||||||
begin
|
begin
|
||||||
while Sc /= Standard_Standard loop
|
while Sc /= Standard_Standard loop
|
||||||
|
|
||||||
if Sc = Outer then
|
if Sc = Outer then
|
||||||
return True;
|
return True;
|
||||||
else
|
else
|
||||||
|
@ -4160,20 +4349,20 @@ package body Sem_Ch8 is
|
||||||
return False;
|
return False;
|
||||||
end Within;
|
end Within;
|
||||||
|
|
||||||
function Report_Overload return Entity_Id;
|
---------------------
|
||||||
-- List possible interpretations, and specialize message in the
|
-- Report_Overload --
|
||||||
-- case of a generic actual.
|
---------------------
|
||||||
|
|
||||||
function Report_Overload return Entity_Id is
|
function Report_Overload return Entity_Id is
|
||||||
begin
|
begin
|
||||||
if Is_Actual then
|
if Is_Actual then
|
||||||
Error_Msg_NE
|
Error_Msg_NE
|
||||||
("ambiguous actual subprogram&, " &
|
("ambiguous actual subprogram&, " &
|
||||||
"possible interpretations: ", N, Nam);
|
"possible interpretations:", N, Nam);
|
||||||
else
|
else
|
||||||
Error_Msg_N
|
Error_Msg_N
|
||||||
("ambiguous subprogram, " &
|
("ambiguous subprogram, " &
|
||||||
"possible interpretations: ", N);
|
"possible interpretations:", N);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
List_Interps (Nam, N);
|
List_Interps (Nam, N);
|
||||||
|
@ -4758,6 +4947,12 @@ package body Sem_Ch8 is
|
||||||
Set_Etype (N, T);
|
Set_Etype (N, T);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
elsif Attribute_Name (N) = Name_Stub_Type then
|
||||||
|
|
||||||
|
-- This is handled in Analyze_Attribute
|
||||||
|
|
||||||
|
Analyze (N);
|
||||||
|
|
||||||
-- All other attributes are invalid in a subtype mark
|
-- All other attributes are invalid in a subtype mark
|
||||||
|
|
||||||
else
|
else
|
||||||
|
@ -4786,7 +4981,7 @@ package body Sem_Ch8 is
|
||||||
then
|
then
|
||||||
Error_Msg_Sloc := Sloc (T_Name);
|
Error_Msg_Sloc := Sloc (T_Name);
|
||||||
Error_Msg_N ("subtype mark required in this context", N);
|
Error_Msg_N ("subtype mark required in this context", N);
|
||||||
Error_Msg_NE ("\found & declared#", N, T_Name);
|
Error_Msg_NE ("\\found & declared#", N, T_Name);
|
||||||
Set_Entity (N, Any_Type);
|
Set_Entity (N, Any_Type);
|
||||||
|
|
||||||
else
|
else
|
||||||
|
@ -4794,8 +4989,22 @@ package body Sem_Ch8 is
|
||||||
|
|
||||||
if In_Open_Scopes (T_Name) then
|
if In_Open_Scopes (T_Name) then
|
||||||
if Ekind (Base_Type (T_Name)) = E_Task_Type then
|
if Ekind (Base_Type (T_Name)) = E_Task_Type then
|
||||||
Error_Msg_N ("task type cannot be used as type mark " &
|
|
||||||
"within its own body", N);
|
-- In Ada 2005, a task name can be used in an access
|
||||||
|
-- definition within its own body.
|
||||||
|
|
||||||
|
if Ada_Version >= Ada_05
|
||||||
|
and then Nkind (Parent (N)) = N_Access_Definition
|
||||||
|
then
|
||||||
|
Set_Entity (N, T_Name);
|
||||||
|
Set_Etype (N, T_Name);
|
||||||
|
return;
|
||||||
|
|
||||||
|
else
|
||||||
|
Error_Msg_N
|
||||||
|
("task type cannot be used as type mark " &
|
||||||
|
"within its own body", N);
|
||||||
|
end if;
|
||||||
else
|
else
|
||||||
Error_Msg_N ("type declaration cannot refer to itself", N);
|
Error_Msg_N ("type declaration cannot refer to itself", N);
|
||||||
end if;
|
end if;
|
||||||
|
@ -5108,21 +5317,24 @@ package body Sem_Ch8 is
|
||||||
|
|
||||||
function In_Open_Scopes (S : Entity_Id) return Boolean is
|
function In_Open_Scopes (S : Entity_Id) return Boolean is
|
||||||
begin
|
begin
|
||||||
-- Since there are several scope stacks maintained by Scope_Stack each
|
-- Several scope stacks are maintained by Scope_Stack. The base of the
|
||||||
-- delineated by Standard (see comments by definition of Scope_Stack)
|
-- currently active scope stack is denoted by the Is_Active_Stack_Base
|
||||||
-- it is necessary to end the search when Standard is reached.
|
-- flag in the scope stack entry. Note that the scope stacks used to
|
||||||
|
-- simply be delimited implicitly by the presence of Standard_Standard
|
||||||
|
-- at their base, but there now are cases where this is not sufficient
|
||||||
|
-- because Standard_Standard actually may appear in the middle of the
|
||||||
|
-- active set of scopes.
|
||||||
|
|
||||||
for J in reverse 0 .. Scope_Stack.Last loop
|
for J in reverse 0 .. Scope_Stack.Last loop
|
||||||
if Scope_Stack.Table (J).Entity = S then
|
if Scope_Stack.Table (J).Entity = S then
|
||||||
return True;
|
return True;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- We need Is_Active_Stack_Base to tell us when to stop rather
|
-- Check Is_Active_Stack_Base to tell us when to stop, as there are
|
||||||
-- than checking for Standard_Standard because there are cases
|
-- cases where Standard_Standard appears in the middle of the active
|
||||||
-- where Standard_Standard appears in the middle of the active
|
-- set of scopes. This affects the declaration and overriding of
|
||||||
-- set of scopes. This affects the declaration and overriding
|
-- private inherited operations in instantiations of generic child
|
||||||
-- of private inherited operations in instantiations of generic
|
-- units.
|
||||||
-- child units.
|
|
||||||
|
|
||||||
exit when Scope_Stack.Table (J).Is_Active_Stack_Base;
|
exit when Scope_Stack.Table (J).Is_Active_Stack_Base;
|
||||||
end loop;
|
end loop;
|
||||||
|
@ -5359,6 +5571,7 @@ package body Sem_Ch8 is
|
||||||
SST.Actions_To_Be_Wrapped_After := No_List;
|
SST.Actions_To_Be_Wrapped_After := No_List;
|
||||||
SST.First_Use_Clause := Empty;
|
SST.First_Use_Clause := Empty;
|
||||||
SST.Is_Active_Stack_Base := False;
|
SST.Is_Active_Stack_Base := False;
|
||||||
|
SST.Previous_Visibility := False;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
if Debug_Flag_W then
|
if Debug_Flag_W then
|
||||||
|
@ -6235,6 +6448,11 @@ package body Sem_Ch8 is
|
||||||
if In_Open_Scopes (Scope (T)) then
|
if In_Open_Scopes (Scope (T)) then
|
||||||
null;
|
null;
|
||||||
|
|
||||||
|
elsif From_With_Type (T) then
|
||||||
|
Error_Msg_N
|
||||||
|
("incomplete type from limited view "
|
||||||
|
& "cannot appear in use clause", Id);
|
||||||
|
|
||||||
-- If the subtype mark designates a subtype in a different package,
|
-- If the subtype mark designates a subtype in a different package,
|
||||||
-- we have to check that the parent type is visible, otherwise the
|
-- we have to check that the parent type is visible, otherwise the
|
||||||
-- use type clause is a noop. Not clear how to do that???
|
-- use type clause is a noop. Not clear how to do that???
|
||||||
|
|
Loading…
Reference in New Issue