Skip to content

R
riscv-gcc-1
Commit 16ca248a by Ed Schonberg Committed by Arnaud Charlet
Options

sem_ch8.adb (Has_Components): If the argument is an incomplete type that is a limited view... 

2007-04-06  Ed Schonberg  <schonberg@adacore.com>
	    Robert Dewar  <dewar@adacore.com>

	* sem_ch8.adb (Has_Components): If the argument is an incomplete type
	that is a limited view, check the non-limited view if available.
	(Undefined): Refine error message for missing with of Text_IO
	(Find_Expanded_Name): Use Is_Known_Unit for more accurate error message
	to distinguish real missing with cases.
	Fix format of all missing with messages
	(Analyze_Subprogram_Renaming): Emit proper error message on illegal
	renaming as body when renamed entity is abstract.

From-SVN: r123597
parent 13bbad84
Showing with 271 additions and 287 deletions
gcc/ada/sem_ch8.adb
......@@ -33,6 +33,7 @@ with Exp_Tss; use Exp_Tss;
with Exp_Util; use Exp_Util;
with Fname; use Fname;
with Freeze; use Freeze;
with Impunit; use Impunit;
with Lib; use Lib;
with Lib.Load; use Lib.Load;
with Lib.Xref; use Lib.Xref;
......@@ -229,23 +230,22 @@ package body Sem_Ch8 is
-- Compiling subunits --
------------------------
-- Subunits must be compiled in the environment of the corresponding
-- stub, that is to say with the same visibility into the parent (and its
-- Subunits must be compiled in the environment of the corresponding stub,
-- that is to say with the same visibility into the parent (and its
-- context) that is available at the point of the stub declaration, but
-- with the additional visibility provided by the context clause of the
-- subunit itself. As a result, compilation of a subunit forces compilation
-- of the parent (see description in lib-). At the point of the stub
-- declaration, Analyze is called recursively to compile the proper body
-- of the subunit, but without reinitializing the names table, nor the
-- scope stack (i.e. standard is not pushed on the stack). In this fashion
-- the context of the subunit is added to the context of the parent, and
-- the subunit is compiled in the correct environment. Note that in the
-- course of processing the context of a subunit, Standard will appear
-- twice on the scope stack: once for the parent of the subunit, and
-- once for the unit in the context clause being compiled. However, the
-- two sets of entities are not linked by homonym chains, so that the
-- compilation of any context unit happens in a fresh visibility
-- environment.
-- declaration, Analyze is called recursively to compile the proper body of
-- the subunit, but without reinitializing the names table, nor the scope
-- stack (i.e. standard is not pushed on the stack). In this fashion the
-- context of the subunit is added to the context of the parent, and the
-- subunit is compiled in the correct environment. Note that in the course
-- of processing the context of a subunit, Standard will appear twice on
-- the scope stack: once for the parent of the subunit, and once for the
-- unit in the context clause being compiled. However, the two sets of
-- entities are not linked by homonym chains, so that the compilation of
-- any context unit happens in a fresh visibility environment.
-------------------------------
-- Processing of USE Clauses --
......@@ -292,8 +292,8 @@ package body Sem_Ch8 is
-- contains the full declaration. To simplify the swap, the defining
-- occurrence that currently holds the private declaration points to the
-- full declaration. During semantic processing the defining occurrence
-- also points to a list of private dependents, that is to say access
-- types or composite types whose designated types or component types are
-- also points to a list of private dependents, that is to say access types
-- or composite types whose designated types or component types are
-- subtypes or derived types of the private type in question. After the
-- full declaration has been seen, the private dependents are updated to
-- indicate that they have full definitions.
......@@ -457,12 +457,11 @@ package body Sem_Ch8 is
function Has_Implicit_Operator (N : Node_Id) return Boolean;
-- N is an expanded name whose selector is an operator name (eg P."+").
-- A declarative part contains an implicit declaration of an operator
-- if it has a declaration of a type to which one of the predefined
-- operators apply. The existence of this routine is an artifact of
-- our implementation: a more straightforward but more space-consuming
-- choice would be to make all inherited operators explicit in the
-- symbol table.
-- declarative part contains an implicit declaration of an operator if it
-- has a declaration of a type to which one of the predefined operators
-- apply. The existence of this routine is an implementation artifact. A
-- more straightforward but more space-consuming choice would be to make
-- all inherited operators explicit in the symbol table.
procedure Inherit_Renamed_Profile (New_S : Entity_Id; Old_S : Entity_Id);
-- A subprogram defined by a renaming declaration inherits the parameter
......@@ -471,17 +470,17 @@ package body Sem_Ch8 is
-- subprogram, which are then used to recheck the default values.
function Is_Appropriate_For_Record (T : Entity_Id) return Boolean;
-- Prefix is appropriate for record if it is of a record type, or
-- an access to such.
-- Prefix is appropriate for record if it is of a record type, or an access
-- to such.
function Is_Appropriate_For_Entry_Prefix (T : Entity_Id) return Boolean;
-- True if it is of a task type, a protected type, or else an access
-- to one of these types.
-- True if it is of a task type, a protected type, or else an access to one
-- of these types.
procedure Note_Redundant_Use (Clause : Node_Id);
-- Mark the name in a use clause as redundant if the corresponding
-- entity is already use-visible. Emit a warning if the use clause
-- comes from source and the proper warnings are enabled.
-- Mark the name in a use clause as redundant if the corresponding entity
-- is already use-visible. Emit a warning if the use clause comes from
-- source and the proper warnings are enabled.
procedure Premature_Usage (N : Node_Id);
-- Diagnose usage of an entity before it is visible
......@@ -507,9 +506,9 @@ package body Sem_Ch8 is
-- Analyze_Exception_Renaming --
--------------------------------
-- The language only allows a single identifier, but the tree holds
-- an identifier list. The parser has already issued an error message
-- if there is more than one element in the list.
-- The language only allows a single identifier, but the tree holds an
-- identifier list. The parser has already issued an error message if
-- there is more than one element in the list.
procedure Analyze_Exception_Renaming (N : Node_Id) is
Id : constant Node_Id := Defining_Identifier (N);
......@@ -543,10 +542,10 @@ package body Sem_Ch8 is
procedure Analyze_Expanded_Name (N : Node_Id) is
begin
-- If the entity pointer is already set, this is an internal node, or
-- a node that is analyzed more than once, after a tree modification.
-- In such a case there is no resolution to perform, just set the type.
-- For completeness, analyze prefix as well.
-- If the entity pointer is already set, this is an internal node, or a
-- node that is analyzed more than once, after a tree modification. In
-- such a case there is no resolution to perform, just set the type. For
-- completeness, analyze prefix as well.
if Present (Entity (N)) then
if Is_Type (Entity (N)) then
......@@ -577,8 +576,8 @@ package body Sem_Ch8 is
procedure Analyze_Generic_Package_Renaming (N : Node_Id) is
begin
-- Apply the Text_IO Kludge here, since we may be renaming
-- one of the subpackages of Text_IO, then join common routine.
-- Apply the Text_IO Kludge here, since we may be renaming one of the
-- subpackages of Text_IO, then join common routine.
Text_IO_Kludge (Name (N));
......@@ -704,11 +703,11 @@ package body Sem_Ch8 is
Set_Is_Pure (Id, Is_Pure (Current_Scope));
Enter_Name (Id);
-- The renaming of a component that depends on a discriminant
-- requires an actual subtype, because in subsequent use of the object
-- Gigi will be unable to locate the actual bounds. This explicit step
-- is required when the renaming is generated in removing side effects
-- of an already-analyzed expression.
-- The renaming of a component that depends on a discriminant requires
-- an actual subtype, because in subsequent use of the object Gigi will
-- be unable to locate the actual bounds. This explicit step is required
-- when the renaming is generated in removing side effects of an
-- already-analyzed expression.
if Nkind (Nam) = N_Selected_Component
and then Analyzed (Nam)
......@@ -749,8 +748,8 @@ package body Sem_Ch8 is
end if;
end if;
-- An object renaming requires an exact match of the type;
-- class-wide matching is not allowed.
-- An object renaming requires an exact match of the type. Class-wide
-- matching is not allowed.
if Is_Class_Wide_Type (T)
and then Base_Type (Etype (Nam)) /= Base_Type (T)
......@@ -822,8 +821,8 @@ package body Sem_Ch8 is
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.
-- 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)
......@@ -932,6 +931,7 @@ package body Sem_Ch8 is
Enter_Name (New_P);
Analyze (Name (N));
if Is_Entity_Name (Name (N)) then
Old_P := Entity (Name (N));
else
......@@ -1007,8 +1007,10 @@ package body Sem_Ch8 is
and then Chars (New_P) = Chars (Generic_Parent (Spec))
then
declare
E : Entity_Id := First_Entity (Old_P);
E : Entity_Id;
begin
E := First_Entity (Old_P);
while Present (E)
and then E /= New_P
loop
......@@ -1136,8 +1138,7 @@ package body Sem_Ch8 is
return;
end if;
-- Otherwise, find renamed entity, and build body of New_S as a call
-- to it.
-- Otherwise find renamed entity and build body of New_S as a call to it
Old_S := Find_Renamed_Entity (N, Selector_Name (Nam), New_S);
......@@ -1199,6 +1200,7 @@ package body Sem_Ch8 is
Generate_Reference (New_S, Defining_Entity (N), 'b');
Style.Check_Identifier (Defining_Entity (N), New_S);
end if;
else
Error_Msg_N ("no entry family matches specification", N);
end if;
......@@ -1231,21 +1233,23 @@ package body Sem_Ch8 is
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
--
-- 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
--
-- 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;
-- Find renamed entity when the declaration is a renaming_as_body
-- and the renamed entity may itself be a renaming_as_body. Used to
-- enforce rule that a renaming_as_body is illegal if the declaration
-- occurs before the subprogram it completes is frozen, and renaming
-- indirectly renames the subprogram itself.(Defect Report 8652/0027).
-- Find renamed entity when the declaration is a renaming_as_body and
-- the renamed entity may itself be a renaming_as_body. Used to enforce
-- rule that a renaming_as_body is illegal if the declaration occurs
-- before the subprogram it completes is frozen, and renaming indirectly
-- renames the subprogram itself.(Defect Report 8652/0027).
--------------------------
-- Check_Null_Exclusion --
......@@ -1255,12 +1259,14 @@ package body Sem_Ch8 is
(Ren : Entity_Id;
Sub : Entity_Id)
is
Ren_Formal : Entity_Id := First_Formal (Ren);
Sub_Formal : Entity_Id := First_Formal (Sub);
Ren_Formal : Entity_Id;
Sub_Formal : Entity_Id;
begin
-- Parameter check
Ren_Formal := First_Formal (Ren);
Sub_Formal := First_Formal (Sub);
while Present (Ren_Formal)
and then Present (Sub_Formal)
loop
......@@ -1345,15 +1351,15 @@ package body Sem_Ch8 is
if Nkind (Nam) = N_Attribute_Reference then
-- In the case of an abstract formal subprogram association,
-- rewrite an actual given by a stream attribute as the name
-- of the corresponding stream primitive of the type.
-- In the case of an abstract formal subprogram association, rewrite
-- an actual given by a stream attribute as the name of the
-- corresponding stream primitive of the type.
-- In a generic context the stream operations are not generated,
-- and this must be treated as a normal attribute reference, to
-- be expanded in subsequent instantiations.
-- In a generic context the stream operations are not generated, and
-- this must be treated as a normal attribute reference, to be
-- expanded in subsequent instantiations.
if Is_Actual and then Is_Abstract (Formal_Spec)
if Is_Actual and then Is_Abstract_Subprogram (Formal_Spec)
and then Expander_Active
then
declare
......@@ -1373,10 +1379,10 @@ package body Sem_Ch8 is
end if;
-- Retrieve the primitive subprogram associated with the
-- attribute. This can only be a stream attribute, since
-- those are the only ones that are dispatching (and the
-- actual for an abstract formal subprogram must be a
-- dispatching operation).
-- attribute. This can only be a stream attribute, since those
-- are the only ones that are dispatching (and the actual for
-- an abstract formal subprogram must be dispatching
-- operation).
case Attribute_Name (Nam) is
when Name_Input =>
......@@ -1424,13 +1430,13 @@ package body Sem_Ch8 is
-- Check whether this declaration corresponds to the instantiation
-- of a formal subprogram.
-- If this is an instantiation, the corresponding actual is frozen
-- and error messages can be made more precise. If this is a default
-- subprogram, the entity is already established in the generic, and
-- is not retrieved by visibility. If it is a default with a box, the
-- If this is an instantiation, the corresponding actual is frozen and
-- error messages can be made more precise. If this is a default
-- subprogram, the entity is already established in the generic, and is
-- not retrieved by visibility. If it is a default with a box, the
-- candidate interpretations, if any, have been collected when building
-- the renaming declaration. If overloaded, the proper interpretation
-- is determined in Find_Renamed_Entity. If the entity is an operator,
-- the renaming declaration. If overloaded, the proper interpretation is
-- determined in Find_Renamed_Entity. If the entity is an operator,
-- Find_Renamed_Entity applies additional visibility checks.
if Is_Actual then
......@@ -1456,9 +1462,9 @@ package body Sem_Ch8 is
-- If there is an immediately visible homonym of the operator
-- and the declaration has a default, this is worth a warning
-- because the user probably did not intend to get the pre-
-- defined operator, visible in the generic declaration.
-- To find if there is an intended candidate, analyze the
-- renaming again in the current context.
-- defined operator, visible in the generic declaration. To
-- find if there is an intended candidate, analyze the renaming
-- again in the current context.
elsif Scope (Old_S) = Standard_Standard
and then Present (Default_Name (Inst_Node))
......@@ -1545,7 +1551,7 @@ package body Sem_Ch8 is
begin
Remove (Old_Decl);
Insert_After (N, New_Decl);
Set_Is_Abstract (Rename_Spec, False);
Set_Is_Abstract_Subprogram (Rename_Spec, False);
Set_Analyzed (New_Decl);
end;
end if;
......@@ -1638,7 +1644,6 @@ package body Sem_Ch8 is
then
Error_Msg_N ("expect valid subprogram name in renaming", N);
return;
end if;
-- Most common case: subprogram renames subprogram. No body is generated
......@@ -1785,12 +1790,13 @@ package body Sem_Ch8 is
-- indicate that the renaming is an abstract dispatching operation
-- with a controlling type.
if Is_Actual and then Is_Abstract (Formal_Spec) then
if Is_Actual and then Is_Abstract_Subprogram (Formal_Spec) then
-- Mark the renaming as abstract here, so Find_Dispatching_Type
-- see it as corresponding to a generic association for a
-- formal abstract subprogram
Set_Is_Abstract (New_S);
Set_Is_Abstract_Subprogram (New_S);
declare
New_S_Ctrl_Type : constant Entity_Id :=
......@@ -1808,10 +1814,9 @@ package body Sem_Ch8 is
Set_Is_Dispatching_Operation (New_S);
Check_Controlling_Formals (New_S_Ctrl_Type, New_S);
-- In the case where the actual in the formal subprogram
-- is itself a formal abstract subprogram association,
-- there's no dispatch table component or position to
-- inherit.
-- If the actual in the formal subprogram is itself a
-- formal abstract subprogram association, there's no
-- dispatch table component or position to inherit.
if Present (DTC_Entity (Old_S)) then
Set_DTC_Entity (New_S, DTC_Entity (Old_S));
......@@ -1831,7 +1836,18 @@ package body Sem_Ch8 is
end if;
Set_Convention (New_S, Convention (Old_S));
Set_Is_Abstract (New_S, Is_Abstract (Old_S));
if Is_Abstract_Subprogram (Old_S) then
if Present (Rename_Spec) then
Error_Msg_N
("a renaming-as-body cannot rename an abstract subprogram",
N);
Set_Has_Completion (Rename_Spec);
else
Set_Is_Abstract_Subprogram (New_S);
end if;
end if;
Check_Library_Unit_Renaming (N, Old_S);
-- Pathological case: procedure renames entry in the scope of its
......@@ -1852,8 +1868,8 @@ package body Sem_Ch8 is
-- where the formal subprogram is also abstract.
if (Ekind (Old_S) = E_Procedure or else Ekind (Old_S) = E_Function)
and then Is_Abstract (Old_S)
and then not Is_Abstract (Formal_Spec)
and then Is_Abstract_Subprogram (Old_S)
and then not Is_Abstract_Subprogram (Formal_Spec)
then
Error_Msg_N
("abstract subprogram not allowed as generic actual", Nam);
......@@ -1874,7 +1890,6 @@ package body Sem_Ch8 is
declare
T : constant Entity_Id :=
Base_Type (Etype (First_Formal (New_S)));
begin
Error_Msg_Node_2 := Prefix (Nam);
Error_Msg_NE
......@@ -2008,7 +2023,6 @@ package body Sem_Ch8 is
-- Loop through package names to identify referenced packages
Pack_Name := First (Names (N));
while Present (Pack_Name) loop
Analyze (Pack_Name);
......@@ -2016,9 +2030,10 @@ package body Sem_Ch8 is
and then Nkind (Pack_Name) = N_Expanded_Name
then
declare
Pref : Node_Id := Prefix (Pack_Name);
Pref : Node_Id;
begin
Pref := Prefix (Pack_Name);
while Nkind (Pref) = N_Expanded_Name loop
Pref := Prefix (Pref);
end loop;
......@@ -2038,9 +2053,7 @@ package body Sem_Ch8 is
-- use visible.
Pack_Name := First (Names (N));
while Present (Pack_Name) loop
if Is_Entity_Name (Pack_Name) then
Pack := Entity (Pack_Name);
......@@ -2068,7 +2081,6 @@ package body Sem_Ch8 is
Next (Pack_Name);
end loop;
end Analyze_Use_Package;
----------------------
......@@ -2088,7 +2100,6 @@ package body Sem_Ch8 is
end if;
Id := First (Subtype_Marks (N));
while Present (Id) loop
Find_Type (Id);
......@@ -2173,7 +2184,6 @@ package body Sem_Ch8 is
else
Param_Spec := First (Parameter_Specifications (Spec));
while Present (Param_Spec) loop
Form_Num := Form_Num + 1;
......@@ -2248,7 +2258,6 @@ package body Sem_Ch8 is
-- Note that there is no Expr_List in this case anyway
if Aname = Name_AST_Entry then
declare
Ent : Entity_Id;
Decl : Node_Id;
......@@ -2288,7 +2297,6 @@ package body Sem_Ch8 is
-- Case of renaming a function
if Nkind (Spec) = N_Function_Specification then
if Is_Procedure_Attribute_Name (Aname) then
Error_Msg_N ("attribute can only be renamed as procedure", Nam);
return;
......@@ -2448,8 +2456,7 @@ package body Sem_Ch8 is
loop
if Nkind (Item) = N_With_Clause
-- Protect the frontend against previously reported
-- critical errors
-- Protect the frontend against previous critical errors
and then Nkind (Name (Item)) /= N_Selected_Component
and then Entity (Name (Item)) = Pack
......@@ -2549,7 +2556,6 @@ package body Sem_Ch8 is
begin
Id := First_Entity (Current_Scope);
while Present (Id) loop
-- An entity in the current scope is not necessarily the first one
-- on its homonym chain. Find its predecessor if any,
......@@ -2575,9 +2581,9 @@ package body Sem_Ch8 is
Prev := Empty;
end if;
Outer := Homonym (Id);
Set_Is_Immediately_Visible (Id, False);
Outer := Homonym (Id);
while Present (Outer) and then Scope (Outer) = Current_Scope loop
Outer := Homonym (Outer);
end loop;
......@@ -2692,7 +2698,6 @@ package body Sem_Ch8 is
F : Entity_Id) return Boolean
is
T : constant Entity_Id := Etype (F);
begin
return In_Use (T)
and then Scope (T) = Scope (Op);
......@@ -2702,20 +2707,18 @@ package body Sem_Ch8 is
begin
Pack_Name := First (Names (N));
while Present (Pack_Name) loop
Pack := Entity (Pack_Name);
if Ekind (Pack) = E_Package then
if In_Open_Scopes (Pack) then
null;
elsif not Redundant_Use (Pack_Name) then
Set_In_Use (Pack, False);
Set_Current_Use_Clause (Pack, Empty);
Id := First_Entity (Pack);
Id := First_Entity (Pack);
while Present (Id) loop
-- Preserve use-visibility of operators that are primitive
......@@ -2756,7 +2759,6 @@ package body Sem_Ch8 is
and then Present_System_Aux
then
Id := First_Entity (System_Aux_Id);
while Present (Id) loop
Set_Is_Potentially_Use_Visible (Id, False);
......@@ -2775,7 +2777,6 @@ package body Sem_Ch8 is
else
Set_Redundant_Use (Pack_Name, False);
end if;
end if;
Next (Pack_Name);
......@@ -2783,7 +2784,6 @@ package body Sem_Ch8 is
if Present (Hidden_By_Use_Clause (N)) then
Elmt := First_Elmt (Hidden_By_Use_Clause (N));
while Present (Elmt) loop
Set_Is_Immediately_Visible (Node (Elmt));
Next_Elmt (Elmt);
......@@ -2805,7 +2805,6 @@ package body Sem_Ch8 is
begin
Id := First (Subtype_Marks (N));
while Present (Id) loop
-- A call to rtsfind may occur while analyzing a use_type clause,
......@@ -2825,9 +2824,9 @@ package body Sem_Ch8 is
then
null;
-- Note that the use_Type clause may mention a subtype of the
-- type whose primitive operations have been made visible. Here
-- as elsewhere, it is the base type that matters for visibility.
-- Note that the use_Type clause may mention a subtype of the type
-- whose primitive operations have been made visible. Here as
-- elsewhere, it is the base type that matters for visibility.
elsif In_Open_Scopes (Scope (Base_Type (T))) then
null;
......@@ -2836,10 +2835,9 @@ package body Sem_Ch8 is
Set_In_Use (T, False);
Set_In_Use (Base_Type (T), False);
Op_List := Collect_Primitive_Operations (T);
Elmt := First_Elmt (Op_List);
Elmt := First_Elmt (Op_List);
while Present (Elmt) loop
if Nkind (Node (Elmt)) = N_Defining_Operator_Symbol then
Set_Is_Potentially_Use_Visible (Node (Elmt), False);
end if;
......@@ -2924,7 +2922,6 @@ package body Sem_Ch8 is
return False;
else
Inst := Current_Scope;
while Present (Inst)
and then Ekind (Inst) /= E_Package
and then not Is_Generic_Instance (Inst)
......@@ -2937,7 +2934,6 @@ package body Sem_Ch8 is
end if;
Act := First_Entity (Inst);
while Present (Act) loop
if Ekind (Act) = E_Package then
......@@ -3058,9 +3054,9 @@ package body Sem_Ch8 is
-- Find the sloc corresponding to the private with'ed unit
Comp_Unit := Cunit (Current_Sem_Unit);
Item := First (Context_Items (Comp_Unit));
Error_Msg_Sloc := No_Location;
Item := First (Context_Items (Comp_Unit));
while Present (Item) loop
if Nkind (Item) = N_With_Clause
and then Private_Present (Item)
......@@ -3088,7 +3084,6 @@ package body Sem_Ch8 is
Ent := Homonyms;
while Present (Ent) loop
if Is_Potentially_Use_Visible (Ent) then
if not Hidden then
Error_Msg_N ("multiple use clauses cause hiding!", N);
Hidden := True;
......@@ -3134,8 +3129,9 @@ package body Sem_Ch8 is
and then
Nkind (Parent (Parent (N))) = N_Use_Package_Clause
then
Error_Msg_NE
("\possible missing with_clause for&", N, Ent);
Error_Msg_Qual_Level := 99;
Error_Msg_NE ("\\missing `WITH &;`", N, Ent);
Error_Msg_Qual_Level := 0;
end if;
end if;
......@@ -3152,7 +3148,6 @@ package body Sem_Ch8 is
<<Continue>>
Ent := Homonym (Ent);
end loop;
end if;
end Nvis_Messages;
......@@ -3275,7 +3270,20 @@ package body Sem_Ch8 is
-- this is a very common error for beginners to make).
if Chars (N) = Name_Put or else Chars (N) = Name_Put_Line then
Error_Msg_N ("\possible missing with of 'Text_'I'O!", N);
Error_Msg_N
("\\possible missing `WITH Ada.Text_'I'O; " &
"USE Ada.Text_'I'O`!", N);
-- Another special check if N is the prefix of a selected
-- component which is a known unit, add message complaining
-- about missingw with for this unit.
elsif Nkind (Parent (N)) = N_Selected_Component
and then N = Prefix (Parent (N))
and then Is_Known_Unit (Parent (N))
then
Error_Msg_Node_2 := Selector_Name (Parent (N));
Error_Msg_N ("\\missing `WITH &.&;`", Prefix (Parent (N)));
end if;
-- Now check for possible misspellings
......@@ -3319,10 +3327,10 @@ package body Sem_Ch8 is
end;
end if;
-- Make entry in undefined references table unless the full
-- errors switch is set, in which case by refraining from
-- generating the table entry, we guarantee that we get an
-- error message for every undefined reference.
-- Make entry in undefined references table unless the full errors
-- switch is set, in which case by refraining from generating the
-- table entry, we guarantee that we get an error message for every
-- undefined reference.
if not All_Errors_Mode then
Urefs.Increment_Last;
......@@ -3440,7 +3448,6 @@ package body Sem_Ch8 is
begin
E2 := Homonym (E);
while Present (E2) loop
if Is_Immediately_Visible (E2) then
......@@ -3509,10 +3516,10 @@ package body Sem_Ch8 is
else
if In_Instance then
Inst := Current_Scope;
-- Find current instance
Inst := Current_Scope;
while Present (Inst)
and then Inst /= Standard_Standard
loop
......@@ -3524,7 +3531,6 @@ package body Sem_Ch8 is
end loop;
E2 := E;
while Present (E2) loop
if From_Actual_Package (E2)
or else
......@@ -3687,10 +3693,10 @@ package body Sem_Ch8 is
then
Premature_Usage (N);
-- If the entity is overloadable, collect all interpretations
-- of the name for subsequent overload resolution. We optimize
-- a bit here to do this only if we have an overloadable entity
-- that is not on its own on the homonym chain.
-- If the entity is overloadable, collect all interpretations of the
-- name for subsequent overload resolution. We optimize a bit here to
-- do this only if we have an overloadable entity that is not on its
-- own on the homonym chain.
elsif Is_Overloadable (E)
and then (Present (Homonym (E)) or else Current_Entity (N) /= E)
......@@ -3710,11 +3716,11 @@ package body Sem_Ch8 is
-- to the discriminant in the initialization procedure.
else
-- Entity is unambiguous, indicate that it is referenced here
-- One slightly odd case is that we do not want to set the
-- Referenced flag if the entity is a label, and the identifier
-- is the label in the source, since this is not a reference
-- from the point of view of the user
-- Entity is unambiguous, indicate that it is referenced here One
-- slightly odd case is that we do not want to set the Referenced
-- flag if the entity is a label, and the identifier is the label
-- in the source, since this is not a reference from the point of
-- view of the user
if Nkind (Parent (N)) = N_Label then
declare
......@@ -3731,11 +3737,10 @@ package body Sem_Ch8 is
Generate_Reference (E, N);
end if;
-- Set Entity, with style check if need be. If this is a
-- discriminant reference, it must be replaced by the
-- corresponding discriminal, that is to say the parameter
-- of the initialization procedure that corresponds to the
-- discriminant. If this replacement is being performed, there
-- Set Entity, with style check if need be. For a discriminant
-- reference, replace by the corresponding discriminal, i.e. the
-- parameter of the initialization procedure that corresponds to
-- the discriminant. If this replacement is being performed, there
-- is no style check to perform.
-- This replacement must not be done if we are currently
......@@ -3754,9 +3759,10 @@ package body Sem_Ch8 is
elsif Is_Concurrent_Type (Scope (E)) then
declare
P : Node_Id := Parent (N);
P : Node_Id;
begin
P := Parent (N);
while Present (P)
and then Nkind (P) /= N_Parameter_Specification
and then Nkind (P) /= N_Component_Declaration
......@@ -3946,12 +3952,15 @@ package body Sem_Ch8 is
if Present (Candidate) then
-- If we know that the unit is a child unit we can give a more
-- accurate error message.
if Is_Child_Unit (Candidate) then
-- If the candidate is a private child unit and we are
-- in the visible part of a public unit, specialize the
-- error message. There might be a private with_clause for
-- it, but it is not currently active.
-- If the candidate is a private child unit and we are in
-- the visible part of a public unit, specialize the error
-- message. There might be a private with_clause for it,
-- but it is not currently active.
if Is_Private_Descendant (Candidate)
and then Ekind (Current_Scope) = E_Package
......@@ -3960,19 +3969,26 @@ package body Sem_Ch8 is
then
Error_Msg_N ("private child unit& is not visible here",
Selector);
-- Normal case where we have a missing with for a child unit
else
Error_Msg_N
("missing with_clause for child unit &", Selector);
Error_Msg_Qual_Level := 99;
Error_Msg_NE ("missing `WITH &;`", Selector, Candidate);
Error_Msg_Qual_Level := 0;
end if;
-- Here we don't know that this is a child unit
else
Error_Msg_NE ("& is not a visible entity of&", N, Selector);
end if;
else
-- Within the instantiation of a child unit, the prefix may
-- denote the parent instance, but the selector has the
-- name of the original child. Find whether we are within
-- the corresponding instance, and get the proper entity, which
-- denote the parent instance, but the selector has the name
-- of the original child. Find whether we are within the
-- corresponding instance, and get the proper entity, which
-- can only be an enclosing scope.
if O_Name /= P_Name
......@@ -4009,15 +4025,16 @@ package body Sem_Ch8 is
end;
end if;
if Chars (P_Name) = Name_Ada
and then Scope (P_Name) = Standard_Standard
then
-- If this is a selection from Ada, System or Interfaces, then
-- we assume a missing with for the corresponding package.
if Is_Known_Unit (N) then
Error_Msg_Node_2 := Selector;
Error_Msg_NE ("missing with for `&.&`", N, P_Name);
Error_Msg_N ("missing `WITH &.&;`", Prefix (N));
-- If this is a selection from a dummy package, then
-- suppress the error message, of course the entity
-- is missing if the package is missing!
-- If this is a selection from a dummy package, then suppress
-- the error message, of course the entity is missing if the
-- package is missing!
elsif Sloc (Error_Msg_Node_2) = No_Location then
null;
......@@ -4025,7 +4042,6 @@ package body Sem_Ch8 is
-- Here we have the case of an undefined component
else
Error_Msg_NE ("& not declared in&", N, Selector);
-- Check for misspelling of some entity in prefix
......@@ -4060,9 +4076,8 @@ package body Sem_Ch8 is
and then Is_Compilation_Unit
(Generic_Parent (Parent (Entity (Prefix (N)))))
then
Error_Msg_NE
("\possible missing with clause on child unit&",
N, Selector);
Error_Msg_Node_2 := Selector;
Error_Msg_N ("\missing `WITH &.&;`", Prefix (N));
end if;
end if;
end if;
......@@ -4076,10 +4091,10 @@ package body Sem_Ch8 is
and then Is_Remote_Access_To_Subprogram_Type (Id)
and then Present (Equivalent_Type (Id))
then
-- If we are not actually generating distribution code (i.e.
-- the current PCS is the dummy non-distributed version), then
-- the Equivalent_Type will be missing, and Id should be treated
-- as a regular access-to-subprogram type.
-- If we are not actually generating distribution code (i.e. the
-- current PCS is the dummy non-distributed version), then the
-- Equivalent_Type will be missing, and Id should be treated as
-- a regular access-to-subprogram type.
Id := Equivalent_Type (Id);
Set_Chars (Selector, Chars (Id));
......@@ -4111,8 +4126,8 @@ package body Sem_Ch8 is
and then
Nkind (Parent (Parent (N))) /= N_Attribute_Reference))
then
-- It is an entry call after all, either to the current task
-- (which will deadlock) or to an enclosing task.
-- It is an entry call after all, either to the current task (which
-- will deadlock) or to an enclosing task.
Analyze_Selected_Component (N);
return;
......@@ -4121,8 +4136,8 @@ package body Sem_Ch8 is
Change_Selected_Component_To_Expanded_Name (N);
-- Do style check and generate reference, but skip both steps if this
-- entity has homonyms, since we may not have the right homonym set
-- yet. The proper homonym will be set during the resolve phase.
-- entity has homonyms, since we may not have the right homonym set yet.
-- The proper homonym will be set during the resolve phase.
if Has_Homonym (Id) then
Set_Entity (N, Id);
......@@ -4137,8 +4152,8 @@ package body Sem_Ch8 is
Set_Etype (N, Get_Full_View (Etype (Id)));
end if;
-- If the Ekind of the entity is Void, it means that all homonyms
-- are hidden from all visibility (RM 8.3(5,14-20)).
-- If the Ekind of the entity is Void, it means that all homonyms are
-- hidden from all visibility (RM 8.3(5,14-20)).
if Ekind (Id) = E_Void then
Premature_Usage (N);
......@@ -4163,8 +4178,8 @@ package body Sem_Ch8 is
H := Homonym (H);
end loop;
-- If an extension of System is present, collect possible
-- explicit overloadings declared in the extension.
-- If an extension of System is present, collect possible explicit
-- overloadings declared in the extension.
if Chars (P_Name) = Name_System
and then Scope (P_Name) = Standard_Standard
......@@ -4187,11 +4202,11 @@ package body Sem_Ch8 is
if Nkind (Selector_Name (N)) = N_Operator_Symbol
and then Scope (Id) /= Standard_Standard
then
-- In addition to user-defined operators in the given scope,
-- there may be an implicit instance of the predefined
-- operator. The operator (defined in Standard) is found
-- in Has_Implicit_Operator, and added to the interpretations.
-- Procedure Add_One_Interp will determine which hides which.
-- In addition to user-defined operators in the given scope, there
-- may be an implicit instance of the predefined operator. The
-- operator (defined in Standard) is found in Has_Implicit_Operator,
-- and added to the interpretations. Procedure Add_One_Interp will
-- determine which hides which.
if Has_Implicit_Operator (N) then
null;
......@@ -4224,24 +4239,23 @@ package body Sem_Ch8 is
-- to this enclosing instance, we know that the default was properly
-- resolved when analyzing the generic, so we prefer the local
-- candidates to those that are external. This is not always the case
-- but is a reasonable heuristic on the use of nested generics.
-- The proper solution requires a full renaming model.
-- but is a reasonable heuristic on the use of nested generics. The
-- proper solution requires a full renaming model.
function Is_Visible_Operation (Op : Entity_Id) return Boolean;
-- If the renamed entity is an implicit operator, check whether it is
-- visible because its operand type is properly visible. This
-- check applies to explicit renamed entities that appear in the
-- source in a renaming declaration or a formal subprogram instance,
-- but not to default generic actuals with a name.
-- visible because its operand type is properly visible. This check
-- applies to explicit renamed entities that appear in the source in a
-- renaming declaration or a formal subprogram instance, 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.
-- Determine whether a candidate subprogram is defined within the
-- enclosing instance. If yes, it has precedence over outer candidates.
------------------------
-- Enclosing_Instance --
......@@ -4258,9 +4272,7 @@ package body Sem_Ch8 is
end if;
S := Scope (Current_Scope);
while S /= Standard_Standard loop
if Is_Generic_Instance (S) then
return S;
end if;
......@@ -4335,9 +4347,10 @@ package body Sem_Ch8 is
------------
function Within (Inner, Outer : Entity_Id) return Boolean is
Sc : Entity_Id := Scope (Inner);
Sc : Entity_Id;
begin
Sc := Scope (Inner);
while Sc /= Standard_Standard loop
if Sc = Outer then
return True;
......@@ -4392,9 +4405,7 @@ package body Sem_Ch8 is
else
Get_First_Interp (Nam, Ind, It);
while Present (It.Nam) loop
if Entity_Matches_Spec (It.Nam, New_S)
and then Is_Visible_Operation (It.Nam)
then
......@@ -4407,17 +4418,13 @@ package body Sem_Ch8 is
It1 := Disambiguate (Nam, I1, Ind, Etype (Old_S));
if It1 = No_Interp then
Inst := Enclosing_Instance;
if Present (Inst) then
if Within (It.Nam, Inst) then
return (It.Nam);
elsif Within (Old_S, Inst) then
return (Old_S);
else
return Report_Overload;
end if;
......@@ -4476,10 +4483,10 @@ package body Sem_Ch8 is
if Nkind (P) = N_Error then
return;
-- If the selector already has an entity, the node has been
-- constructed in the course of expansion, and is known to be
-- valid. Do not verify that it is defined for the type (it may
-- be a private component used in the expansion of record equality).
-- If the selector already has an entity, the node has been constructed
-- in the course of expansion, and is known to be valid. Do not verify
-- that it is defined for the type (it may be a private component used
-- in the expansion of record equality).
elsif Present (Entity (Selector_Name (N))) then
......@@ -4566,7 +4573,6 @@ package body Sem_Ch8 is
declare
Typ : constant Entity_Id := Etype (N);
Decl : constant Node_Id := Declaration_Node (Typ);
begin
if Nkind (Decl) = N_Subtype_Declaration
and then not Analyzed (Decl)
......@@ -4660,9 +4666,7 @@ package body Sem_Ch8 is
begin
Get_First_Interp (P, Ind, It);
while Present (It.Nam) loop
if In_Open_Scopes (It.Nam) then
if Found then
Error_Msg_N (
......@@ -4690,16 +4694,15 @@ package body Sem_Ch8 is
else
-- If no interpretation as an expanded name is possible, it
-- must be a selected component of a record returned by a
-- function call. Reformat prefix as a function call, the
-- rest is done by type resolution. If the prefix is a
-- procedure or entry, as is P.X; this is an error.
-- function call. Reformat prefix as a function call, the rest
-- is done by type resolution. If the prefix is procedure or
-- entry, as is P.X; this is an error.
if Ekind (P_Name) /= E_Function
and then (not Is_Overloaded (P)
or else
Nkind (Parent (N)) = N_Procedure_Call_Statement)
then
-- Prefix may mention a package that is hidden by a local
-- declaration: let the user know. Scan the full homonym
-- chain, the candidate package may be anywhere on it.
......@@ -4824,9 +4827,9 @@ package body Sem_Ch8 is
T := Base_Type (Entity (Prefix (N)));
-- Case type is not known to be tagged. Its appearance in
-- the prefix of the 'Class attribute indicates that the full
-- view will be tagged.
-- Case type is not known to be tagged. Its appearance in the
-- prefix of the 'Class attribute indicates that the full view
-- will be tagged.
if not Is_Tagged_Type (T) then
if Ekind (T) = E_Incomplete_Type then
......@@ -4844,14 +4847,13 @@ package body Sem_Ch8 is
and then not Is_Generic_Type (T)
and then In_Private_Part (Scope (T))
then
-- The Class attribute can be applied to an untagged
-- private type fulfilled by a tagged type prior to
-- the full type declaration (but only within the
-- parent package's private part). Create the class-wide
-- type now and check that the full type is tagged
-- later during its analysis. Note that we do not
-- mark the private type as tagged, unlike the case
-- of incomplete types, because the type must still
-- The Class attribute can be applied to an untagged private
-- type fulfilled by a tagged type prior to the full type
-- declaration (but only within the parent package's private
-- part). Create the class-wide type now and check that the
-- full type is tagged later during its analysis. Note that
-- we do not mark the private type as tagged, unlike the
-- case of incomplete types, because the type must still
-- appear untagged to outside units.
if No (Class_Wide_Type (T)) then
......@@ -4862,8 +4864,8 @@ package body Sem_Ch8 is
Set_Etype (N, Class_Wide_Type (T));
else
-- Should we introduce a type Any_Tagged and use
-- Wrong_Type here, it would be a bit more consistent???
-- Should we introduce a type Any_Tagged and use Wrong_Type
-- here, it would be a bit more consistent???
Error_Msg_NE
("tagged type required, found}",
......@@ -5198,7 +5200,6 @@ package body Sem_Ch8 is
-- Start of processing for Has_Implicit_Operator
begin
if Ekind (P) = E_Package
and then not In_Open_Scopes (P)
then
......@@ -5214,9 +5215,7 @@ package body Sem_Ch8 is
-- array of Boolean type.
when Name_Op_And | Name_Op_Not | Name_Op_Or | Name_Op_Xor =>
while Id /= Priv_Id loop
if Valid_Boolean_Arg (Id)
and then Id = Base_Type (Id)
then
......@@ -5230,9 +5229,7 @@ package body Sem_Ch8 is
-- Equality: look for any non-limited type (result is Boolean)
when Name_Op_Eq | Name_Op_Ne =>
while Id /= Priv_Id loop
if Is_Type (Id)
and then not Is_Limited_Type (Id)
and then Id = Base_Type (Id)
......@@ -5247,7 +5244,6 @@ package body Sem_Ch8 is
-- Comparison operators: scalar type, or array of scalar
when Name_Op_Lt | Name_Op_Le | Name_Op_Gt | Name_Op_Ge =>
while Id /= Priv_Id loop
if (Is_Scalar_Type (Id)
or else (Is_Array_Type (Id)
......@@ -5271,7 +5267,6 @@ package body Sem_Ch8 is
Name_Op_Multiply |
Name_Op_Divide |
Name_Op_Expon =>
while Id /= Priv_Id loop
if Is_Numeric_Type (Id)
and then Id = Base_Type (Id)
......@@ -5286,7 +5281,6 @@ package body Sem_Ch8 is
-- Concatenation: any one-dimensional array type
when Name_Op_Concat =>
while Id /= Priv_Id loop
if Is_Array_Type (Id) and then Number_Dimensions (Id) = 1
and then Id = Base_Type (Id)
......@@ -5302,7 +5296,6 @@ package body Sem_Ch8 is
-- subtype of Name_Id that would restrict to operators ???
when others => null;
end case;
-- If we fall through, then we do not have an implicit operator
......@@ -5354,7 +5347,6 @@ package body Sem_Ch8 is
begin
if Ekind (Old_S) = E_Operator then
New_F := First_Formal (New_S);
while Present (New_F) loop
......@@ -5414,23 +5406,22 @@ package body Sem_Ch8 is
(Clause : Node_Id;
Force_Installation : Boolean := False)
is
U : Node_Id := Clause;
U : Node_Id;
P : Node_Id;
Id : Entity_Id;
begin
U := Clause;
while Present (U) loop
-- Case of USE package
if Nkind (U) = N_Use_Package_Clause then
P := First (Names (U));
while Present (P) loop
Id := Entity (P);
if Ekind (Id) = E_Package then
if In_Use (Id) then
Note_Redundant_Use (P);
......@@ -5448,11 +5439,10 @@ package body Sem_Ch8 is
Next (P);
end loop;
-- case of USE TYPE
-- Case of USE TYPE
else
P := First (Subtype_Marks (U));
while Present (P) loop
if not Is_Entity_Name (P)
or else No (Entity (P))
......@@ -5496,11 +5486,19 @@ package body Sem_Ch8 is
-- Determine if given type has components (i.e. is either a record
-- type or a type that has discriminants).
--------------------
-- Has_Components --
--------------------
function Has_Components (T1 : Entity_Id) return Boolean is
begin
return Is_Record_Type (T1)
or else (Is_Private_Type (T1) and then Has_Discriminants (T1))
or else (Is_Task_Type (T1) and then Has_Discriminants (T1));
or else (Is_Task_Type (T1) and then Has_Discriminants (T1))
or else (Is_Incomplete_Type (T1)
and then From_With_Type (T1)
and then Present (Non_Limited_View (T1))
and then Is_Record_Type (Non_Limited_View (T1)));
end Has_Components;
-- Start of processing for Is_Appropriate_For_Record
......@@ -5510,8 +5508,7 @@ package body Sem_Ch8 is
Present (T)
and then (Has_Components (T)
or else (Is_Access_Type (T)
and then
Has_Components (Designated_Type (T))));
and then Has_Components (Designated_Type (T))));
end Is_Appropriate_For_Record;
---------------
......@@ -5845,10 +5842,10 @@ package body Sem_Ch8 is
begin
-- Within an instance, the analysis of the actual for a formal object
-- does not see the name of the object itself. This is significant
-- only if the object is an aggregate, where its analysis does not do
-- any name resolution on component associations. (see 4717-008). In
-- such a case, look for the visible homonym on the chain.
-- does not see the name of the object itself. This is significant only
-- if the object is an aggregate, where its analysis does not do any
-- name resolution on component associations. (see 4717-008). In such a
-- case, look for the visible homonym on the chain.
if In_Instance
and then Present (Homonym (E))
......@@ -5907,7 +5904,7 @@ package body Sem_Ch8 is
The_Unit : Node_Id;
function Find_System (C_Unit : Node_Id) return Entity_Id;
-- Scan context clause of compilation unit to find a with_clause
-- Scan context clause of compilation unit to find with_clause
-- for System.
-----------------
......@@ -5919,7 +5916,6 @@ package body Sem_Ch8 is
begin
With_Clause := First (Context_Items (C_Unit));
while Present (With_Clause) loop
if (Nkind (With_Clause) = N_With_Clause
and then Chars (Name (With_Clause)) = Name_System)
......@@ -6007,14 +6003,13 @@ package body Sem_Ch8 is
System_Aux_Id :=
Defining_Entity (Specification (Unit (Cunit (Unum))));
Withn := Make_With_Clause (Loc,
Withn :=
Make_With_Clause (Loc,
Name =>
Make_Expanded_Name (Loc,
Chars => Chars (System_Aux_Id),
Prefix =>
New_Reference_To (Scope (System_Aux_Id), Loc),
Selector_Name =>
New_Reference_To (System_Aux_Id, Loc)));
Prefix => New_Reference_To (Scope (System_Aux_Id), Loc),
Selector_Name => New_Reference_To (System_Aux_Id, Loc)));
Set_Entity (Name (Withn), System_Aux_Id);
......@@ -6077,7 +6072,6 @@ package body Sem_Ch8 is
end if;
E := First_Entity (S);
while Present (E) loop
if Is_Child_Unit (E) then
Set_Is_Immediately_Visible (E,
......@@ -6097,9 +6091,7 @@ package body Sem_Ch8 is
-- must be restored in any case. Their declarations may appear
-- after the private part of the parent.
if not Full_Vis
and then Present (E)
then
if not Full_Vis then
while Present (E) loop
if Is_Child_Unit (E) then
Set_Is_Immediately_Visible (E,
......@@ -6171,9 +6163,9 @@ package body Sem_Ch8 is
End_Use_Clauses (Scope_Stack.Table (SS_Last).First_Use_Clause);
end if;
-- If the call is from within a compilation unit, as when
-- called from Rtsfind, make current entries in scope stack
-- invisible while we analyze the new unit.
-- If the call is from within a compilation unit, as when called from
-- Rtsfind, make current entries in scope stack invisible while we
-- analyze the new unit.
for J in reverse 0 .. SS_Last loop
exit when Scope_Stack.Table (J).Entity = Standard_Standard
......@@ -6181,8 +6173,8 @@ package body Sem_Ch8 is
S := Scope_Stack.Table (J).Entity;
Set_Is_Immediately_Visible (S, False);
E := First_Entity (S);
E := First_Entity (S);
while Present (E) loop
Set_Is_Immediately_Visible (E, False);
Next_Entity (E);
......@@ -6205,12 +6197,11 @@ package body Sem_Ch8 is
begin
if Present (L) then
Decl := First (L);
while Present (Decl) loop
if Nkind (Decl) = N_Use_Package_Clause then
Chain_Use_Clause (Decl);
Pack_Name := First (Names (Decl));
Pack_Name := First (Names (Decl));
while Present (Pack_Name) loop
Pack := Entity (Pack_Name);
......@@ -6225,8 +6216,8 @@ package body Sem_Ch8 is
elsif Nkind (Decl) = N_Use_Type_Clause then
Chain_Use_Clause (Decl);
Id := First (Subtype_Marks (Decl));
Id := First (Subtype_Marks (Decl));
while Present (Id) loop
if Entity (Id) /= Any_Type then
Use_One_Type (Id);
......@@ -6270,7 +6261,6 @@ package body Sem_Ch8 is
if In_Instance then
Current_Instance := Current_Scope;
while not Is_Generic_Instance (Current_Instance) loop
Current_Instance := Scope (Current_Instance);
end loop;
......@@ -6314,7 +6304,6 @@ package body Sem_Ch8 is
or else Private_With_OK) -- Ada 2005 (AI-262)
loop
Prev := Current_Entity (Id);
while Present (Prev) loop
if Is_Immediately_Visible (Prev)
and then (not Is_Overloadable (Prev)
......@@ -6327,13 +6316,12 @@ package body Sem_Ch8 is
goto Next_Usable_Entity;
-- A use clause within an instance hides outer global
-- entities, which are not used to resolve local entities
-- in the instance. Note that the predefined entities in
-- Standard could not have been hidden in the generic by
-- a use clause, and therefore remain visible. Other
-- compilation units whose entities appear in Standard must
-- be hidden in an instance.
-- A use clause within an instance hides outer global entities,
-- which are not used to resolve local entities in the
-- instance. Note that the predefined entities in Standard
-- could not have been hidden in the generic by a use clause,
-- and therefore remain visible. Other compilation units whose
-- entities appear in Standard must be hidden in an instance.
-- To determine whether an entity is external to the instance
-- we compare the scope depth of its scope with that of the
......@@ -6359,13 +6347,12 @@ package body Sem_Ch8 is
Append_Elmt (Prev, Hidden_By_Use_Clause (N));
end if;
-- A user-defined operator is not use-visible if the
-- predefined operator for the type is immediately visible,
-- which is the case if the type of the operand is in an open
-- scope. This does not apply to user-defined operators that
-- have operands of different types, because the predefined
-- mixed mode operations (multiplication and division) apply to
-- universal types and do not hide anything.
-- A user-defined operator is not use-visible if the predefined
-- operator for the type is immediately visible, which is the case
-- if the type of the operand is in an open scope. This does not
-- apply to user-defined operators that have operands of different
-- types, because the predefined mixed mode operations (multiply
-- and divide) apply to universal types and do not hide anything.
elsif Ekind (Prev) = E_Operator
and then Operator_Matches_Spec (Prev, Id)
......@@ -6401,11 +6388,10 @@ package body Sem_Ch8 is
Next_Entity (Id);
end loop;
-- Child units are also made use-visible by a use clause, but they
-- may appear after all visible declarations in the parent entity list.
-- Child units are also made use-visible by a use clause, but they may
-- appear after all visible declarations in the parent entity list.
while Present (Id) loop
if Is_Child_Unit (Id)
and then Is_Visible_Child_Unit (Id)
then
......@@ -6460,10 +6446,9 @@ package body Sem_Ch8 is
elsif not Redundant_Use (Id) then
Set_In_Use (T);
Op_List := Collect_Primitive_Operations (T);
Elmt := First_Elmt (Op_List);
Elmt := First_Elmt (Op_List);
while Present (Elmt) loop
if (Nkind (Node (Elmt)) = N_Defining_Operator_Symbol
or else Chars (Node (Elmt)) in Any_Operator_Name)
and then not Is_Hidden (Node (Elmt))
......@@ -6525,7 +6510,6 @@ package body Sem_Ch8 is
procedure Write_Scopes is
S : Entity_Id;
begin
for J in reverse 1 .. Scope_Stack.Last loop
S := Scope_Stack.Table (J).Entity;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment