-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- If this is first subtype, or is a base type, then there is no
-- ancestor subtype, so we return Empty to indicate this fact.
- if Is_First_Subtype (Typ) or else Typ = Base_Type (Typ) then
+ if Is_First_Subtype (Typ) or else Is_Base_Type (Typ) then
return Empty;
end if;
if No (S) then
return Standard_Standard;
- -- Quit if we get to standard or a dynamic scope
+ -- Quit if we get to standard or a dynamic scope. We must also
+ -- handle enclosing scopes that have a full view; required to
+ -- locate enclosing scopes that are synchronized private types
+ -- whose full view is a task type.
elsif S = Standard_Standard
or else Is_Dynamic_Scope (S)
+ or else (Is_Private_Type (S)
+ and then Present (Full_View (S))
+ and then Is_Dynamic_Scope (Full_View (S)))
then
return S;
-- The discriminants are not necessarily contiguous, because access
-- discriminants will generate itypes. They are not the first entities
- -- either, because tag and controller record must be ahead of them.
+ -- either because the tag must be ahead of them.
if Chars (Ent) = Name_uTag then
Ent := Next_Entity (Ent);
end if;
- if Chars (Ent) = Name_uController then
- Ent := Next_Entity (Ent);
- end if;
-
-- Skip all hidden stored discriminants if any
while Present (Ent) loop
Ent := Next_Entity (Ent);
end if;
- if Chars (Ent) = Name_uController then
- Ent := Next_Entity (Ent);
- end if;
-
if Has_Completely_Hidden_Discriminant (Ent) then
-
while Present (Ent) loop
exit when Is_Completely_Hidden (Ent);
Ent := Next_Entity (Ent);
end loop;
-
end if;
pragma Assert (Ekind (Ent) = E_Discriminant);
return Empty;
end First_Tag_Component;
+ -------------------------------
+ -- Initialization_Suppressed --
+ -------------------------------
+
+ function Initialization_Suppressed (Typ : Entity_Id) return Boolean is
+ begin
+ return Suppress_Initialization (Typ)
+ or else Suppress_Initialization (Base_Type (Typ));
+ end Initialization_Suppressed;
+
----------------
-- Initialize --
----------------
Btype : constant Entity_Id := Base_Type (Ent);
begin
- if Error_Posted (Ent)
- or else Error_Posted (Btype)
- then
+ if Error_Posted (Ent) or else Error_Posted (Btype) then
return False;
elsif Is_Private_Type (Btype) then
-------------------------------
function Is_Immutably_Limited_Type (Ent : Entity_Id) return Boolean is
- Btype : constant Entity_Id := Base_Type (Ent);
+ Btype : constant Entity_Id := Available_View (Base_Type (Ent));
begin
if Is_Limited_Record (Btype) then
and then Nkind (Parent (Btype)) = N_Formal_Type_Declaration
then
return not In_Package_Body (Scope ((Btype)));
- end if;
- if Is_Private_Type (Btype) then
+ 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.
-- 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 intefaces.
+ -- limited interfaces.
if not Is_Interface (Etype (C))
and then Is_Immutably_Limited_Type (Etype (C))