Set_Etype (Nam, T);
end if;
- -- Complete analysis of the subtype mark in any case, for ASIS use.
+ -- Complete analysis of the subtype mark in any case, for ASIS use
if Present (Subtype_Mark (N)) then
Find_Type (Subtype_Mark (N));
and then not Is_Access_Constant (Etype (Nam))
then
Error_Msg_N ("(Ada 2005): the renamed object is not "
- & "access-to-constant ('R'M 8.5.1(6))", N);
+ & "access-to-constant (RM 8.5.1(6))", N);
end if;
end if;
Error_Node);
Error_Msg_Sloc := Sloc (N);
Error_Msg_N
- ("\because of renaming at# ('R'M 8.5.4(4))", Error_Node);
+ ("\because of renaming # (RM 8.5.4(4))", Error_Node);
-- Ada 2005 (AI-423): Otherwise, the subtype of the object name
-- shall exclude null.
and then not Has_Null_Exclusion (Subtyp_Decl)
then
Error_Msg_N
- ("`NOT NULL` required for subtype & ('R'M 8.5.1(4.6/2))",
+ ("`NOT NULL` required for subtype & (RM 8.5.1(4.6/2))",
Defining_Identifier (Subtyp_Decl));
end if;
end if;
Error_Msg_Sloc := Sloc (Hidden);
Error_Msg_N ("?default subprogram is resolved " &
"in the generic declaration " &
- "('R'M 12.6(17))", N);
+ "(RM 12.6(17))", N);
Error_Msg_NE ("\?and will not use & #", N, Hidden);
end if;
end;
return;
end if;
+ -- Find the renamed entity that matches the given specification. Disable
+ -- Ada_83 because there is no requirement of full conformance between
+ -- renamed entity and new entity, even though the same circuit is used.
+
+ -- This is a bit of a kludge, which introduces a really irregular use of
+ -- Ada_Version[_Explicit]. Would be nice to find cleaner way to do this
+ -- ???
+
+ Ada_Version := Ada_Version_Type'Max (Ada_Version, Ada_95);
+ Ada_Version_Explicit := Ada_Version;
+
+ if No (Old_S) then
+ Old_S := Find_Renamed_Entity (N, Name (N), New_S, Is_Actual);
+
+ -- When the renamed subprogram is overloaded and used as an actual
+ -- of a generic, its entity is set to the first available homonym.
+ -- We must first disambiguate the name, then set the proper entity.
+
+ if Is_Actual
+ and then Is_Overloaded (Nam)
+ then
+ Set_Entity (Nam, Old_S);
+ end if;
+ end if;
+
-- Most common case: subprogram renames subprogram. No body is generated
-- in this case, so we must indicate the declaration is complete as is.
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.
+ -- between a subprogram and its correct renaming.
- if Ada_Version >= Ada_05 then
+ -- Note: the Any_Id check is a guard that prevents compiler crashes
+ -- when performing a null exclusion check between a renaming and a
+ -- renamed subprogram that has been found to be illegal.
+
+ if Ada_Version >= Ada_05
+ and then Entity (Nam) /= Any_Id
+ then
Check_Null_Exclusion
(Ren => New_S,
Sub => Entity (Nam));
end if;
end if;
- -- Find the renamed entity that matches the given specification. Disable
- -- Ada_83 because there is no requirement of full conformance between
- -- renamed entity and new entity, even though the same circuit is used.
-
- -- This is a bit of a kludge, which introduces a really irregular use of
- -- Ada_Version[_Explicit]. Would be nice to find cleaner way to do this
- -- ???
-
- Ada_Version := Ada_Version_Type'Max (Ada_Version, Ada_95);
- Ada_Version_Explicit := Ada_Version;
-
- if No (Old_S) then
- Old_S := Find_Renamed_Entity (N, Name (N), New_S, Is_Actual);
- end if;
-
if Old_S /= Any_Id then
if Is_Actual
and then From_Default (N)
New_S, Old_S);
end if;
+ -- Another warning or some utility: if the new subprogram as the same
+ -- name as the old one, the old one is not hidden by an outer homograph,
+ -- the new one is not a public symbol, and the old one is otherwise
+ -- directly visible, the renaming is superfluous.
+
+ if Chars (Old_S) = Chars (New_S)
+ and then Comes_From_Source (N)
+ and then Scope (Old_S) /= Standard_Standard
+ and then Warn_On_Redundant_Constructs
+ and then
+ (Is_Immediately_Visible (Old_S)
+ or else Is_Potentially_Use_Visible (Old_S))
+ and then Is_Overloadable (Current_Scope)
+ and then Chars (Current_Scope) /= Chars (Old_S)
+ then
+ Error_Msg_N
+ ("?redundant renaming, entity is directly visible", Name (N));
+ end if;
+
Ada_Version := Save_AV;
Ada_Version_Explicit := Save_AV_Exp;
end Analyze_Subprogram_Renaming;
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List (
- Make_Return_Statement (Loc,
+ Make_Simple_Return_Statement (Loc,
Expression => Attr_Node))));
-- Case of renaming a procedure
-- undefined reference.
if not All_Errors_Mode then
- Urefs.Increment_Last;
- Urefs.Table (Urefs.Last).Node := N;
- Urefs.Table (Urefs.Last).Err := Emsg;
- Urefs.Table (Urefs.Last).Nvis := Nvis;
- Urefs.Table (Urefs.Last).Loc := Sloc (N);
+ Urefs.Append (
+ (Node => N,
+ Err => Emsg,
+ Nvis => Nvis,
+ Loc => Sloc (N)));
end if;
Msg := True;
-- to the discriminant in the initialization procedure.
else
- -- Entity is unambiguous, indicate that it is referenced here One
+ -- 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
Set_Referenced (E, R);
end;
- -- Normal case, not a label. Generate reference
+ -- Normal case, not a label: generate reference
+
+ -- ??? It is too early to generate a reference here even if
+ -- the entity is unambiguous, because the tree is not
+ -- sufficiently typed at this point for Generate_Reference to
+ -- determine whether this reference modifies the denoted object
+ -- (because implicit derefences cannot be identified prior to
+ -- full type resolution).
else
Generate_Reference (E, N);
-- 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
+ -- The non-limited view may itself be incomplete, in which case
+ -- get the full view if available.
elsif From_With_Type (Id)
and then Is_Type (Id)
and then Present (Non_Limited_View (Id))
and then Scope (Non_Limited_View (Id)) = P_Name
then
- Candidate := Non_Limited_View (Id);
+ Candidate := Get_Full_View (Non_Limited_View (Id));
Is_New_Candidate := True;
else
then
-- Selected component of record. Type checking will validate
-- name of selector.
+ -- ??? could we rewrite an implicit dereference into an explicit
+ -- one here?
Analyze_Selected_Component (N);
then
Error_Msg_N
("\dereference must not be of an incomplete type " &
- "('R'M 3.10.1)", P);
+ "(RM 3.10.1)", P);
end if;
else
elsif Nkind (N) = N_Attribute_Reference then
- -- Class attribute. This is only valid in Ada 95 mode, but we don't
- -- do a check, since the tagged type referenced could only exist if
- -- we were in 95 mode when it was declared (or, if we were in Ada
- -- 83 mode, then an error message would already have been issued).
+ -- Class attribute. This is not valid in Ada 83 mode, but we do not
+ -- need to enforce that at this point, since the declaration of the
+ -- tagged type in the prefix would have been flagged already.
if Attribute_Name (N) = Name_Class then
Check_Restriction (No_Dispatch, N);
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
+ -- Case where 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
-- It is legal to denote the class type of an incomplete
-- type. The full type will have to be tagged, of course.
+ -- In Ada2005 this usage is declared obsolescent, so we
+ -- warn accordingly.
+
+ -- ??? This test is temporarily disabled (always False)
+ -- because it causes an unwanted warning on GNAT sources
+ -- (built with -gnatg, which includes Warn_On_Obsolescent_
+ -- Feature). Once this issue is cleared in the sources, it
+ -- can be enabled.
+
+ if not Is_Tagged_Type (T)
+ and then Ada_Version >= Ada_05
+ and then Warn_On_Obsolescent_Feature
+ and then False
+ then
+ Error_Msg_N
+ ("applying 'Class to an untagged imcomplete type"
+ & " is an obsolescent feature (RM J.11)", N);
+ end if;
Set_Is_Tagged_Type (T);
Set_Primitive_Operations (T, New_Elmt_List);
if Nkind (Prefix (N)) = N_Expanded_Name then
Rewrite (N,
Make_Expanded_Name (Sloc (N),
- Chars => Chars (Entity (N)),
- Prefix => New_Copy (Prefix (Prefix (N))),
- Selector_Name =>
- New_Reference_To (Entity (N), Sloc (N))));
+ Chars => Chars (T),
+ Prefix => New_Copy (Prefix (Prefix (N))),
+ Selector_Name => New_Reference_To (T, Sloc (N))));
else
- Rewrite (N,
- New_Reference_To (Entity (N), Sloc (N)));
+ Rewrite (N, New_Reference_To (T, Sloc (N)));
end if;
Set_Entity (N, T);
Set_Entity (N, Any_Type);
else
+ -- If the type is an incomplete type created to handle
+ -- anonymous access components of a record type, then the
+ -- incomplete type is the visible entity and subsequent
+ -- references will point to it. Mark the original full
+ -- type as referenced, to prevent spurious warnings.
+
+ if Is_Incomplete_Type (T_Name)
+ and then Present (Full_View (T_Name))
+ and then not Comes_From_Source (T_Name)
+ then
+ Set_Referenced (Full_View (T_Name));
+ end if;
+
T_Name := Get_Full_View (T_Name);
+ -- Ada 2005 (AI-251, AI-50217): Handle interfaces visible through
+ -- limited-with clauses
+
+ if From_With_Type (T_Name)
+ and then Ekind (T_Name) in Incomplete_Kind
+ and then Present (Non_Limited_View (T_Name))
+ and then Is_Interface (Non_Limited_View (T_Name))
+ then
+ T_Name := Non_Limited_View (T_Name);
+ end if;
+
if In_Open_Scopes (T_Name) then
if Ekind (Base_Type (T_Name)) = E_Task_Type then
end if;
end Find_Type;
- -------------------
- -- Get_Full_View --
- -------------------
-
- function Get_Full_View (T_Name : Entity_Id) return Entity_Id is
- begin
- if Ekind (T_Name) = E_Incomplete_Type
- and then Present (Full_View (T_Name))
- then
- return Full_View (T_Name);
-
- elsif Is_Class_Wide_Type (T_Name)
- and then Ekind (Root_Type (T_Name)) = E_Incomplete_Type
- and then Present (Full_View (Root_Type (T_Name)))
- then
- return Class_Wide_Type (Full_View (Root_Type (T_Name)));
-
- else
- return T_Name;
- end if;
- end Get_Full_View;
-
------------------------------------
-- Has_Implicit_Character_Literal --
------------------------------------
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)));
+ and then Is_Record_Type
+ (Get_Full_View (Non_Limited_View (T1))));
end Has_Components;
-- Start of processing for Is_Appropriate_For_Record
end if;
Scope_Suppress := SST.Save_Scope_Suppress;
- Local_Entity_Suppress.Set_Last (SST.Save_Local_Entity_Suppress);
+ Local_Suppress_Stack_Top := SST.Save_Local_Suppress_Stack_Top;
if Debug_Flag_W then
Write_Str ("--> exiting scope: ");
SST : Scope_Stack_Entry renames Scope_Stack.Table (Scope_Stack.Last);
begin
- SST.Entity := S;
- SST.Save_Scope_Suppress := Scope_Suppress;
- SST.Save_Local_Entity_Suppress := Local_Entity_Suppress.Last;
+ SST.Entity := S;
+ SST.Save_Scope_Suppress := Scope_Suppress;
+ SST.Save_Local_Suppress_Stack_Top := Local_Suppress_Stack_Top;
if Scope_Stack.Last > Scope_Stack.First then
SST.Component_Alignment_Default := Scope_Stack.Table
-- appearing in context clauses.
procedure Find_Direct_Name (N : Node_Id);
- -- Given a direct name (Identifier or Operator_Symbol), this routine
- -- scans the homonym chain for the name searching for corresponding
- -- visible entities to find the referenced entity (or in the case of
- -- overloading), entities. On return, the Entity, and Etype fields
- -- are set. In the non-overloaded case, these are the correct final
- -- entries. In the overloaded case, Is_Overloaded is set, Etype and
- -- Entity refer to an arbitrary element of the overloads set, and
- -- an appropriate list of entries has been made in the overload
- -- interpretation table (to be disambiguated in the resolve phase).
+ -- Given a direct name (Identifier or Operator_Symbol), this routine scans
+ -- the homonym chain for the name searching for corresponding visible
+ -- entities to find the referenced entity (or in the case of overloading),
+ -- entities. On return, the Entity and Etype fields are set. In the
+ -- non-overloaded case, these are the correct final entries. In the
+ -- overloaded case, Is_Overloaded is set, Etype and Entity refer to an
+ -- arbitrary element of the overloads set, and an appropriate list of
+ -- entries has been made in the overload interpretation table (to be
+ -- disambiguated in the resolve phase).
procedure Find_Selected_Component (N : Node_Id);
-- Resolve various cases of selected components, recognize expanded names
-- Perform name resolution, and verify that the name found is that of a
-- type. On return the Entity and Etype fields of the node N are set
-- appropriately. If it is an incomplete type whose full declaration has
- -- been seen, they are set to the entity in the full declaration.
- -- Similarly, if the type is private, it has received a full declaration,
- -- and we are in the private part or body of the package, then the two
- -- fields are set to the entity of the full declaration as well. This
- -- procedure also provides special processing for Class types as well.
-
- function Get_Full_View (T_Name : Entity_Id) return Entity_Id;
- -- If T_Name is an incomplete type and the full declaration has been
- -- seen, or is the name of a class_wide type whose root is incomplete.
- -- return the corresponding full declaration.
+ -- been seen, they are set to the entity in the full declaration. If it
+ -- is an incomplete type associated with an interface visible through a
+ -- limited-with clause, whose full declaration has been seen, they are
+ -- set to the entity in the full declaration. Similarly, if the type is
+ -- private, it has received a full declaration, and we are in the private
+ -- part or body of the package, then the two fields are set to the entity
+ -- of the full declaration as well. This procedure also has special
+ -- processing for 'Class attribute references.
procedure Initialize;
-- Initializes data structures used for visibility analysis. Must be
projects / platform / upstream / linaro-gcc.git / commitdiff