https://gcc.gnu.org/g:2e28085cc3ec07dbf897c9b9f5c64a68cddd3d14
commit r15-1479-g2e28085cc3ec07dbf897c9b9f5c64a68cddd3d14
Author: Eric Botcazou <ebotca...@adacore.com>
Date: Tue May 14 22:06:17 2024 +0200
ada: Do not compute Has_Controlled_Component twice during freezing
The Has_Controlled_Component flag is computed twice during freezing when
expansion is enabled: in Freeze_Array_Type and Expand_Freeze_Array_Type
for array types, and in Freeze_Record_Type and Expand_Freeze_Record_Type
for record types.
This removes the latter computation in both cases, as well as moves the
computation of concurrent flags from the latter to the former places, which
happens to plug a loophole in the detection of errors when the No_Task_Parts
aspect is specified on peculiar types.
gcc/ada/
* exp_ch3.adb (Expand_Freeze_Array_Type): Do not propagate the
concurrent flags and the Has_Controlled_Component flag here.
(Expand_Freeze_Record_Type): Likewise.
* freeze.adb (Freeze_Array_Type): Propagate the concurrent flags.
(Freeze_Record_Type): Likewise.
* sem_util.adb (Has_Some_Controlled_Component): Adjust comment.
Diff:
---
gcc/ada/exp_ch3.adb | 38 --------------------------------------
gcc/ada/freeze.adb | 9 ++++++---
gcc/ada/sem_util.adb | 2 +-
3 files changed, 7 insertions(+), 42 deletions(-)
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 3d8b80239887..548fbede4f17 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -5431,17 +5431,6 @@ package body Exp_Ch3 is
begin
if not Is_Bit_Packed_Array (Typ) then
-
- -- If the component contains tasks, so does the array type. This may
- -- not be indicated in the array type because the component may have
- -- been a private type at the point of definition. Same if component
- -- type is controlled or contains protected objects.
-
- Propagate_Concurrent_Flags (Base, Comp_Typ);
- Set_Has_Controlled_Component
- (Base, Has_Controlled_Component (Comp_Typ)
- or else Is_Controlled (Comp_Typ));
-
if No (Init_Proc (Base)) then
-- If this is an anonymous array created for a declaration with
@@ -6123,8 +6112,6 @@ package body Exp_Ch3 is
Typ : constant Node_Id := Entity (N);
Typ_Decl : constant Node_Id := Parent (Typ);
- Comp : Entity_Id;
- Comp_Typ : Entity_Id;
Predef_List : List_Id;
Wrapper_Decl_List : List_Id;
@@ -6156,31 +6143,6 @@ package body Exp_Ch3 is
Check_Stream_Attributes (Typ);
end if;
- -- Update task, protected, and controlled component flags, because some
- -- of the component types may have been private at the point of the
- -- record declaration. Detect anonymous access-to-controlled components.
-
- Comp := First_Component (Typ);
- while Present (Comp) loop
- Comp_Typ := Etype (Comp);
-
- Propagate_Concurrent_Flags (Typ, Comp_Typ);
-
- -- Do not set Has_Controlled_Component on a class-wide equivalent
- -- type. See Make_CW_Equivalent_Type.
-
- if not Is_Class_Wide_Equivalent_Type (Typ)
- and then
- (Has_Controlled_Component (Comp_Typ)
- or else (Chars (Comp) /= Name_uParent
- and then Is_Controlled (Comp_Typ)))
- then
- Set_Has_Controlled_Component (Typ);
- end if;
-
- Next_Component (Comp);
- end loop;
-
-- Handle constructors of untagged CPP_Class types
if not Is_Tagged_Type (Typ) and then Is_CPP_Class (Typ) then
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 5dbf7198cb41..452e11fc747e 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -3661,7 +3661,9 @@ package body Freeze is
Set_SSO_From_Default (Arr);
- -- Propagate flags for component type
+ -- Propagate flags from component type
+
+ Propagate_Concurrent_Flags (Arr, Ctyp);
if Is_Controlled (Ctyp)
or else Has_Controlled_Component (Ctyp)
@@ -5684,11 +5686,12 @@ package body Freeze is
Freeze_And_Append (Corresponding_Remote_Type (Rec), N, Result);
end if;
- -- Check for controlled components, unchecked unions, and type
- -- invariants.
+ -- Check for tasks, protected and controlled components, unchecked
+ -- unions, and type invariants.
Comp := First_Component (Rec);
while Present (Comp) loop
+ Propagate_Concurrent_Flags (Rec, Etype (Comp));
-- Do not set Has_Controlled_Component on a class-wide
-- equivalent type. See Make_CW_Equivalent_Type.
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index b1d47f224160..8479e8c4661c 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -22259,7 +22259,7 @@ package body Sem_Util is
elsif Is_Record_Type (Input_Typ) then
Comp := First_Component (Input_Typ);
while Present (Comp) loop
- -- Skip _Parent component like Expand_Freeze_Record_Type
+ -- Skip _Parent component like Record_Type_Definition
if Chars (Comp) /= Name_uParent
and then Needs_Finalization (Etype (Comp))
