- ---------------------
- -- Is_Limited_View --
- ---------------------
-
- function Is_Limited_View (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
- declare
- Utyp : constant Entity_Id := Underlying_Type (Btype);
- begin
- if No (Utyp) then
- return False;
- else
- return Is_Limited_View (Utyp);
- end if;
- end;
- end if;
-
- elsif Is_Concurrent_Type (Btype) then
- return True;
-
- elsif Is_Record_Type (Btype) then
-
- -- Note that we return True for all limited interfaces, even though
- -- (unsynchronized) limited interfaces can have descendants that are
- -- nonlimited, because this is a predicate on the type itself, and
- -- things like functions with limited interface results need to be
- -- handled as build in place even though they might return objects
- -- of a type that is not inherently limited.
-
- if Is_Class_Wide_Type (Btype) then
- return Is_Limited_View (Root_Type (Btype));
-
- else
- declare
- C : Entity_Id;
-
- begin
- C := First_Component (Btype);
- while Present (C) loop
-
- -- Don't consider components with interface types (which can
- -- only occur in the case of a _parent component anyway).
- -- They don't have any components, plus it would cause this
- -- function to return true for nonlimited types derived from
- -- limited interfaces.
-
- if not Is_Interface (Etype (C))
- and then Is_Limited_View (Etype (C))
- then
- return True;
- end if;
-
- C := Next_Component (C);
- end loop;
- end;
-
- return False;
- end if;
-
- elsif Is_Array_Type (Btype) then
- return Is_Limited_View (Component_Type (Btype));
-
- else
- return False;
- end if;
- end Is_Limited_View;
-