[gcc/devel/c++-coroutines] [Ada] Fix failing assertions related to volatile objects

[gcc/devel/c++-coroutines] [Ada] Fix failing assertions related to volatile objects

[Iain D Sandoe]

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

commit eb6eb3b79aac8efe003861859e52d8e1680b120f
Author: Piotr Trojanek <trojanek@adacore.com>
Date:   Tue May 26 12:19:01 2020 +0200

    [Ada] Fix failing assertions related to volatile objects
    
    gcc/ada/
    
            * sem_ch3.adb (Process_Discriminants): Set Ekind of the
            processed discriminant entity before passing to
            Is_Effectively_Volatile, which was crashing on a failed
            assertion.
            * sem_prag.adb (Analyze_External_Property_In_Decl_Part): Prevent
            call to No_Caching_Enabled with entities other than variables,
            which was crashing on a failed assertion.
            (Analyze_Pragma): Style cleanups.
            * sem_util.adb (Is_Effectively_Volatile): Enforce comment with
            an assertion; prevent call to No_Caching_Enabled with entities
            other than variables.
            (Is_Effectively_Volatile_Object): Only call
            Is_Effectively_Volatile on objects, not on types.
            (No_Caching_Enabled): Enforce comment with an assertion.

Diff:
---
 gcc/ada/sem_ch3.adb  |  4 ++--
 gcc/ada/sem_prag.adb |  9 ++++++---
 gcc/ada/sem_util.adb | 10 +++++++---
 3 files changed, 15 insertions(+), 8 deletions(-)

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index c105f3c83e8..74946d3708b 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -19977,6 +19977,7 @@ package body Sem_Ch3 is
          end if;
 
          Set_Etype (Defining_Identifier (Discr), Discr_Type);
+         Set_Ekind (Defining_Identifier (Discr), E_Discriminant);
 
          --  If a discriminant specification includes the assignment compound
          --  delimiter followed by an expression, the expression is the default
@@ -20035,7 +20036,7 @@ package body Sem_Ch3 is
                  (Defining_Identifier (Discr), Expression (Discr));
             end if;
 
-            --  In gnatc or gnatprove mode, make sure set Do_Range_Check flag
+            --  In gnatc or GNATprove mode, make sure set Do_Range_Check flag
             --  gets set unless we can be sure that no range check is required.
 
             if not Expander_Active
@@ -20175,7 +20176,6 @@ package body Sem_Ch3 is
       Discr_Number := Uint_1;
       while Present (Discr) loop
          Id := Defining_Identifier (Discr);
-         Set_Ekind (Id, E_Discriminant);
          Init_Component_Location (Id);
          Init_Esize (Id);
          Set_Discriminant_Number (Id, Discr_Number);
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index db9c6119155..24053d54cc8 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -2122,7 +2122,9 @@ package body Sem_Prag is
       if Prag_Id /= Pragma_No_Caching
         and then not Is_Effectively_Volatile (Obj_Id)
       then
-         if No_Caching_Enabled (Obj_Id) then
+         if Ekind (Obj_Id) = E_Variable
+           and then No_Caching_Enabled (Obj_Id)
+         then
             SPARK_Msg_N
               ("illegal combination of external property % and property "
                & """No_Caching"" (SPARK RM 7.1.2(6))", N);
@@ -13363,7 +13365,7 @@ package body Sem_Prag is
             --  respective root types.
 
             if Nkind (Obj_Or_Type_Decl) /= N_Object_Declaration then
-               if (Prag_Id = Pragma_No_Caching)
+               if Prag_Id = Pragma_No_Caching
                   or not Nkind_In (Original_Node (Obj_Or_Type_Decl),
                                    N_Full_Type_Declaration,
                                    N_Private_Type_Declaration,
@@ -13383,7 +13385,8 @@ package body Sem_Prag is
             --  will be done at the end of the declarative region that
             --  contains the pragma.
 
-            if Ekind (Obj_Or_Type_Id) = E_Variable or Is_Type (Obj_Or_Type_Id)
+            if Ekind (Obj_Or_Type_Id) = E_Variable
+              or else Is_Type (Obj_Or_Type_Id)
             then
 
                --  In the case of a type, pragma is a type-related
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index f7a7c1fb431..b88f6f7fb3c 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -15651,12 +15651,14 @@ package body Sem_Util is
 
       --  Otherwise Id denotes an object
 
-      else
+      else pragma Assert (Is_Object (Id));
          --  A volatile object for which No_Caching is enabled is not
          --  effectively volatile.
 
          return
-           (Is_Volatile (Id) and then not No_Caching_Enabled (Id))
+           (Is_Volatile (Id)
+            and then not
+              (Ekind (Id) = E_Variable and then No_Caching_Enabled (Id)))
              or else Has_Volatile_Components (Id)
              or else Is_Effectively_Volatile (Etype (Id));
       end if;
@@ -15669,7 +15671,8 @@ package body Sem_Util is
    function Is_Effectively_Volatile_Object (N : Node_Id) return Boolean is
    begin
       if Is_Entity_Name (N) then
-         return Is_Effectively_Volatile (Entity (N));
+         return Is_Object (Entity (N))
+           and then Is_Effectively_Volatile (Entity (N));
 
       elsif Nkind (N) = N_Indexed_Component then
          return Is_Effectively_Volatile_Object (Prefix (N));
@@ -23289,6 +23292,7 @@ package body Sem_Util is
    ------------------------
 
    function No_Caching_Enabled (Id : Entity_Id) return Boolean is
+      pragma Assert (Ekind (Id) = E_Variable);
       Prag : constant Node_Id := Get_Pragma (Id, Pragma_No_Caching);
       Arg1 : Node_Id;