+2017-09-13 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * einfo.adb: Flag42 is now Is_Controlled_Active.
+ (Is_Controlled): This attribute is now synthesized.
+ (Is_Controlled_Active): This attribute is now an explicit flag rather
+ than a synthesized attribute. (Set_Is_Controlled): Removed.
+ (Set_Is_Controlled_Active): New routine.
+ (Write_Entity_Flags): Update the output for Flag42.
+ * einfo.ads: Update the documentation of the following attributes:
+ Disable_Controlled, Is_Controlled, Is_Controlled_Active, Is_Controlled
+ and Is_Controlled_Active have swapped their functionality.
+ (Is_Controlled): Renamed to Is_Controlled_Active.
+ (Is_Controlled_Active): Renamed to Is_Controlled.
+ (Set_Is_Controlled): Renamed to Set_Is_Controlled_Active.
+ * exp_ch3.adb (Expand_Freeze_Record_Type): Restore the original use of
+ Is_Controlled.
+ * exp_util.adb (Has_Some_Controlled_Component): Code clean up.
+ (Needs_Finalization): Code clean up. Remove the tests for
+ Disable_Controlled because a) they were incorrect as they would reject
+ a type which is sublect to the aspect, but may contain controlled
+ components, and b) they are no longer necessary.
+ * exp_util.ads (Needs_Finalization): Update comment on documentation.
+ * freeze.adb (Freeze_Array_Type): Restore the original use of
+ Is_Controlled.
+ (Freeze_Record_Type): Restore the original use of Is_Controlled.
+ * sem_ch3.adb (Analyze_Object_Declaration): Restore the original use of
+ Is_Controlled.
+ (Array_Type_Declaration): Restore the original use of Is_Controlled.
+ (Build_Derived_Private_Type): Restore the original use of
+ Is_Controlled.
+ (Build_Derived_Record_Type): Set the Is_Controlled_Active flag of a
+ type derived from Ada.Finalization.[Limited_]Controlled.
+ (Build_Derived_Type): Restore the original use of Is_Controlled.
+ (Record_Type_Definition): Restore the original use of Is_Controlled.
+ * sem_ch7.adb (Preserve_Full_Attributes): Restore the original use of
+ Is_Controlled.
+ * sem_ch13.adb (Analyze_Aspect_Disable_Controlled): New routine.
+ (Analyze_Aspect_Specifications): Use routine
+ Analyze_Aspect_Disable_Controlled to process aspect Disable_Controlled.
+
+2017-09-13 Vincent Celier <celier@adacore.com>
+
+ * clean.adb (Gnatclean): Fix error when looking for target
+ of <target>-gnatclean
+
+2017-09-13 Javier Miranda <miranda@adacore.com>
+ Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch8.adb (Find_Expanded_Name): Complete code that identifies an
+ expanded name that designates the current instance of a child unit in
+ its own body and appears as the prefix of a reference to an entity
+ local to the child unit.
+
2017-09-12 Bob Duff <duff@adacore.com>
* sem_warn.adb: Minor comment.
Find_Program_Name;
if Name_Len > 10
- and then Name_Buffer (Name_Len - 7 .. Name_Len) = "gnatclean"
+ and then Name_Buffer (Name_Len - 8 .. Name_Len) = "gnatclean"
then
Target := new String'(Name_Buffer (1 .. Name_Len - 9));
Arg_Len := Arg_Len + 1;
-- Body_Needed_For_SAL Flag40
-- Treat_As_Volatile Flag41
- -- Is_Controlled Flag42
+ -- Is_Controlled_Active Flag42
-- Has_Controlled_Component Flag43
-- Is_Pure Flag44
-- In_Private_Part Flag45
return Flag76 (Id);
end Is_Constructor;
- function Is_Controlled (Id : E) return B is
+ function Is_Controlled_Active (Id : E) return B is
begin
return Flag42 (Base_Type (Id));
- end Is_Controlled;
+ end Is_Controlled_Active;
function Is_Controlling_Formal (Id : E) return B is
begin
Set_Flag76 (Id, V);
end Set_Is_Constructor;
- procedure Set_Is_Controlled (Id : E; V : B := True) is
+ procedure Set_Is_Controlled_Active (Id : E; V : B := True) is
begin
pragma Assert (Id = Base_Type (Id));
Set_Flag42 (Id, V);
- end Set_Is_Controlled;
+ end Set_Is_Controlled_Active;
procedure Set_Is_Controlling_Formal (Id : E; V : B := True) is
begin
K = E_Constant or else K = E_In_Parameter or else K = E_Loop_Parameter;
end Is_Constant_Object;
- --------------------------
- -- Is_Controlled_Active --
- --------------------------
+ -------------------
+ -- Is_Controlled --
+ -------------------
- function Is_Controlled_Active (Id : E) return B is
+ function Is_Controlled (Id : E) return B is
begin
- return Is_Controlled (Id) and then not Disable_Controlled (Id);
- end Is_Controlled_Active;
+ return Is_Controlled_Active (Id) and then not Disable_Controlled (Id);
+ end Is_Controlled;
--------------------
-- Is_Discriminal --
W ("Is_Constr_Subt_For_U_Nominal", Flag80 (Id));
W ("Is_Constrained", Flag12 (Id));
W ("Is_Constructor", Flag76 (Id));
- W ("Is_Controlled", Flag42 (Id));
+ W ("Is_Controlled_Active", Flag42 (Id));
W ("Is_Controlling_Formal", Flag97 (Id));
W ("Is_Descendant_Of_Address", Flag223 (Id));
W ("Is_DIC_Procedure", Flag132 (Id));
-- incomplete type.
-- Disable_Controlled (Flag253)
--- Present in all entities. Set for a controlled type (Is_Controlled flag
--- set) if the aspect Disable_Controlled is active for the type.
+-- Present in all entities. Set for a controlled type subject to aspect
+-- Disable_Controlled which evaluates to True. This flag is taken into
+-- account in synthesized attribute Is_Controlled.
-- Discard_Names (Flag88)
-- Defined in types and exception entities. Set if pragma Discard_Names
-- Defined in function and procedure entities. Set if a pragma
-- CPP_Constructor applies to the subprogram.
--- Is_Controlled (Flag42) [base type only]
+-- Is_Controlled_Active (Flag42) [base type only]
-- Defined in all type entities. Indicates that the type is controlled,
-- i.e. is either a descendant of Ada.Finalization.Controlled or of
-- Ada.Finalization.Limited_Controlled.
--- Is_Controlled_Active (synth) [base type only]
--- Defined in all type entities. Set if Is_Controlled is set for the
--- type, and Disable_Controlled is not set.
+-- Is_Controlled (synth) [base type only]
+-- Defined in all type entities. Set if Is_Controlled_Active is set for
+-- the type, and Disable_Controlled is not set.
-- Is_Controlling_Formal (Flag97)
-- Defined in all Formal_Kind entities. Marks the controlling parameters
-- Is_Atomic (Flag85)
-- Is_Constr_Subt_For_U_Nominal (Flag80)
-- Is_Constr_Subt_For_UN_Aliased (Flag141)
- -- Is_Controlled (Flag42) (base type only)
+ -- Is_Controlled_Active (Flag42) (base type only)
-- Is_Eliminated (Flag124)
-- Is_Frozen (Flag4)
-- Is_Generic_Actual_Type (Flag94)
-- Invariant_Procedure (synth)
-- Is_Access_Protected_Subprogram_Type (synth)
-- Is_Atomic_Or_VFA (synth)
- -- Is_Controlled_Active (synth)
+ -- Is_Controlled (synth)
-- Partial_Invariant_Procedure (synth)
-- Predicate_Function (synth)
-- Predicate_Function_M (synth)
-- Private_View (Node22)
-- Stored_Constraint (Elist23)
-- Has_Completion (Flag26)
- -- Is_Controlled (Flag42) (base type only)
+ -- Is_Controlled_Active (Flag42) (base type only)
-- Is_For_Access_Subtype (Flag118) (subtype only)
-- (plus type attributes)
-- Is_Class_Wide_Equivalent_Type (Flag35)
-- Is_Concurrent_Record_Type (Flag20)
-- Is_Constrained (Flag12)
- -- Is_Controlled (Flag42) (base type only)
+ -- Is_Controlled_Active (Flag42) (base type only)
-- Is_Interface (Flag186)
-- Is_Limited_Interface (Flag197)
-- No_Reordering (Flag239) (base type only)
-- Has_Record_Rep_Clause (Flag65) (base type only)
-- Is_Concurrent_Record_Type (Flag20)
-- Is_Constrained (Flag12)
- -- Is_Controlled (Flag42) (base type only)
+ -- Is_Controlled_Active (Flag42) (base type only)
-- Is_Interface (Flag186)
-- Is_Limited_Interface (Flag197)
-- No_Reordering (Flag239) (base type only)
function Is_Constr_Subt_For_UN_Aliased (Id : E) return B;
function Is_Constrained (Id : E) return B;
function Is_Constructor (Id : E) return B;
- function Is_Controlled (Id : E) return B;
+ function Is_Controlled_Active (Id : E) return B;
function Is_Controlling_Formal (Id : E) return B;
function Is_CPP_Class (Id : E) return B;
function Is_Descendant_Of_Address (Id : E) return B;
function Is_Base_Type (Id : E) return B;
function Is_Boolean_Type (Id : E) return B;
function Is_Constant_Object (Id : E) return B;
- function Is_Controlled_Active (Id : E) return B;
+ function Is_Controlled (Id : E) return B;
function Is_Discriminal (Id : E) return B;
function Is_Dynamic_Scope (Id : E) return B;
function Is_External_State (Id : E) return B;
procedure Set_Is_Constr_Subt_For_UN_Aliased (Id : E; V : B := True);
procedure Set_Is_Constrained (Id : E; V : B := True);
procedure Set_Is_Constructor (Id : E; V : B := True);
- procedure Set_Is_Controlled (Id : E; V : B := True);
+ procedure Set_Is_Controlled_Active (Id : E; V : B := True);
procedure Set_Is_Controlling_Formal (Id : E; V : B := True);
procedure Set_Is_CPP_Class (Id : E; V : B := True);
procedure Set_Is_Descendant_Of_Address (Id : E; V : B := True);
pragma Inline (Is_Constr_Subt_For_UN_Aliased);
pragma Inline (Is_Constrained);
pragma Inline (Is_Constructor);
- pragma Inline (Is_Controlled);
+ pragma Inline (Is_Controlled_Active);
pragma Inline (Is_Controlling_Formal);
pragma Inline (Is_CPP_Class);
pragma Inline (Is_Decimal_Fixed_Point_Type);
pragma Inline (Set_Is_Constr_Subt_For_UN_Aliased);
pragma Inline (Set_Is_Constrained);
pragma Inline (Set_Is_Constructor);
- pragma Inline (Set_Is_Controlled);
+ pragma Inline (Set_Is_Controlled_Active);
pragma Inline (Set_Is_Controlling_Formal);
pragma Inline (Set_Is_CPP_Class);
pragma Inline (Set_Is_Descendant_Of_Address);
pragma Inline (Base_Type);
pragma Inline (Is_Base_Type);
- pragma Inline (Is_Controlled_Active);
+ pragma Inline (Is_Controlled);
pragma Inline (Is_Package_Or_Generic_Package);
pragma Inline (Is_Packed_Array);
pragma Inline (Is_Subprogram_Or_Generic_Subprogram);
and then
(Has_Controlled_Component (Comp_Typ)
or else (Chars (Comp) /= Name_uParent
- and then (Is_Controlled_Active (Comp_Typ))))
+ and then Is_Controlled (Comp_Typ)))
then
Set_Has_Controlled_Component (Typ);
end if;
-- Needs_Finalization --
------------------------
- function Needs_Finalization (T : Entity_Id) return Boolean is
- function Has_Some_Controlled_Component (Rec : Entity_Id) return Boolean;
- -- If type is not frozen yet, check explicitly among its components,
- -- because the Has_Controlled_Component flag is not necessarily set.
+ function Needs_Finalization (Typ : Entity_Id) return Boolean is
+ function Has_Some_Controlled_Component
+ (Input_Typ : Entity_Id) return Boolean;
+ -- Determine whether type Input_Typ has at least one controlled
+ -- component.
-----------------------------------
-- Has_Some_Controlled_Component --
-----------------------------------
function Has_Some_Controlled_Component
- (Rec : Entity_Id) return Boolean
+ (Input_Typ : Entity_Id) return Boolean
is
Comp : Entity_Id;
begin
- if Has_Controlled_Component (Rec) then
+ -- When a type is already frozen and has at least one controlled
+ -- component, or is manually decorated, it is sufficient to inspect
+ -- flag Has_Controlled_Component.
+
+ if Has_Controlled_Component (Input_Typ) then
return True;
- elsif not Is_Frozen (Rec) then
- if Is_Record_Type (Rec) then
- Comp := First_Entity (Rec);
+ -- Otherwise inspect the internals of the type
+
+ elsif not Is_Frozen (Input_Typ) then
+ if Is_Array_Type (Input_Typ) then
+ return Needs_Finalization (Component_Type (Input_Typ));
+ elsif Is_Record_Type (Input_Typ) then
+ Comp := First_Component (Input_Typ);
while Present (Comp) loop
- if not Is_Type (Comp)
- and then Needs_Finalization (Etype (Comp))
- then
+ if Needs_Finalization (Etype (Comp)) then
return True;
end if;
- Next_Entity (Comp);
+ Next_Component (Comp);
end loop;
-
- return False;
-
- else
- return
- Is_Array_Type (Rec)
- and then Needs_Finalization (Component_Type (Rec));
end if;
- else
- return False;
end if;
+
+ return False;
end Has_Some_Controlled_Component;
-- Start of processing for Needs_Finalization
if Restriction_Active (No_Finalization) then
return False;
- -- C++ types are not considered controlled. It is assumed that the
- -- non-Ada side will handle their clean up.
+ -- C++ types are not considered controlled. It is assumed that the non-
+ -- Ada side will handle their clean up.
- elsif Convention (T) = Convention_CPP then
+ elsif Convention (Typ) = Convention_CPP then
return False;
- -- Never needs finalization if Disable_Controlled set
+ -- Class-wide types are treated as controlled because derivations from
+ -- the root type may introduce controlled components.
- elsif Disable_Controlled (T) then
- return False;
+ elsif Is_Class_Wide_Type (Typ) then
+ return True;
- elsif Is_Class_Wide_Type (T) and then Disable_Controlled (Etype (T)) then
- return False;
+ -- Concurrent types are controlled as long as their corresponding record
+ -- is controlled.
- else
- -- Class-wide types are treated as controlled because derivations
- -- from the root type can introduce controlled components.
+ elsif Is_Concurrent_Type (Typ)
+ and then Present (Corresponding_Record_Type (Typ))
+ and then Needs_Finalization (Corresponding_Record_Type (Typ))
+ then
+ return True;
+
+ -- Otherwise the type is controlled when it is either derived from type
+ -- [Limited_]Controlled and not subject to aspect Disable_Controlled, or
+ -- contains at least one controlled component.
+ else
return
- Is_Class_Wide_Type (T)
- or else Is_Controlled (T)
- or else Has_Some_Controlled_Component (T)
- or else
- (Is_Concurrent_Type (T)
- and then Present (Corresponding_Record_Type (T))
- and then Needs_Finalization (Corresponding_Record_Type (T)));
+ Is_Controlled (Typ) or else Has_Some_Controlled_Component (Typ);
end if;
end Needs_Finalization;
Typ : Entity_Id) return Boolean
is
begin
-
-- If we have no initialization of any kind, then we don't need to place
-- any restrictions on the address clause, because the object will be
-- elaborated after the address clause is evaluated. This happens if the
-- consist of constants, when the object has a nontrivial initialization
-- or is controlled.
- function Needs_Finalization (T : Entity_Id) return Boolean;
- -- True if type T is controlled, or has controlled subcomponents. Also
- -- True if T is a class-wide type, because some type extension might add
- -- controlled subcomponents, except that if pragma Restrictions
- -- (No_Finalization) applies, this is False for class-wide types.
+ function Needs_Finalization (Typ : Entity_Id) return Boolean;
+ -- Determine whether type Typ is controlled and this requires finalization
+ -- actions.
function Non_Limited_Designated_Type (T : Entity_Id) return Entity_Id;
-- An anonymous access type may designate a limited view. Check whether
-- Propagate flags for component type
- if Is_Controlled_Active (Component_Type (Arr))
+ if Is_Controlled (Component_Type (Arr))
or else Has_Controlled_Component (Ctyp)
then
Set_Has_Controlled_Component (Arr);
(Has_Controlled_Component (Etype (Comp))
or else
(Chars (Comp) /= Name_uParent
- and then Is_Controlled_Active (Etype (Comp)))
+ and then Is_Controlled (Etype (Comp)))
or else
(Is_Protected_Type (Etype (Comp))
and then
procedure Analyze_Aspect_Convention;
-- Perform analysis of aspect Convention
+ procedure Analyze_Aspect_Disable_Controlled;
+ -- Perform analysis of aspect Disable_Controlled
+
procedure Analyze_Aspect_Export_Import;
-- Perform analysis of aspects Export or Import
end if;
end Analyze_Aspect_Convention;
+ ---------------------------------------
+ -- Analyze_Aspect_Disable_Controlled --
+ ---------------------------------------
+
+ procedure Analyze_Aspect_Disable_Controlled is
+ begin
+ -- The aspect applies only to controlled records
+
+ if not (Ekind (E) = E_Record_Type
+ and then Is_Controlled_Active (E))
+ then
+ Error_Msg_N
+ ("aspect % requires controlled record type", Aspect);
+ return;
+ end if;
+
+ -- Preanalyze the expression (if any) when the aspect resides
+ -- in a generic unit.
+
+ if Inside_A_Generic then
+ if Present (Expr) then
+ Preanalyze_And_Resolve (Expr, Any_Boolean);
+ end if;
+
+ -- Otherwise the aspect resides in a nongeneric context
+
+ else
+ -- A controlled record type loses its controlled semantics
+ -- when the expression statically evaluates to True.
+
+ if Present (Expr) then
+ Analyze_And_Resolve (Expr, Any_Boolean);
+
+ if Is_OK_Static_Expression (Expr) then
+ if Is_True (Static_Boolean (Expr)) then
+ Set_Disable_Controlled (E);
+ end if;
+
+ -- Otherwise the expression is not static
+
+ else
+ Error_Msg_N
+ ("expression of aspect % must be static", Aspect);
+ end if;
+
+ -- Otherwise the aspect appears without an expression and
+ -- defaults to True.
+
+ else
+ Set_Disable_Controlled (E);
+ end if;
+ end if;
+ end Analyze_Aspect_Disable_Controlled;
+
----------------------------------
-- Analyze_Aspect_Export_Import --
----------------------------------
-- Disable_Controlled
elsif A_Id = Aspect_Disable_Controlled then
- if Ekind (E) /= E_Record_Type
- or else not Is_Controlled (E)
- then
- Error_Msg_N
- ("aspect % requires controlled record type", Aspect);
- goto Continue;
- end if;
-
- -- If we're in a generic template, we don't want to try
- -- to disable controlled types, because typical usage is
- -- "Disable_Controlled => not <some_check>'Enabled", and
- -- the value of Enabled is not known until we see a
- -- particular instance. In such a context, we just need
- -- to preanalyze the expression for legality.
-
- if Expander_Active then
- Analyze_And_Resolve (Expr, Standard_Boolean);
-
- if not Present (Expr)
- or else Is_True (Static_Boolean (Expr))
- then
- Set_Disable_Controlled (E);
- end if;
-
- elsif Serious_Errors_Detected = 0 then
- Preanalyze_And_Resolve (Expr, Standard_Boolean);
- end if;
-
+ Analyze_Aspect_Disable_Controlled;
goto Continue;
end if;
E : constant Entity_Id := Entity (N);
- Non_Generic_Case : constant Boolean := Nkind (N) = N_Freeze_Entity;
- -- True in non-generic case. Some of the processing here is skipped
+ Nongeneric_Case : constant Boolean := Nkind (N) = N_Freeze_Entity;
+ -- True in nongeneric case. Some of the processing here is skipped
-- for the generic case since it is not needed. Basically in the
-- generic case, we only need to do stuff that might generate error
-- messages or warnings.
-- This is not needed in the generic case
if Ada_Version >= Ada_2005
- and then Non_Generic_Case
+ and then Nongeneric_Case
and then Ekind (E) = E_Record_Type
and then Is_Tagged_Type (E)
and then not Is_Interface (E)
-- predefined primitives.
if Is_Type (E)
- and then Non_Generic_Case
+ and then Nongeneric_Case
and then not Within_Internal_Subprogram
and then Has_Predicates (E)
then
-- This is also not needed in the generic case
- if Non_Generic_Case
+ if Nongeneric_Case
and then Has_Delayed_Aspects (E)
and then Scope (E) = Current_Scope
then
and then not Is_Constrained (Underlying_Type (T))
and then not Is_Aliased (Id)
and then not Is_Class_Wide_Type (T)
- and then not Is_Controlled_Active (T)
+ and then not Is_Controlled (T)
and then not Has_Controlled_Component (Base_Type (T))
and then Expander_Active
then
Set_Has_Controlled_Component
(Implicit_Base,
Has_Controlled_Component (Element_Type)
- or else Is_Controlled_Active (Element_Type));
+ or else Is_Controlled (Element_Type));
Set_Packed_Array_Impl_Type
(Implicit_Base, Empty);
Set_Has_Controlled_Component (T, Has_Controlled_Component
(Element_Type)
or else
- Is_Controlled_Active (Element_Type));
+ Is_Controlled (Element_Type));
Set_Finalize_Storage_Only (T, Finalize_Storage_Only
(Element_Type));
Set_Default_SSO (T);
Error_Msg_N ("cannot add discriminants to untagged type", N);
end if;
- Set_Stored_Constraint (Derived_Type, No_Elist);
- Set_Is_Constrained (Derived_Type, Is_Constrained (Parent_Type));
- Set_Is_Controlled (Derived_Type, Is_Controlled (Parent_Type));
- Set_Disable_Controlled (Derived_Type, Disable_Controlled
- (Parent_Type));
+ Set_Stored_Constraint (Derived_Type, No_Elist);
+ Set_Is_Constrained (Derived_Type, Is_Constrained (Parent_Type));
+
+ Set_Is_Controlled_Active
+ (Derived_Type, Is_Controlled_Active (Parent_Type));
+
+ Set_Disable_Controlled
+ (Derived_Type, Disable_Controlled (Parent_Type));
+
Set_Has_Controlled_Component
- (Derived_Type, Has_Controlled_Component
- (Parent_Type));
+ (Derived_Type, Has_Controlled_Component (Parent_Type));
-- Direct controlled types do not inherit Finalize_Storage_Only flag
- if not Is_Controlled_Active (Parent_Type) then
+ if not Is_Controlled (Parent_Type) then
Set_Finalize_Storage_Only
(Base_Type (Derived_Type), Finalize_Storage_Only (Parent_Type));
end if;
and then Chars (Scope (Scope (Derived_Type))) = Name_Ada
and then Scope (Scope (Scope (Derived_Type))) = Standard_Standard
then
- Set_Is_Controlled (Derived_Type);
+ Set_Is_Controlled_Active (Derived_Type);
else
- Set_Is_Controlled (Derived_Type, Is_Controlled (Parent_Base));
+ Set_Is_Controlled_Active
+ (Derived_Type, Is_Controlled_Active (Parent_Base));
end if;
-- Minor optimization: there is no need to generate the class-wide
begin
-- Set common attributes
- Set_Scope (Derived_Type, Current_Scope);
-
+ Set_Scope (Derived_Type, Current_Scope);
Set_Etype (Derived_Type, Parent_Base);
Set_Ekind (Derived_Type, Ekind (Parent_Base));
Propagate_Concurrent_Flags (Derived_Type, Parent_Base);
- Set_Size_Info (Derived_Type, Parent_Type);
- Set_RM_Size (Derived_Type, RM_Size (Parent_Type));
- Set_Is_Controlled (Derived_Type, Is_Controlled (Parent_Type));
- Set_Disable_Controlled (Derived_Type, Disable_Controlled (Parent_Type));
+ Set_Size_Info (Derived_Type, Parent_Type);
+ Set_RM_Size (Derived_Type, RM_Size (Parent_Type));
- Set_Is_Tagged_Type (Derived_Type, Is_Tagged_Type (Parent_Type));
- Set_Is_Volatile (Derived_Type, Is_Volatile (Parent_Type));
+ Set_Is_Controlled_Active
+ (Derived_Type, Is_Controlled_Active (Parent_Type));
+
+ Set_Disable_Controlled (Derived_Type, Disable_Controlled (Parent_Type));
+ Set_Is_Tagged_Type (Derived_Type, Is_Tagged_Type (Parent_Type));
+ Set_Is_Volatile (Derived_Type, Is_Volatile (Parent_Type));
if Is_Tagged_Type (Derived_Type) then
Set_No_Tagged_Streams_Pragma
end;
end if;
- Final_Storage_Only := not Is_Controlled_Active (T);
+ Final_Storage_Only := not Is_Controlled (T);
-- Ada 2005: Check whether an explicit Limited is present in a derived
-- type declaration.
elsif not Is_Class_Wide_Equivalent_Type (T)
and then (Has_Controlled_Component (Etype (Component))
or else (Chars (Component) /= Name_uParent
- and then Is_Controlled_Active
- (Etype (Component))))
+ and then Is_Controlled (Etype (Component))))
then
Set_Has_Controlled_Component (T, True);
Final_Storage_Only :=
end if;
if Priv_Is_Base_Type then
- Set_Is_Controlled (Priv, Is_Controlled (Full_Base));
+ Set_Is_Controlled_Active
+ (Priv, Is_Controlled_Active (Full_Base));
Set_Finalize_Storage_Only
(Priv, Finalize_Storage_Only (Full_Base));
Set_Has_Controlled_Component
and then Ekind (Scope (Id)) = E_Package
and then Ekind (Id) = E_Package
and then Renamed_Entity (Id) = Scope (Id)
+ and then Is_Immediately_Visible (P_Name)
then
Is_New_Candidate := True;
projects / gcc.git / commitdiff