diff mbox series

[Ada] Fix failing assertions related to volatile objects

Message ID 20200710094420.GA35290@adacore.com
State New
Headers show
Series [Ada] Fix failing assertions related to volatile objects | expand

Commit Message

Pierre-Marie de Rodat July 10, 2020, 9:44 a.m. UTC 
Comments for routines No_Caching_Enabled and Is_Effectively_Volatile,
which are both related to volatile objects, were not enforced with
assertions. As a result, we had failing assertions much deeper in the
call tree, far from where the problems occur. This patch adds both the
missing assertions and guards to prevent those assertions from failing.

In preparation for a main commit that will address a problem related to
freezing of Dynamic_Predicate aspect on volatile objects.

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

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

Patch

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
@@ -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
--- 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
--- 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;