]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
[Ada] Crash with declare expression used in a postcondition
authorArnaud Charlet <charlet@adacore.com>
Thu, 3 Dec 2020 15:06:47 +0000 (10:06 -0500)
committerPierre-Marie de Rodat <derodat@adacore.com>
Wed, 28 Apr 2021 09:38:04 +0000 (05:38 -0400)
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.

gcc/ada/sem_aux.adb
gcc/ada/sem_ch4.adb
gcc/ada/sem_res.adb

index 4925ffd36f00fd0b779f3db28a308d362d9abae2..3eddad9d814ff93c6b233cb6df5bb5868c7523ca 100644 (file)
@@ -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;
index 7a8c261ee4f898ff37cb1986f726ed7e401c66a4..ad6c7fddf9312b6a0eec77f430c7423f569fdec9 100644 (file)
@@ -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
index f6e0eab84b7e5cc230b6152a7a3425ebe7a51a03..39907aea2e77573fd94ffedf6428c4346afdb8af 100644 (file)
@@ -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