From: Arnaud Charlet <charlet@adacore.com>
Date: Thu, 3 Dec 2020 15:06:47 +0000 (-0500)
Subject: [Ada] Crash with declare expression used in a postcondition
X-Git-Tag: basepoints/gcc-13~8119
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=ff683f9f0341391253eef171890f1b98f18ec99d;p=thirdparty%2Fgcc.git

[Ada] Crash with declare expression used in a postcondition

gcc/ada/

	* sem_aux.adb (Is_Limited_Type): Fix logic to check Is_Type
	before assuming Ent is a typo.
	* sem_ch4.adb (Analyze_Expression_With_Actions): Update
	comments, minor reformatting.
	* sem_res.adb (Resolve_Declare_Expression): Add protection
	against no type.
---

diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb
index 4925ffd36f00..3eddad9d814f 100644
--- a/gcc/ada/sem_aux.adb
+++ b/gcc/ada/sem_aux.adb
@@ -1072,14 +1072,18 @@ package body Sem_Aux is
    ---------------------
 
    function Is_Limited_Type (Ent : Entity_Id) return Boolean is
-      Btype : constant E := Base_Type (Ent);
-      Rtype : constant E := Root_Type (Btype);
+      Btype : Entity_Id;
+      Rtype : Entity_Id;
 
    begin
       if not Is_Type (Ent) then
          return False;
+      end if;
 
-      elsif Ekind (Btype) = E_Limited_Private_Type
+      Btype := Base_Type (Ent);
+      Rtype := Root_Type (Btype);
+
+      if Ekind (Btype) = E_Limited_Private_Type
         or else Is_Limited_Composite (Btype)
       then
          return True;
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 7a8c261ee4f8..ad6c7fddf931 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -2278,9 +2278,12 @@ package body Sem_Ch4 is
    procedure Analyze_Expression_With_Actions (N : Node_Id) is
 
       procedure Check_Action_OK (A : Node_Id);
-      --  Check that the action is something that is allows as a declare_item
-      --  of a declare_expression, except the checks are suppressed for
-      --  generated code.
+      --  Check that the action A is allowed as a declare_item of a declare
+      --  expression if N and A come from source.
+
+      ---------------------
+      -- Check_Action_OK --
+      ---------------------
 
       procedure Check_Action_OK (A : Node_Id) is
       begin
@@ -2324,7 +2327,7 @@ package body Sem_Ch4 is
          Error_Msg_N ("object renaming or constant declaration expected", A);
       end Check_Action_OK;
 
-      A : Node_Id;
+      A        : Node_Id;
       EWA_Scop : Entity_Id;
 
    --  Start of processing for Analyze_Expression_With_Actions
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index f6e0eab84b7e..39907aea2e77 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -7494,6 +7494,7 @@ package body Sem_Res is
             Node := First (Actions (N));
             while Present (Node) loop
                if Nkind (Node) = N_Object_Declaration
+                 and then Is_Type (Etype (Defining_Identifier (Node)))
                  and then Requires_Transient_Scope
                             (Etype (Defining_Identifier (Node)))
                then