From eb6eb3b79aac8efe003861859e52d8e1680b120f Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Tue, 26 May 2020 12:19:01 +0200 Subject: [PATCH] [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. --- 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; -- 2.30.2