From: Piotr Trojanek <trojanek@adacore.com>
Date: Tue, 23 Feb 2021 22:37:50 +0000 (+0100)
Subject: [Ada] Robust detection of access-to-subprogram and access-to-object types
X-Git-Tag: upstream/12.2.0~8084
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=a4613d9ada54c334650d93edbb4c08069550099e;p=platform%2Fupstream%2Fgcc.git

[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 --git a/gcc/ada/einfo-utils.adb b/gcc/ada/einfo-utils.adb
index c16f55e..f0dbf9c 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 fd75f58..edc1082 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 5d97f1d..8306309 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;