[gcc r12-1449] [Ada] Robust switching from incomplete to access types

[gcc r12-1449] [Ada] Robust switching from incomplete to access types

[Pierre-Marie de Rodat]

https://gcc.gnu.org/g:ed17bbe3c3ac0a5afd866030d88dce3f6d5a2730

commit r12-1449-ged17bbe3c3ac0a5afd866030d88dce3f6d5a2730
Author: Piotr Trojanek <trojanek@adacore.com>
Date:   Wed Feb 24 19:39:21 2021 +0100

    [Ada] Robust switching from incomplete to access types
    
    gcc/ada/
    
            * sem_ch3.adb (Access_Type_Declaration): Add comments to explain
            the ordering of Mutate_Kind and Set_Directly_Designated_Type;
            remove temporary setting of Ekind to E_Access_Type for building
            _master objects, since now the Ekind is already set to its final
            value. Move repeated code into Setup_Access_Type routine and use
            it so that Process_Subtype is executed before mutating the kind
            of the type entity.
            * gen_il-gen-gen_entities.adb (Gen_Entities): Remove
            Directly_Designated_Type from E_Void, E_Private_Record,
            E_Limited_Private_Type and Incomplete_Kind; now it only belongs
            to Access_Kind entities.
            * sem_util.adb: Minor reformatting.

Diff:
---
 gcc/ada/gen_il-gen-gen_entities.adb | 12 +++------
 gcc/ada/sem_ch3.adb                 | 54 ++++++++++++++++++++-----------------
 gcc/ada/sem_util.adb                |  8 +++---
 3 files changed, 36 insertions(+), 38 deletions(-)

diff --git a/gcc/ada/gen_il-gen-gen_entities.adb b/gcc/ada/gen_il-gen-gen_entities.adb
index edc108201c2..52cf72d0762 100644
--- a/gcc/ada/gen_il-gen-gen_entities.adb
+++ b/gcc/ada/gen_il-gen-gen_entities.adb
@@ -259,7 +259,6 @@ begin -- Gen_IL.Gen.Gen_Entities
         Sm (Corresponding_Remote_Type, Node_Id),
         Sm (CR_Discriminant, Node_Id),
         Sm (Debug_Renaming_Link, Node_Id),
-        Sm (Directly_Designated_Type, Node_Id),
         Sm (Discriminal_Link, Node_Id),
         Sm (Discriminant_Default_Value, Node_Id),
         Sm (Discriminant_Number, Uint),
@@ -824,10 +823,7 @@ begin -- Gen_IL.Gen.Gen_Entities
        (Sm (Direct_Primitive_Operations, Elist_Id,
             Pre => "Is_Tagged_Type (N)"),
         Sm (Scalar_Range, Node_Id),
-        Sm (Scope_Depth_Value, Uint),
-        Sm (Directly_Designated_Type, Node_Id)));
-   --  ????Directly_Designated_Type was allowed to be Set_, but not get.
-   --  Same for E_Limited_Private_Type. And incomplete.
+        Sm (Scope_Depth_Value, Uint)));
 
    Cc (E_Private_Subtype, Private_Kind,
        (Sm (Direct_Primitive_Operations, Elist_Id,
@@ -836,8 +832,7 @@ begin -- Gen_IL.Gen.Gen_Entities
 
    Cc (E_Limited_Private_Type, Private_Kind,
        (Sm (Scalar_Range, Node_Id),
-        Sm (Scope_Depth_Value, Uint),
-        Sm (Directly_Designated_Type, Node_Id)));
+        Sm (Scope_Depth_Value, Uint)));
 
    Cc (E_Limited_Private_Subtype, Private_Kind,
        (Sm (Scope_Depth_Value, Uint)));
@@ -845,8 +840,7 @@ begin -- Gen_IL.Gen.Gen_Entities
    Ab (Incomplete_Kind, Incomplete_Or_Private_Kind,
        (Sm (Direct_Primitive_Operations, Elist_Id,
             Pre => "Is_Tagged_Type (N)"),
-        Sm (Non_Limited_View, Node_Id),
-        Sm (Directly_Designated_Type, Node_Id)));
+        Sm (Non_Limited_View, Node_Id)));
 
    Cc (E_Incomplete_Type, Incomplete_Kind,
        (Sm (Scalar_Range, Node_Id)));
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 8306309e5b9..f67c40ed466 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -1326,36 +1326,48 @@ package body Sem_Ch3 is
    ----------------------------
 
    procedure Access_Type_Declaration (T : Entity_Id; Def : Node_Id) is
+
+      procedure Setup_Access_Type (Desig_Typ : Entity_Id);
+      --  After type declaration is analysed with T being an incomplete type,
+      --  this routine will mutate the kind of T to the appropriate access type
+      --  and set its directly designated type to Desig_Typ.
+
+      -----------------------
+      -- Setup_Access_Type --
+      -----------------------
+
+      procedure Setup_Access_Type (Desig_Typ : Entity_Id) is
+      begin
+         if All_Present (Def) or else Constant_Present (Def) then
+            Mutate_Ekind (T, E_General_Access_Type);
+         else
+            Mutate_Ekind (T, E_Access_Type);
+         end if;
+
+         Set_Directly_Designated_Type (T, Desig_Typ);
+      end Setup_Access_Type;
+
+      --  Local variables
+
       P : constant Node_Id := Parent (Def);
       S : constant Node_Id := Subtype_Indication (Def);
 
       Full_Desig : Entity_Id;
 
+   --  Start of processing for Access_Type_Declaration
+
    begin
       --  Check for permissible use of incomplete type
 
       if Nkind (S) /= N_Subtype_Indication then
+
          Analyze (S);
 
          if Nkind (S) in N_Has_Entity
            and then Present (Entity (S))
            and then Ekind (Root_Type (Entity (S))) = E_Incomplete_Type
          then
-            --  The following "if" prevents us from blowing up if the access
-            --  type is illegally completing something else.
-
-            if T in E_Void_Id
-                    | Access_Kind_Id
-                    | E_Private_Type_Id
-                    | E_Limited_Private_Type_Id
-                    | Incomplete_Kind_Id
-            then
-               Set_Directly_Designated_Type (T, Entity (S));
-
-            else
-               pragma Assert (Error_Posted (T));
-               return;
-            end if;
+            Setup_Access_Type (Desig_Typ => Entity (S));
 
             --  If the designated type is a limited view, we cannot tell if
             --  the full view contains tasks, and there is no way to handle
@@ -1366,13 +1378,12 @@ package body Sem_Ch3 is
             if From_Limited_With (Entity (S))
               and then not Is_Class_Wide_Type (Entity (S))
             then
-               Mutate_Ekind (T, E_Access_Type);
                Build_Master_Entity (T);
                Build_Master_Renaming (T);
             end if;
 
          else
-            Set_Directly_Designated_Type (T, Process_Subtype (S, P, T, 'P'));
+            Setup_Access_Type (Desig_Typ => Process_Subtype (S, P, T, 'P'));
          end if;
 
          --  If the access definition is of the form: ACCESS NOT NULL ..
@@ -1404,14 +1415,7 @@ package body Sem_Ch3 is
          end if;
 
       else
-         Set_Directly_Designated_Type (T,
-           Process_Subtype (S, P, T, 'P'));
-      end if;
-
-      if All_Present (Def) or Constant_Present (Def) then
-         Mutate_Ekind (T, E_General_Access_Type);
-      else
-         Mutate_Ekind (T, E_Access_Type);
+         Setup_Access_Type (Desig_Typ => Process_Subtype (S, P, T, 'P'));
       end if;
 
       if not Error_Posted (T) then
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index f523bbf28cd..73a7bd1b20e 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -24441,10 +24441,10 @@ package body Sem_Util is
                 (Chars (Related_Id), Suffix, Suffix_Index, Prefix));
 
    begin
-      Mutate_Ekind       (N, Kind);
-      Set_Is_Internal    (N, True);
-      Append_Entity      (N, Scope_Id);
-      Set_Public_Status  (N);
+      Mutate_Ekind      (N, Kind);
+      Set_Is_Internal   (N, True);
+      Append_Entity     (N, Scope_Id);
+      Set_Public_Status (N);
 
       if Kind in Type_Kind then
          Init_Size_Align (N);