diff mbox series

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

Message ID 20210507093823.GA140847@adacore.com
State New
Headers show
Series [Ada] Robust detection of access-to-subprogram and access-to-object types | expand

Commit Message

Pierre-Marie de Rodat May 7, 2021, 9:38 a.m. UTC 
Routines Is_Access_Object_Type and Is_Access_Subprogram_Type were
arbitrarily categorizing E_Access_Subtype as an access-to-object, even
though it could represent an access-to-subprogram.

Now those routines examine not just the Ekind, but also the
Designated_Type of an access (sub)type, which is more reliable.

Only the handling of Can_Use_Internal_Rep and Convention flags need to
be adjusted, because they are set before the Designated_Type. However,
those flags are only set at base type anyway, so there is no problem
with E_Access_Subtype being wrongly recognized and we can safely rely on
the Ekind to detect access-to-subprograms.

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

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

Patch

diff --git a/gcc/ada/einfo-utils.adb b/gcc/ada/einfo-utils.adb
--- 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
--- 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
--- 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;