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 --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 3d8b80239887b4f04744f7ed374c98972588844e..548fbede4f17d5673a6a566dc4a6a4dfb982a209 100644 (file)
--- 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 5dbf7198cb410b8e10a73f70ca0de1543ec10b20..452e11fc747e4c580394b3ef5c26a37443603291 100644 (file)
--- 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 b1d47f22416093e3cefe52d3eeda7dabfeeaf782..8479e8c4661c0c6e6d810262d2f5ca1d538cffd5 100644 (file)
--- 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))