-- Turn off subprogram ordering, not used for this unit
with Atree; use Atree;
+with Namet; use Namet;
with Nlists; use Nlists;
with Output; use Output;
with Sinfo; use Sinfo;
return Etype (Discrete_Subtype_Definition (Parent (Id)));
end Entry_Index_Type;
- -----------------
- -- Find_Pragma --
- -----------------
-
- function Find_Pragma (Id : Entity_Id; Name : Name_Id) return Node_Id is
- Item : Node_Id;
-
- begin
- Item := First_Rep_Item (Id);
- while Present (Item) loop
- if Nkind (Item) = N_Pragma and then Pragma_Name (Item) = Name then
- return Item;
- end if;
-
- Item := Next_Rep_Item (Item);
- end loop;
-
- return Empty;
- end Find_Pragma;
-
---------------------
-- First_Component --
---------------------
end if;
end Get_Full_View;
+ ----------------
+ -- Get_Pragma --
+ ----------------
+
+ function Get_Pragma (E : Entity_Id; Id : Pragma_Id) return Node_Id
+ is
+ N : Node_Id;
+
+ begin
+ N := First_Rep_Item (E);
+ while Present (N) loop
+ if Nkind (N) = N_Pragma
+ and then Get_Pragma_Id (Pragma_Name (N)) = Id
+ then
+ return N;
+ else
+ Next_Rep_Item (N);
+ end if;
+ end loop;
+
+ return Empty;
+ end Get_Pragma;
+
--------------------------------------
-- Get_Record_Representation_Clause --
--------------------------------------
-- --
------------------------------------------------------------------------------
-with Namet; use Namet;
with Snames; use Snames;
with Types; use Types;
with Uintp; use Uintp;
-- expression is deferred to the freeze point. For further details see
-- Sem_Ch13.Analyze_Aspect_Specifications.
- function Find_Pragma (Id : Entity_Id; Name : Name_Id) return Node_Id;
- -- Given entity Id and pragma name Name, attempt to find the corresponding
- -- pragma in Id's chain of representation items. The function returns Empty
- -- if no such pragma has been found.
-
function Get_Attribute_Definition_Clause
(E : Entity_Id;
Id : Attribute_Id) return Node_Id;
-- value returned is the N_Attribute_Definition_Clause node, otherwise
-- Empty is returned.
+ function Get_Pragma (E : Entity_Id; Id : Pragma_Id) return Node_Id;
+ -- Searches the Rep_Item chain for a given entity E, for an instance of
+ -- a pragma with the given pragma Id. If found, the value returned is the
+ -- N_Pragma node, otherwise Empty is returned.
+
function Get_Record_Representation_Clause (E : Entity_Id) return Node_Id;
-- Searches the Rep_Item chain for a given entity E, for a record
-- representation clause, and if found, returns it. Returns Empty
Check_For_Premature_Usage (T_Def);
- -- The return type and/or any parameter type may be incomplete. Mark
- -- the subprogram_type as depending on the incomplete type, so that
- -- it can be updated when the full type declaration is seen. This
- -- only applies to incomplete types declared in some enclosing scope,
- -- not to limited views from other packages.
+ -- The return type and/or any parameter type may be incomplete. Mark the
+ -- subprogram_type as depending on the incomplete type, so that it can
+ -- be updated when the full type declaration is seen. This only applies
+ -- to incomplete types declared in some enclosing scope, not to limited
+ -- views from other packages.
if Present (Formals) then
Formal := First_Formal (Desig_Type);
end loop;
end if;
- -- If the return type is incomplete, this is legal as long as the
- -- type is declared in the current scope and will be completed in
- -- it (rather than being part of limited view).
+ -- If the return type is incomplete, this is legal as long as the type
+ -- is declared in the current scope and will be completed in it (rather
+ -- than being part of limited view).
if Ekind (Etype (Desig_Type)) = E_Incomplete_Type
and then not Has_Delayed_Freeze (Desig_Type)
if Base_Type (Full_Desig) = T then
Error_Msg_N ("access type cannot designate itself", S);
- -- In Ada 2005, the type may have a limited view through some unit
- -- in its own context, allowing the following circularity that cannot
- -- be detected earlier
+ -- In Ada 2005, the type may have a limited view through some unit in
+ -- its own context, allowing the following circularity that cannot be
+ -- detected earlier
elsif Is_Class_Wide_Type (Full_Desig)
and then Etype (Full_Desig) = T
Set_Etype (T, T);
- -- If the type has appeared already in a with_type clause, it is
- -- frozen and the pointer size is already set. Else, initialize.
+ -- If the type has appeared already in a with_type clause, it is frozen
+ -- and the pointer size is already set. Else, initialize.
if not From_With_Type (T) then
Init_Size_Align (T);
Type_Scope := Scope (Base_Type (Scope (C)));
end if;
- -- For an untagged type derived from a private type, the only
- -- visible components are new discriminants.
+ -- For an untagged type derived from a private type, the only visible
+ -- components are new discriminants. In an instance all components are
+ -- visible (see Analyze_Selected_Component).
if not Is_Tagged_Type (Original_Scope) then
return not Has_Private_Ancestor (Original_Scope)
- or else In_Open_Scopes (Scope (Original_Scope))
- or else
- (Ekind (Original_Comp) = E_Discriminant
- and then Original_Scope = Type_Scope);
+ or else In_Open_Scopes (Scope (Original_Scope))
+ or else In_Instance
+ or else (Ekind (Original_Comp) = E_Discriminant
+ and then Original_Scope = Type_Scope);
-- If it is _Parent or _Tag, there is no visibility issue
and then Is_Local_Type (Type_Scope);
end if;
- -- There is another weird way in which a component may be invisible
- -- when the private and the full view are not derived from the same
- -- ancestor. Here is an example :
+ -- There is another weird way in which a component may be invisible when
+ -- the private and the full view are not derived from the same ancestor.
+ -- Here is an example :
-- type A1 is tagged record F1 : integer; end record;
-- type A2 is new A1 with record F2 : integer; end record;
projects / gcc.git / commitdiff