+2019-07-11 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_util.ads, exp_util.adb (Needs_Finalization): Move to
+ Sem_Util.
+ * sem_ch9.adb (Analyze_Protected_Definition): Code cleanup. Mark
+ the protected type as having controlled components when it
+ contains at least one such component.
+ * sem_util.ads, sem_util.adb (Needs_Finalization): New
+ function.
+
2019-07-11 Eric Botcazou <ebotcazou@adacore.com>
* alloc.ads (Rep_JSON_Table_Initial): New constant.
end if;
end Needs_Constant_Address;
- ------------------------
- -- Needs_Finalization --
- ------------------------
-
- 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
- (Input_Typ : Entity_Id) return Boolean
- is
- Comp : Entity_Id;
-
- begin
- -- 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;
-
- -- 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 Needs_Finalization (Etype (Comp)) then
- return True;
- end if;
-
- Next_Component (Comp);
- end loop;
- end if;
- end if;
-
- return False;
- end Has_Some_Controlled_Component;
-
- -- Start of processing for Needs_Finalization
-
- begin
- -- Certain run-time configurations and targets do not provide support
- -- for controlled types.
-
- 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.
-
- elsif Convention (Typ) = Convention_CPP then
- return False;
-
- -- Class-wide types are treated as controlled because derivations from
- -- the root type may introduce controlled components.
-
- elsif Is_Class_Wide_Type (Typ) then
- return True;
-
- -- 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
- return
- Is_Controlled (Typ) or else Has_Some_Controlled_Component (Typ);
- end if;
- end Needs_Finalization;
-
----------------------------
-- New_Class_Wide_Subtype --
----------------------------
Typ : Entity_Id;
begin
- if No (L)
- or else Is_Empty_List (L)
- then
+ if No (L) or else Is_Empty_List (L) then
return False;
end if;
-- consist of constants, when the object has a nontrivial initialization
-- or is controlled.
- 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
-- non-limited view is available during expansion, to examine components
----------------------------------
procedure Analyze_Protected_Definition (N : Node_Id) is
- E : Entity_Id;
- L : Entity_Id;
-
procedure Undelay_Itypes (T : Entity_Id);
-- Itypes created for the private components of a protected type
-- do not receive freeze nodes, because there is no scope in which
end if;
while Present (Comp) loop
- if Is_Type (Comp)
- and then Is_Itype (Comp)
- then
+ if Is_Type (Comp) and then Is_Itype (Comp) then
Set_Has_Delayed_Freeze (Comp, False);
Set_Is_Frozen (Comp);
Layout_Type (Comp);
end if;
- if Is_Record_Type (Comp)
- or else Is_Protected_Type (Comp)
- then
+ if Is_Record_Type (Comp) or else Is_Protected_Type (Comp) then
Undelay_Itypes (Comp);
end if;
end if;
end loop;
end Undelay_Itypes;
+ -- Local variables
+
+ Prot_Typ : constant Entity_Id := Current_Scope;
+ Item_Id : Entity_Id;
+ Last_Id : Entity_Id;
+
-- Start of processing for Analyze_Protected_Definition
begin
if Present (Private_Declarations (N))
and then not Is_Empty_List (Private_Declarations (N))
then
- L := Last_Entity (Current_Scope);
+ Last_Id := Last_Entity (Prot_Typ);
Analyze_Declarations (Private_Declarations (N));
- if Present (L) then
- Set_First_Private_Entity (Current_Scope, Next_Entity (L));
+ if Present (Last_Id) then
+ Set_First_Private_Entity (Prot_Typ, Next_Entity (Last_Id));
else
- Set_First_Private_Entity (Current_Scope,
- First_Entity (Current_Scope));
+ Set_First_Private_Entity (Prot_Typ, First_Entity (Prot_Typ));
end if;
end if;
- E := First_Entity (Current_Scope);
- while Present (E) loop
- if Ekind_In (E, E_Function, E_Procedure) then
- Set_Convention (E, Convention_Protected);
+ Item_Id := First_Entity (Prot_Typ);
+ while Present (Item_Id) loop
+ if Ekind_In (Item_Id, E_Function, E_Procedure) then
+ Set_Convention (Item_Id, Convention_Protected);
else
- Propagate_Concurrent_Flags (Current_Scope, Etype (E));
+ Propagate_Concurrent_Flags (Prot_Typ, Etype (Item_Id));
+
+ if Chars (Item_Id) /= Name_uParent
+ and then Needs_Finalization (Etype (Item_Id))
+ then
+ Set_Has_Controlled_Component (Prot_Typ);
+ end if;
end if;
- Next_Entity (E);
+ Next_Entity (Item_Id);
end loop;
- Undelay_Itypes (Current_Scope);
+ Undelay_Itypes (Prot_Typ);
Check_Max_Entries (N, Max_Protected_Entries);
- Process_End_Label (N, 'e', Current_Scope);
+ Process_End_Label (N, 'e', Prot_Typ);
end Analyze_Protected_Definition;
----------------------------------------
return Empty;
end Nearest_Enclosing_Instance;
+ ------------------------
+ -- Needs_Finalization --
+ ------------------------
+
+ 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
+ (Input_Typ : Entity_Id) return Boolean
+ is
+ Comp : Entity_Id;
+
+ begin
+ -- 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;
+
+ -- 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 Needs_Finalization (Etype (Comp)) then
+ return True;
+ end if;
+
+ Next_Component (Comp);
+ end loop;
+ end if;
+ end if;
+
+ return False;
+ end Has_Some_Controlled_Component;
+
+ -- Start of processing for Needs_Finalization
+
+ begin
+ -- Certain run-time configurations and targets do not provide support
+ -- for controlled types.
+
+ 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.
+
+ elsif Convention (Typ) = Convention_CPP then
+ return False;
+
+ -- Class-wide types are treated as controlled because derivations from
+ -- the root type may introduce controlled components.
+
+ elsif Is_Class_Wide_Type (Typ) then
+ return True;
+
+ -- 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
+ return
+ Is_Controlled (Typ) or else Has_Some_Controlled_Component (Typ);
+ end if;
+ end Needs_Finalization;
+
----------------------
-- Needs_One_Actual --
----------------------
-- Return the entity of the nearest enclosing instance which encapsulates
-- entity E. If no such instance exits, return Empty.
+ function Needs_Finalization (Typ : Entity_Id) return Boolean;
+ -- Determine whether type Typ is controlled and this requires finalization
+ -- actions.
+
function Needs_One_Actual (E : Entity_Id) return Boolean;
-- Returns True if a function has defaults for all but its first formal,
-- which is a controlling formal. Used in Ada 2005 mode to solve the
projects / gcc.git / commitdiff