OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

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.

From-SVN: r252065
This commit is contained in:
Pierre-Marie de Rodat 2017-09-13 09:53:05 +00:00
parent caf3dcdf25
commit 0cb81445f4
12 changed files with 226 additions and 137 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
gcc/ada/ChangeLog
View File

@ -1,3 +1,56 @@
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.

2
gcc/ada/clean.adb
View File

@ -519,7 +519,7 @@ package body Clean is
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;

24
gcc/ada/einfo.adb
View File

@ -334,7 +334,7 @@ package body Einfo is
-- 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
@ -2189,10 +2189,10 @@ package body Einfo is
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
@ -5341,11 +5341,11 @@ package body Einfo is
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
@ -7902,14 +7902,14 @@ package body Einfo is
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 --
@ -9549,7 +9549,7 @@ package body Einfo is
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));

35
gcc/ada/einfo.ads
View File

@ -980,8 +980,9 @@ package Einfo is
-- 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
@ -2443,14 +2444,14 @@ package Einfo is
-- 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
@ -5648,7 +5649,7 @@ package Einfo is
-- 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)
@ -5684,7 +5685,7 @@ package Einfo is
-- 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)
@ -6344,7 +6345,7 @@ package Einfo is
-- 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)
@ -6497,7 +6498,7 @@ package Einfo is
-- 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)
@ -6526,7 +6527,7 @@ package Einfo is
-- 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)
@ -7169,7 +7170,7 @@ package Einfo is
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;
@ -7489,7 +7490,7 @@ package Einfo is
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;
@ -7858,7 +7859,7 @@ package Einfo is
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);
@ -8676,7 +8677,7 @@ package Einfo is
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);
@ -9190,7 +9191,7 @@ package Einfo is
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);
@ -9434,7 +9435,7 @@ package Einfo is
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);

2
gcc/ada/exp_ch3.adb
View File

@ -4951,7 +4951,7 @@ package body Exp_Ch3 is
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;

83
gcc/ada/exp_util.adb
View File

@ -10296,48 +10296,48 @@ package body Exp_Util is
-- 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
@ -10349,32 +10349,34 @@ package body Exp_Util is
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.
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
-- Class-wide types are treated as controlled because derivations
-- from the root type can introduce controlled components.
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;
@ -10387,7 +10389,6 @@ package body Exp_Util is
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

8
gcc/ada/exp_util.ads
View File

@ -924,11 +924,9 @@ package Exp_Util is
-- 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

4
gcc/ada/freeze.adb
View File

@ -2574,7 +2574,7 @@ package body Freeze is
-- 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);
@ -4508,7 +4508,7 @@ package body Freeze is
(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

96
gcc/ada/sem_ch13.adb
View File

@ -1595,6 +1595,9 @@ package body Sem_Ch13 is
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
@ -1678,6 +1681,60 @@ package body Sem_Ch13 is
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 --
----------------------------------
@ -3468,34 +3525,7 @@ package body Sem_Ch13 is
-- 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;
@ -10839,8 +10869,8 @@ package body Sem_Ch13 is
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.
@ -10867,7 +10897,7 @@ package body Sem_Ch13 is
-- 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)
@ -11003,7 +11033,7 @@ package body Sem_Ch13 is
-- 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
@ -11019,7 +11049,7 @@ package body Sem_Ch13 is
-- 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

52
gcc/ada/sem_ch3.adb
View File

@ -4848,7 +4848,7 @@ package body Sem_Ch3 is
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
@ -6157,7 +6157,7 @@ package body Sem_Ch3 is
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);
@ -6178,7 +6178,7 @@ package body Sem_Ch3 is
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);
@ -7897,18 +7897,21 @@ package body Sem_Ch3 is
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;
@ -9206,9 +9209,10 @@ package body Sem_Ch3 is
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
@ -9475,19 +9479,20 @@ package body Sem_Ch3 is
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
@ -21799,7 +21804,7 @@ package body Sem_Ch3 is
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.
@ -21859,8 +21864,7 @@ package body Sem_Ch3 is
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 :=

3
gcc/ada/sem_ch7.adb
View File

@ -2644,7 +2644,8 @@ package body Sem_Ch7 is
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

1
gcc/ada/sem_ch8.adb
View File

@ -6013,6 +6013,7 @@ package body Sem_Ch8 is
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;