diff mbox series

[Ada] Robust switching from incomplete to access types

Message ID 20210615102051.GA1967@adacore.com
State New
Headers show
Series [Ada] Robust switching from incomplete to access types | expand

Commit Message

Pierre-Marie de Rodat June 15, 2021, 10:20 a.m. UTC 
When processing an access type declaration that completes an incomplete
type, we now cleanly switch to a proper access type before setting the
designated type. This simplifies the previous ad-hoc machinery for error
recovery, which actually didn't work when the completion as an access
type referenced an unknown subtype name.

After cleaning code with transition from incomplete to access type, the
Directly_Designated_Type field is only needed for access type entities.

An access type declaration must be analysed before mutating the kind of
the type entity from incomplete to access type. The analysis happens
either directly in Analyse (which executed before mutating the kind) or
indirectly in Process_Subtype (which was executed after mutating the
kind).

Tested on x86_64-pc-linux-gnu, committed on trunk

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 mbox series

Patch

diff --git a/gcc/ada/gen_il-gen-gen_entities.adb b/gcc/ada/gen_il-gen-gen_entities.adb
--- 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
--- 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
--- 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);