aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorPiotr Trojanek <trojanek@adacore.com>2020-05-26 12:19:01 +0200
committerPierre-Marie de Rodat <derodat@adacore.com>2020-07-10 05:16:16 -0400
commiteb6eb3b79aac8efe003861859e52d8e1680b120f (patch)
tree7d8338c0b72ca586a49ee6d69cc3be717261d5c9 /gcc
parentc24633fbbb88d0032008ab012e2e3204b9405ec4 (diff)
downloadgcc-eb6eb3b79aac8efe003861859e52d8e1680b120f.zip
gcc-eb6eb3b79aac8efe003861859e52d8e1680b120f.tar.gz
gcc-eb6eb3b79aac8efe003861859e52d8e1680b120f.tar.bz2
[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.
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/sem_ch3.adb4
-rw-r--r--gcc/ada/sem_prag.adb9
-rw-r--r--gcc/ada/sem_util.adb10
3 files changed, 15 insertions, 8 deletions
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index c105f3c..74946d3 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 db9c611..24053d5 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 f7a7c1f..b88f6f7 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;