-- cases where the renamed object is a dynamically tagged access
-- result, such as occurs in certain expansions.
- if (Is_Class_Wide_Type (Etype (Nam))
- or else (Is_Dynamically_Tagged (Nam)
- and then not Is_Access_Type (T)))
- and then not Is_Class_Wide_Type (T)
- then
- Error_Msg_N ("dynamically tagged expression not allowed!", Nam);
+ if Is_Tagged_Type (T) then
+ Check_Dynamically_Tagged_Expression
+ (Expr => Nam,
+ Typ => T,
+ Related_Nod => N);
end if;
-- Ada 2005 (AI-230/AI-254): Access renaming
end if;
end if;
- -- Special processing for renaming function return object
+ -- Special processing for renaming function return object. Some errors
+ -- and warnings are produced only for calls that come from source.
- if Nkind (Nam) = N_Function_Call
- and then Comes_From_Source (Nam)
- then
+ if Nkind (Nam) = N_Function_Call then
case Ada_Version is
-- Usage is illegal in Ada 83
when Ada_83 =>
- Error_Msg_N
- ("(Ada 83) cannot rename function return object", Nam);
+ if Comes_From_Source (Nam) then
+ Error_Msg_N
+ ("(Ada 83) cannot rename function return object", Nam);
+ end if;
-- In Ada 95, warn for odd case of renaming parameterless function
- -- call if this is not a limited type (where this is useful)
+ -- call if this is not a limited type (where this is useful).
when others =>
if Warn_On_Object_Renames_Function
and then No (Parameter_Associations (Nam))
and then not Is_Limited_Type (Etype (Nam))
+ and then Comes_From_Source (Nam)
then
Error_Msg_N
- ("?renaming function result object is suspicious",
- Nam);
+ ("?renaming function result object is suspicious", Nam);
Error_Msg_NE
- ("\?function & will be called only once",
- Nam, Entity (Name (Nam)));
+ ("\?function & will be called only once", Nam,
+ Entity (Name (Nam)));
Error_Msg_N
("\?suggest using an initialized constant object instead",
Nam);
end if;
+
+ -- If the function call returns an unconstrained type, we must
+ -- build a constrained subtype for the new entity, in a way
+ -- similar to what is done for an object declaration with an
+ -- unconstrained nominal type.
+
+ if Is_Composite_Type (Etype (Nam))
+ and then not Is_Constrained (Etype (Nam))
+ and then not Has_Unknown_Discriminants (Etype (Nam))
+ and then Expander_Active
+ then
+ declare
+ Loc : constant Source_Ptr := Sloc (N);
+ Subt : constant Entity_Id :=
+ Make_Defining_Identifier (Loc,
+ Chars => New_Internal_Name ('T'));
+ begin
+ Remove_Side_Effects (Nam);
+ Insert_Action (N,
+ Make_Subtype_Declaration (Loc,
+ Defining_Identifier => Subt,
+ Subtype_Indication =>
+ Make_Subtype_From_Expr (Nam, Etype (Nam))));
+ Rewrite (Subtype_Mark (N), New_Occurrence_Of (Subt, Loc));
+ Set_Etype (Nam, Subt);
+ end;
+ end if;
end case;
end if;
then
Error_Msg_NE ("invalid use of incomplete type&", Id, T2);
return;
+
elsif Ekind (Etype (T)) = E_Incomplete_Type then
Error_Msg_NE ("invalid use of incomplete type&", Id, T);
return;
and then Nkind (Nam) in N_Has_Entity
then
declare
- Nam_Decl : Node_Id;
- Nam_Ent : Entity_Id;
+ Nam_Decl : Node_Id;
+ Nam_Ent : Entity_Id;
begin
if Nkind (Nam) = N_Attribute_Reference then
Nam_Ent := Entity (Nam);
end if;
- Nam_Decl := Parent (Nam_Ent);
+ Nam_Decl := Parent (Nam_Ent);
if Has_Null_Exclusion (N)
and then not Has_Null_Exclusion (Nam_Decl)
-- have a null exclusion or a null-excluding subtype.
if Is_Formal_Object (Nam_Ent)
- and then In_Generic_Scope (Id)
+ and then In_Generic_Scope (Id)
then
if not Can_Never_Be_Null (Etype (Nam_Ent)) then
Error_Msg_N
-- of the renamed actual in the instance will raise
-- constraint_error.
- elsif Nkind (Parent (Nam_Ent)) = N_Object_Declaration
+ elsif Nkind (Nam_Decl) = N_Object_Declaration
and then In_Instance
and then Present
- (Corresponding_Generic_Association (Parent (Nam_Ent)))
- and then Nkind (Expression (Parent (Nam_Ent)))
+ (Corresponding_Generic_Association (Nam_Decl))
+ and then Nkind (Expression (Nam_Decl))
= N_Raise_Constraint_Error
then
Error_Msg_N
-- must not be null-excluding.
elsif No (Access_Definition (N))
- and then Can_Never_Be_Null (T)
+ and then Can_Never_Be_Null (T)
then
Error_Msg_NE
("`NOT NULL` not allowed (& already excludes null)",
then
Error_Msg_N
("illegal renaming of discriminant-dependent component", Nam);
- else
- null;
end if;
-- A static function call may have been folded into a literal
return;
end if;
- -- Apply Text_IO kludge here, since we may be renaming one of the
- -- children of Text_IO.
+ -- Apply Text_IO kludge here since we may be renaming a child of Text_IO
Text_IO_Kludge (Name (N));
end if;
if Etype (Old_P) = Any_Type then
- Error_Msg_N
- ("expect package name in renaming", Name (N));
+ Error_Msg_N ("expect package name in renaming", Name (N));
elsif Ekind (Old_P) /= E_Package
and then not (Ekind (Old_P) = E_Generic_Package
Inherit_Renamed_Profile (New_S, Old_S);
- -- The prefix can be an arbitrary expression that yields a task
- -- type, so it must be resolved.
+ -- The prefix can be an arbitrary expression that yields a task type,
+ -- so it must be resolved.
Resolve (Prefix (Nam), Scope (Old_S));
end if;
declare
F1 : Entity_Id;
F2 : Entity_Id;
+ T1 : Entity_Id;
begin
F1 := First_Formal (Candidate_Renaming);
F2 := First_Formal (New_S);
+ T1 := First_Subtype (Etype (F1));
while Present (F1) and then Present (F2) loop
Next_Formal (F1);
("\missing specification for &", Spec, F1);
end if;
end if;
+
+ if Nkind (Nam) = N_Operator_Symbol
+ and then From_Default (N)
+ then
+ Error_Msg_Node_2 := T1;
+ Error_Msg_NE
+ ("default & on & is not directly visible",
+ Nam, Nam);
+ end if;
end;
end if;
end if;
and then Etype (Pack) /= Any_Type
then
if Ekind (Pack) = E_Generic_Package then
- Error_Msg_N
+ Error_Msg_N -- CODEFIX
("a generic package is not allowed in a use clause",
Pack_Name);
else
- Error_Msg_N ("& is not a usable package", Pack_Name);
+ Error_Msg_N -- CODEFIX???
+ ("& is not a usable package", Pack_Name);
end if;
else
procedure Nvis_Messages is
Comp_Unit : Node_Id;
Ent : Entity_Id;
+ Found : Boolean := False;
Hidden : Boolean := False;
Item : Node_Id;
while Present (Ent) loop
if Is_Potentially_Use_Visible (Ent) then
if not Hidden then
- Error_Msg_N ("multiple use clauses cause hiding!", N);
+ Error_Msg_N -- CODEFIX
+ ("multiple use clauses cause hiding!", N);
Hidden := True;
end if;
Error_Msg_Sloc := Sloc (Ent);
- Error_Msg_N ("hidden declaration#!", N);
+ Error_Msg_N -- CODEFIX
+ ("hidden declaration#!", N);
end if;
Ent := Homonym (Ent);
if Is_Hidden (Ent) then
Error_Msg_N ("non-visible (private) declaration#!", N);
+
+ -- If the entity is declared in a generic package, it
+ -- cannot be visible, so there is no point in adding it
+ -- to the list of candidates if another homograph from a
+ -- non-generic package has been seen.
+
+ elsif Ekind (Scope (Ent)) = E_Generic_Package
+ and then Found
+ then
+ null;
+
else
- Error_Msg_N ("non-visible declaration#!", N);
+ Error_Msg_N -- CODEFIX
+ ("non-visible declaration#!", N);
+
+ if Ekind (Scope (Ent)) /= E_Generic_Package then
+ Found := True;
+ end if;
if Is_Compilation_Unit (Ent)
and then
end loop;
if Present (Ematch) then
- Error_Msg_NE ("\possible misspelling of&", N, Ematch);
+ Error_Msg_NE -- CODEFIX
+ ("\possible misspelling of&", N, Ematch);
end if;
end;
end if;
-- Here we have the case of an undefined component
else
- Error_Msg_NE ("& not declared in&", N, Selector);
+
+ -- The prefix may hide a homonym in the context that
+ -- declares the desired entity. This error can use a
+ -- specialized message.
+
+ if In_Open_Scopes (P_Name)
+ and then Present (Homonym (P_Name))
+ and then Is_Compilation_Unit (Homonym (P_Name))
+ and then
+ (Is_Immediately_Visible (Homonym (P_Name))
+ or else Is_Visible_Child_Unit (Homonym (P_Name)))
+ then
+ declare
+ H : constant Entity_Id := Homonym (P_Name);
+
+ begin
+ Id := First_Entity (H);
+ while Present (Id) loop
+ if Chars (Id) = Chars (Selector) then
+ Error_Msg_Qual_Level := 99;
+ Error_Msg_Name_1 := Chars (Selector);
+ Error_Msg_NE
+ ("% not declared in&", N, P_Name);
+ Error_Msg_NE
+ ("\use fully qualified name starting with"
+ & " Standard to make& visible", N, H);
+ Error_Msg_Qual_Level := 0;
+ exit;
+ end if;
+
+ Next_Entity (Id);
+ end loop;
+ end;
+
+ else
+ Error_Msg_NE ("& not declared in&", N, Selector);
+ end if;
-- Check for misspelling of some entity in prefix
if Is_Bad_Spelling_Of (Chars (Id), Chars (Selector))
and then not Is_Internal_Name (Chars (Id))
then
- Error_Msg_NE
+ Error_Msg_NE -- CODEFIX
("possible misspelling of&", Selector, Id);
exit;
end if;
Candidate_Renaming := Empty;
if not Is_Overloaded (Nam) then
- if Entity_Matches_Spec (Entity (Nam), New_S)
- and then Is_Visible_Operation (Entity (Nam))
- then
- Old_S := Entity (Nam);
+ if Entity_Matches_Spec (Entity (Nam), New_S) then
+ Candidate_Renaming := New_S;
+
+ if Is_Visible_Operation (Entity (Nam)) then
+ Old_S := Entity (Nam);
+ end if;
elsif
Present (First_Formal (Entity (Nam)))
if Ekind (Base_Type (T_Name)) = E_Task_Type then
-- In Ada 2005, a task name can be used in an access
- -- definition within its own body.
+ -- definition within its own body. It cannot be used
+ -- in the discriminant part of the task declaration,
+ -- nor anywhere else in the declaration because entries
+ -- cannot have access parameters.
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;
+
+ if Has_Completion (T_Name) then
+ return;
+
+ else
+ Error_Msg_N
+ ("task type cannot be used as type mark " &
+ "within its own declaration", N);
+ end if;
else
Error_Msg_N
-- we compare the scope depth of its scope with that of the
-- current instance. However, a generic actual of a subprogram
-- instance is declared in the wrapper package but will not be
- -- hidden by a use-visible entity.
+ -- hidden by a use-visible entity. Similarly, a generic actual
+ -- will not be hidden by an entity declared in another generic
+ -- actual, which can only have been use-visible in the generic.
+ -- Is this condition complete, and can the following complex
+ -- test be simplified ???
-- If Id is called Standard, the predefined package with the
-- same name is in the homonym chain. It has to be ignored
and then (Scope (Prev) /= Standard_Standard
or else Sloc (Prev) > Standard_Location)
then
- Set_Is_Potentially_Use_Visible (Id);
- Set_Is_Immediately_Visible (Prev, False);
- Append_Elmt (Prev, Hidden_By_Use_Clause (N));
+ if Ekind (Prev) = E_Package
+ and then Present (Associated_Formal_Package (Prev))
+ and then Present (Associated_Formal_Package (P))
+ then
+ null;
+
+ else
+ Set_Is_Potentially_Use_Visible (Id);
+ Set_Is_Immediately_Visible (Prev, False);
+ Append_Elmt (Prev, Hidden_By_Use_Clause (N));
+ end if;
end if;
-- A user-defined operator is not use-visible if the predefined
OSDN Git Service
