[gcc r12-613] [Ada] Robust detection of access-to-subprogram and access-to-object types

[gcc r12-613] [Ada] Robust detection of access-to-subprogram and access-to-object types

[Pierre-Marie de Rodat]

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

commit r12-613-ga4613d9ada54c334650d93edbb4c08069550099e
Author: Piotr Trojanek <trojanek@adacore.com>
Date:   Tue Feb 23 23:37:50 2021 +0100

    [Ada] Robust detection of access-to-subprogram and access-to-object types
    
    gcc/ada/
    
            * einfo-utils.adb (Is_Access_Object_Type): Use
            Directly_Designated_Type.
            (Is_Access_Subprogram_Type): Use Directly_Designated_Type.
            (Set_Convention): Use plain Ekind.
            * gen_il-gen-gen_entities.adb (Type_Kind): Use plain Ekind.
            * sem_ch3.adb (Access_Type_Declaration): When seeing an illegal
            completion with an access type don't attempt to decorate the
            completion entity; previously the entity had its Ekind set to
            E_General_Access_Type or E_Access_Type, but its Designated_Type
            was empty, which caused a crash in freezing. (Actually, the
            error recovery in the surrounding context is still incomplete,
            e.g. we will crash when the illegal completion is an access to
            an unknown identifier).

Diff:
---
 gcc/ada/einfo-utils.adb             | 9 +++++----
 gcc/ada/gen_il-gen-gen_entities.adb | 2 +-
 gcc/ada/sem_ch3.adb                 | 5 ++++-
 3 files changed, 10 insertions(+), 6 deletions(-)

diff --git a/gcc/ada/einfo-utils.adb b/gcc/ada/einfo-utils.adb
index c16f55ef62d..f0dbf9c27d4 100644
--- a/gcc/ada/einfo-utils.adb
+++ b/gcc/ada/einfo-utils.adb
@@ -101,7 +101,8 @@ package body Einfo.Utils is
 
    function Is_Access_Object_Type               (Id : E) return B is
    begin
-      return Is_Access_Type (Id) and then not Is_Access_Subprogram_Type (Id);
+      return Is_Access_Type (Id)
+        and then Ekind (Directly_Designated_Type (Id)) /= E_Subprogram_Type;
    end Is_Access_Object_Type;
 
    function Is_Access_Type                      (Id : E) return B is
@@ -116,7 +117,8 @@ package body Einfo.Utils is
 
    function Is_Access_Subprogram_Type           (Id : E) return B is
    begin
-      return Ekind (Id) in Access_Subprogram_Kind;
+      return Is_Access_Type (Id)
+        and then Ekind (Directly_Designated_Type (Id)) = E_Subprogram_Type;
    end Is_Access_Subprogram_Type;
 
    function Is_Aggregate_Type                   (Id : E) return B is
@@ -2672,8 +2674,7 @@ package body Einfo.Utils is
    begin
       Set_Basic_Convention (E, Val);
 
-      if Is_Type (E)
-        and then Is_Access_Subprogram_Type (Base_Type (E))
+      if Ekind (E) in Access_Subprogram_Kind
         and then Has_Foreign_Convention (E)
       then
          Set_Can_Use_Internal_Rep (E, False);
diff --git a/gcc/ada/gen_il-gen-gen_entities.adb b/gcc/ada/gen_il-gen-gen_entities.adb
index fd75f588a82..edc108201c2 100644
--- a/gcc/ada/gen_il-gen-gen_entities.adb
+++ b/gcc/ada/gen_il-gen-gen_entities.adb
@@ -480,7 +480,7 @@ begin -- Gen_IL.Gen.Gen_Entities
        (Sm (Alignment, Uint),
         Sm (Associated_Node_For_Itype, Node_Id),
         Sm (Can_Use_Internal_Rep, Flag, Base_Type_Only,
-            Pre => "Is_Access_Subprogram_Type (Base_Type (N))"),
+            Pre => "Ekind (Base_Type (N)) in Access_Subprogram_Kind"),
         Sm (Class_Wide_Type, Node_Id),
         Sm (Contract, Node_Id),
         Sm (Current_Use_Clause, Node_Id),
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 5d97f1da619..8306309e5b9 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -1354,6 +1354,7 @@ package body Sem_Ch3 is
 
             else
                pragma Assert (Error_Posted (T));
+               return;
             end if;
 
             --  If the designated type is a limited view, we cannot tell if
@@ -6725,7 +6726,9 @@ package body Sem_Ch3 is
                               Has_Private_Component (Derived_Type));
       Conditional_Delay      (Derived_Type, Subt);
 
-      if Is_Access_Subprogram_Type (Derived_Type) then
+      if Is_Access_Subprogram_Type (Derived_Type)
+        and then Is_Base_Type (Derived_Type)
+      then
          Set_Can_Use_Internal_Rep
            (Derived_Type, Can_Use_Internal_Rep (Parent_Type));
       end if;