Patchwork [Ada] Properly detect passing volatile A.B to non-volatile formal

login
register
mail settings
Submitter Arnaud Charlet
Date Nov. 21, 2011, 11:59 a.m.
Message ID <20111121115938.GA30985@adacore.com>
Download mbox | patch
Permalink /patch/126766/
State New
Headers show

Comments

Arnaud Charlet - Nov. 21, 2011, 11:59 a.m.
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)

Patch

Index: sem_util.adb
===================================================================
--- sem_util.adb	(revision 181563)
+++ sem_util.adb	(working copy)
@@ -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
Index: s-taprop-linux.adb
===================================================================
--- s-taprop-linux.adb	(revision 181565)
+++ s-taprop-linux.adb	(working copy)
@@ -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);
 
Index: s-atocou-builtin.adb
===================================================================
--- s-atocou-builtin.adb	(revision 181556)
+++ s-atocou-builtin.adb	(working copy)
@@ -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;
 
    ------------