-- If component is limited, aggregate must be expanded because each
-- component assignment must be built in place.
- if Is_Limited_View (Component_Type (Typ)) then
+ if Is_Inherently_Limited_Type (Component_Type (Typ)) then
return False;
end if;
-- call will be generated by Make_Tag_Ctrl_Assignment).
if Needs_Finalization (Init_Typ)
- and then not Is_Limited_View (Init_Typ)
+ and then not Is_Inherently_Limited_Type (Init_Typ)
then
Set_No_Finalize_Actions (First (Assign));
else
-- Extension aggregates, aggregates in extended return statements, and
-- aggregates for C++ imported types must be expanded.
- elsif Ada_Version >= Ada_2005 and then Is_Limited_View (Typ) then
+ elsif Ada_Version >= Ada_2005
+ and then Is_Inherently_Limited_Type (Typ)
+ then
if Nkind (Parent (N)) not in
N_Component_Association | N_Object_Declaration
then
-- of their individual elements will receive an adjustment of its own.
if Finalization_OK
- and then not Is_Limited_View (Comp_Typ)
+ and then not Is_Inherently_Limited_Type (Comp_Typ)
and then not
(Is_Array_Type (Etype (N))
and then Is_Array_Type (Comp_Typ)
else pragma Assert (Is_Definite_Subtype (Typ)
or else (Has_Unknown_Discriminants (Typ)
- and then Is_Limited_View (Typ)));
+ and then Is_Inherently_Limited_Type (Typ)));
Alloc_Typ := Typ;
end if;
-- and attached to the finalization list.
if Needs_Finalization (Typ)
- and then not Is_Limited_View (Typ)
+ and then not Is_Inherently_Limited_Type (Typ)
then
Adj_Call :=
Make_Adjust_Call (
-- the object declaration into a renaming declaration.
if Needs_Finalization (Typ)
- and then not Is_Limited_View (Typ)
+ and then not Is_Inherently_Limited_Type (Typ)
and then Nkind (Expr_Q) /= N_Function_Call
and then not Rewrite_As_Renaming
then
if Needs_Finalization (DesigT)
and then Needs_Finalization (T)
- and then not Is_Limited_View (T)
+ and then not Is_Inherently_Limited_Type (T)
and then not Aggr_In_Place
and then Nkind (Exp) /= N_Function_Call
and then not For_Special_Return_Object (N)
Set_Enclosing_Sec_Stack_Return (N);
end if;
- elsif Is_Limited_View (R_Type) then
+ elsif Is_Inherently_Limited_Type (R_Type) then
null;
-- No copy needed for thunks returning interface type objects since
-- of a function with a limited interface result, where the function
-- may return objects of nonlimited descendants.
- return Is_Limited_View (Typ)
+ return Is_Inherently_Limited_Type (Typ)
and then Ada_Version >= Ada_2005
and then not Debug_Flag_Dot_L;
end Is_Build_In_Place_Result_Type;
Typ => Typ,
Stmts => Make_Deep_Array_Body (Initialize_Case, Typ)));
- if not Is_Limited_View (Typ) then
+ if not Is_Inherently_Limited_Type (Typ) then
Set_TSS (Typ,
Make_Deep_Proc
(Prim => Adjust_Case,
Typ => Typ,
Stmts => Make_Deep_Record_Body (Initialize_Case, Typ)));
- if not Is_Limited_View (Typ) then
+ if not Is_Inherently_Limited_Type (Typ) then
Set_TSS (Typ,
Make_Deep_Proc
(Prim => Adjust_Case,
-- function being called is build-in-place. This will have to be revised
-- when build-in-place functions are generalized to other types.
- elsif Is_Limited_View (Exp_Typ)
+ elsif Is_Inherently_Limited_Type (Exp_Typ)
and then
(Is_Class_Wide_Type (Exp_Typ)
or else Is_Interface (Exp_Typ)
if Ada_Version >= Ada_2005
and then Nkind (Exp) = N_Function_Call
- and then Is_Limited_View (Etype (Exp))
+ and then Is_Inherently_Limited_Type (Etype (Exp))
and then Nkind (Parent (Exp)) /= N_Object_Declaration
then
declare
-- limited objects.
if Present (Init)
- and then not Is_Limited_View (Typ)
+ and then not Is_Inherently_Limited_Type (Typ)
then
-- Capture initialization value at point of declaration, and make
-- explicit assignment legal, because object may be a constant.
-- be an array type, or a nonlimited record type).
if Has_Private_Declaration (E) then
- if (not Is_Record_Type (E) or else not Is_Limited_View (E))
+ if (not Is_Record_Type (E)
+ or else not Is_Inherently_Limited_Type (E))
and then not Is_Private_Type (E)
then
Error_Msg_Name_1 := Name_Simple_Storage_Pool_Type;
-- extensions, and maybe for nondiscriminated types.
-- This is wrong for limited, but those were wrong already.
- if not Is_Limited_View (A_Type)
+ if not Is_Inherently_Limited_Type (A_Type)
and then Is_Build_In_Place_Function_Call (A)
then
Transform_BIP_Assignment (A_Type);
-- Loop_Entry must create a constant initialized by the evaluated
-- prefix.
- if Is_Limited_View (Etype (P)) then
+ if Is_Inherently_Limited_Type (Etype (P)) then
Error_Attr_P ("prefix of attribute % cannot be limited");
end if;
then
Error_Attr_P ("prefix of attribute % must be a record or array");
- elsif Is_Limited_View (P_Type) then
+ elsif Is_Inherently_Limited_Type (P_Type) then
Error_Attr ("prefix of attribute % cannot be limited", N);
elsif Nkind (E1) /= N_Aggregate then
end if;
end Is_Generic_Formal;
- -------------------------------
- -- Is_Immutably_Limited_Type --
- -------------------------------
-
- function Is_Immutably_Limited_Type (Ent : Entity_Id) return Boolean is
- Btype : constant Entity_Id := Available_View (Base_Type (Ent));
-
- begin
- if Is_Limited_Record (Btype) then
- return True;
-
- elsif Ekind (Btype) = E_Limited_Private_Type
- and then Nkind (Parent (Btype)) = N_Formal_Type_Declaration
- then
- return not In_Package_Body (Scope ((Btype)));
-
- elsif Is_Private_Type (Btype) then
-
- -- AI05-0063: A type derived from a limited private formal type is
- -- not immutably limited in a generic body.
-
- if Is_Derived_Type (Btype)
- and then Is_Generic_Type (Etype (Btype))
- then
- if not Is_Limited_Type (Etype (Btype)) then
- return False;
-
- -- A descendant of a limited formal type is not immutably limited
- -- in the generic body, or in the body of a generic child.
-
- elsif Ekind (Scope (Etype (Btype))) = E_Generic_Package then
- return not In_Package_Body (Scope (Btype));
-
- else
- return False;
- end if;
-
- else
- return False;
- end if;
-
- elsif Is_Concurrent_Type (Btype) then
- return True;
-
- else
- return False;
- end if;
- end Is_Immutably_Limited_Type;
-
---------------------
-- Is_Limited_Type --
---------------------
end if;
end Is_Limited_Type;
- ---------------------
- -- Is_Limited_View --
- ---------------------
+ -------------------------------
+ -- Is_Immutably_Limited_Type --
+ -------------------------------
+
+ function Is_Immutably_Limited_Type (Ent : Entity_Id) return Boolean is
+ Btype : constant Entity_Id := Available_View (Base_Type (Ent));
+
+ begin
+ if Is_Limited_Record (Btype) then
+ return True;
+
+ elsif Ekind (Btype) = E_Limited_Private_Type
+ and then Nkind (Parent (Btype)) = N_Formal_Type_Declaration
+ then
+ return not In_Package_Body (Scope ((Btype)));
+
+ elsif Is_Private_Type (Btype) then
+
+ -- AI05-0063: A type derived from a limited private formal type is
+ -- not immutably limited in a generic body.
+
+ if Is_Derived_Type (Btype)
+ and then Is_Generic_Type (Etype (Btype))
+ then
+ if not Is_Limited_Type (Etype (Btype)) then
+ return False;
+
+ -- A descendant of a limited formal type is not immutably limited
+ -- in the generic body, or in the body of a generic child.
+
+ elsif Ekind (Scope (Etype (Btype))) = E_Generic_Package then
+ return not In_Package_Body (Scope (Btype));
+
+ else
+ return False;
+ end if;
+
+ else
+ return False;
+ end if;
+
+ elsif Is_Concurrent_Type (Btype) then
+ return True;
+
+ else
+ return False;
+ end if;
+ end Is_Immutably_Limited_Type;
+
+ --------------------------------
+ -- Is_Inherently_Limited_Type --
+ --------------------------------
- function Is_Limited_View (Ent : Entity_Id) return Boolean is
+ function Is_Inherently_Limited_Type (Ent : Entity_Id) return Boolean is
Btype : constant Entity_Id := Available_View (Base_Type (Ent));
begin
if No (Utyp) then
return False;
else
- return Is_Limited_View (Utyp);
+ return Is_Inherently_Limited_Type (Utyp);
end if;
end;
end if;
-- of a type that is not inherently limited.
if Is_Class_Wide_Type (Btype) then
- return Is_Limited_View (Root_Type (Btype));
+ return Is_Inherently_Limited_Type (Root_Type (Btype));
else
declare
-- limited interfaces.
if not Is_Interface (Etype (C))
- and then Is_Limited_View (Etype (C))
+ and then Is_Inherently_Limited_Type (Etype (C))
then
return True;
end if;
end if;
elsif Is_Array_Type (Btype) then
- return Is_Limited_View (Component_Type (Btype));
+ return Is_Inherently_Limited_Type (Component_Type (Btype));
else
return False;
end if;
- end Is_Limited_View;
+ end Is_Inherently_Limited_Type;
----------------------
-- Nearest_Ancestor --
-- used to set the visibility of generic formals of a generic package
-- declared with a box or with partial parameterization.
+ function Is_Limited_Type (Ent : Entity_Id) return Boolean;
+ -- Ent is any entity. Returns true if Ent is a limited type (limited
+ -- private type, limited interface type, task type, protected type,
+ -- composite containing a limited component, or a subtype of any of
+ -- these types). This older routine overlaps with the next ones, this
+ -- should be cleaned up???
+
function Is_Immutably_Limited_Type (Ent : Entity_Id) return Boolean;
-- Implements definition in Ada 2012 RM-7.5 (8.1/3). This differs from the
-- following predicate in that an untagged record with immutably limited
-- components is NOT by itself immutably limited. This matters, e.g. when
-- checking the legality of an access to the current instance.
- function Is_Limited_View (Ent : Entity_Id) return Boolean;
+ function Is_Inherently_Limited_Type (Ent : Entity_Id) return Boolean;
-- Ent is any entity. True for a type that is "inherently" limited (i.e.
-- cannot become nonlimited). From the Ada 2005 RM-7.5(8.1/2), "a type with
-- a part that is of a task, protected, or explicitly limited record type".
-- for other types, too. This is also used for identifying pure procedures
-- whose calls should not be eliminated (RM 10.2.1(18/2)).
- function Is_Limited_Type (Ent : Entity_Id) return Boolean;
- -- Ent is any entity. Returns true if Ent is a limited type (limited
- -- private type, limited interface type, task type, protected type,
- -- composite containing a limited component, or a subtype of any of
- -- these types). This older routine overlaps with the previous one, this
- -- should be cleaned up???
-
function Nearest_Ancestor (Typ : Entity_Id) return Entity_Id;
-- Given a subtype Typ, this function finds out the nearest ancestor from
-- which constraints and predicates are inherited. There is no simple link
-- or else be a partial view.
if Nkind (Discriminant_Type (D)) = N_Access_Definition then
- if Is_Limited_View (Current_Scope)
+ if Is_Inherently_Limited_Type (Current_Scope)
or else
(Nkind (Parent (Current_Scope)) = N_Private_Type_Declaration
and then Limited_Present (Parent (Current_Scope)))
-- get generated elsewhere.
if (Ada_Version < Ada_2005 or else Debug_Flag_Dot_L)
- and then Is_Limited_View (Etype (Scope_Id))
+ and then Is_Inherently_Limited_Type (Etype (Scope_Id))
and then Static_Accessibility_Level (Expr, Zero_On_Dynamic_Level)
> Subprogram_Access_Level (Scope_Id)
then
("(Ada 2005) cannot copy object of a limited type "
& "(RM-2005 6.5(5.5/2))", Expr);
- if Is_Limited_View (R_Type) then
+ if Is_Inherently_Limited_Type (R_Type) then
Error_Msg_N
("\return by reference not permitted in Ada 2005", Expr);
end if;
("return of limited object not permitted in Ada 2005 "
& "(RM-2005 6.5(5.5/2))?y?", Expr);
- elsif Is_Limited_View (R_Type) then
+ elsif Is_Inherently_Limited_Type (R_Type) then
Error_Msg_N
("return by reference not permitted in Ada 2005 "
& "(RM-2005 6.5(5.5/2))?y?", Expr);
-- there is no copy involved and no performance hit.
if Nkind (Nam) = N_Function_Call
- and then Is_Limited_View (Etype (Nam))
+ and then Is_Inherently_Limited_Type (Etype (Nam))
and then not Is_Constrained (Etype (Nam))
and then Comes_From_Source (N)
then
-- in Freeze_Entity).
if Is_Record_Type (Typ)
- and then not Is_Limited_View (Typ)
+ and then not Is_Inherently_Limited_Type (Typ)
then
Error_Pragma
("pragma% can only apply to explicitly limited record type");
-- of the current b-i-p implementation to unify the handling for
-- multiple kinds of storage pools). ???
- if Is_Limited_View (Desig_T)
+ if Is_Inherently_Limited_Type (Desig_T)
and then Nkind (Expression (E)) = N_Function_Call
then
declare
if Ada_Version >= Ada_2012
and then Is_Limited_Type (Desig_T)
- and then not Is_Limited_View (Scope (Discr))
+ and then not Is_Inherently_Limited_Type (Scope (Discr))
then
Error_Msg_N
("only immutably limited types can have anonymous "
return False;
end if;
- return Is_Definite_Subtype (T) and then Is_Limited_View (T);
+ return Is_Definite_Subtype (T) and then Is_Inherently_Limited_Type (T);
end Build_Default_Subtype_OK;
--------------------------------------------
-- In Ada 95, limited types are returned by reference, but not if the
-- convention is other than Ada.
- elsif Is_Limited_View (Typ)
+ elsif Is_Inherently_Limited_Type (Typ)
and then not Has_Foreign_Convention (Func)
then
Set_Returns_By_Ref (Func);
-- statement is aliased if its type is immutably limited.
or else (Is_Return_Object (E)
- and then Is_Limited_View (Etype (E)))
+ and then Is_Inherently_Limited_Type (Etype (E)))
-- The current instance of a limited type is aliased, so
-- we want to allow uses of T'Access in the init proc for
or else (Is_Formal (E)
and then Chars (E) = Name_uInit
- and then Is_Limited_View (Etype (E)));
+ and then Is_Inherently_Limited_Type (Etype (E)));
elsif Nkind (Obj) = N_Selected_Component then
return Is_Aliased (Entity (Selector_Name (Obj)));
begin
if Is_Record_Type (Typ)
- and then not Is_Limited_View (Typ)
+ and then not Is_Inherently_Limited_Type (Typ)
and then Has_Defaulted_Discriminants (Typ)
then
-- Loop through the components, looking for an array whose upper
projects / thirdparty / gcc.git / commitdiff
