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);