===================================================================
@@ -8727,11 +8727,16 @@
then
return True;
- elsif Nkind (N) = N_Indexed_Component
- or else Nkind (N) = N_Selected_Component
+ elsif Nkind_In (N, N_Indexed_Component, N_Selected_Component)
+ and then Is_Volatile_Prefix (Prefix (N))
then
- return Is_Volatile_Prefix (Prefix (N));
+ return True;
+ elsif Nkind (N) = N_Selected_Component
+ and then Is_Volatile (Entity (Selector_Name (N)))
+ then
+ return True;
+
else
return False;
end if;
@@ -10833,9 +10838,7 @@
-- source. This excludes, for example, calls to a dispatching
-- assignment operation when the left-hand side is tagged.
- if Modification_Comes_From_Source
- or else Alfa_Mode
- then
+ if Modification_Comes_From_Source or else Alfa_Mode then
Generate_Reference (Ent, Exp, 'm');
-- If the target of the assignment is the bound variable
===================================================================
@@ -990,12 +990,19 @@
-- do not need to manipulate caller's signal mask at this point.
-- All tasks in RTS will have All_Tasks_Mask initially.
- Result := pthread_create
- (T.Common.LL.Thread'Access,
- Attributes'Access,
- Thread_Body_Access (Wrapper),
- To_Address (T));
+ -- Note: the use of Unrestricted_Access in the following call is needed
+ -- because otherwise we have an error of getting a access-to-volatile
+ -- value which points to a non-volatile object. But in this case it is
+ -- safe to do this, since we know we have no problems with aliasing and
+ -- Unrestricted_Access bypasses this check.
+ Result :=
+ pthread_create
+ (T.Common.LL.Thread'Unrestricted_Access,
+ Attributes'Access,
+ Thread_Body_Access (Wrapper),
+ To_Address (T));
+
pragma Assert
(Result = 0 or else Result = EAGAIN or else Result = ENOMEM);
===================================================================
@@ -50,7 +50,12 @@
function Decrement (Item : in out Atomic_Counter) return Boolean is
begin
- return Sync_Sub_And_Fetch (Item.Value'Access, 1) = 0;
+ -- Note: the use of Unrestricted_Access here is required because we
+ -- are obtaining an access-to-volatile pointer to a non-volatile object.
+ -- This is not allowed for [Unchecked_]Access, but is safe in this case
+ -- because we know that no aliases are being created.
+
+ return Sync_Sub_And_Fetch (Item.Value'Unrestricted_Access, 1) = 0;
end Decrement;
---------------
@@ -59,7 +64,12 @@
procedure Increment (Item : in out Atomic_Counter) is
begin
- Sync_Add_And_Fetch (Item.Value'Access, 1);
+ -- Note: the use of Unrestricted_Access here is required because we
+ -- are obtaining an access-to-volatile pointer to a non-volatile object.
+ -- This is not allowed for [Unchecked_]Access, but is safe in this case
+ -- because we know that no aliases are being created.
+
+ Sync_Add_And_Fetch (Item.Value'Unrestricted_Access, 1);
end Increment;
------------
This patch provides proper detection of the error of passing pointer to volatile to pointer to non-volatile in the case of a component reference A.B. The following test program (compiled with -gnatld7 -gnatj60 -gnat2005) shows detection of this error 1. procedure Atomic_Test is 2. 3. type X32 is mod 2 ** 32; 4. 5. type X32_Array is array (1 .. 1) of aliased X32; 6. pragma Atomic_Components (X32_Array); 7. 8. type Rec is record 9. A : X32_Array; 10. B : aliased X32; 11. pragma Atomic (B); 12. end record; 13. 14. procedure Test (X : access X32) is null; 15. 16. C : aliased X32; 17. pragma Atomic (C); 18. 19. Object : Rec; 20. begin 21. Test (Object.A (1)'Access); | >>> access to volatile object cannot yield access-to-non-volatile type 22. Test (Object.B'Access); | >>> access to volatile object cannot yield access-to-non-volatile type 23. Test (C'Access); | >>> access to volatile object cannot yield access-to-non-volatile type 24. end Atomic_Test; Before the patch not all these errors were caught. This change necessitated fixes to two runtime files, namely s-atocou-builtin.adb and s-taprop-linux.adb, which had this error. These were both fixed by using Unrestricted_Access instead of Access. Tested on x86_64-pc-linux-gnu, committed on trunk 2011-11-21 Robert Dewar <dewar@adacore.com> * s-atocou-builtin.adb (Decrement): Use Unrestricted_Access to deal with fact that we properly detect the error if Access is used. (Increment): Same fix. * s-taprop-linux.adb (Create_Task): Use Unrestricted_Access to deal with fact that we properly detect the error if Access is used. * sem_util.adb (Is_Volatile_Object): Properly record that A.B is volatile if the B component is volatile. This affects the check for passing such a by reference volatile actual to a non-volatile formal (which should be illegal)