diff mbox

[Ada] Warn on assigning to packed atomic component

Message ID 20100618081830.GA1757@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet June 18, 2010, 8:18 a.m. UTC 
When an assignment is made to a component of a packed atomic object,
the generated code may have to do a load/modify/store sequence that
results in possibly unexpected references to the atomic object. This
patch generates warnings in this situation:

     1. function atomicwarn return Boolean is
     2.    type r is record
     3.       a, b, c : Boolean;
     4.    end record;
     5.    pragma Pack (r);
     6.    pragma Atomic (r);
     7.    rv : r;
     8.    type a is array (0 .. 31) of Boolean;
     9.    pragma Pack (a);
    10.    pragma Atomic (a);
    11.    av : a;
    12.
    13. begin
    14.    rv.a := True;
           |
        >>> warning: assignment to component of packed atomic record
        >>> warning: may cause unexpected accesses to atomic object

    15.    av (3) := true;
           |
        >>> warning: assignment to component of packed atomic array
        >>> warning: may cause unexpected accesses to atomic object

    16.    return rv.b and av (4);
    17. end;

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

2010-06-18  Robert Dewar  <dewar@adacore.com>

	* sem_res.adb (Analyze_Indexed_Component, Analyze_Selected_Component):
	Warn on assigning to packed atomic component.
diff mbox

Patch

Index: sem_res.adb
===================================================================
--- sem_res.adb	(revision 160959)
+++ sem_res.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -6635,6 +6635,24 @@  package body Sem_Res is
          Warn_On_Suspicious_Index (Name, First (Expressions (N)));
          Eval_Indexed_Component (N);
       end if;
+
+      --  If the array type is atomic, and is packed, and we are in a left side
+      --  context, then this is worth a warning, since we have a situation
+      --  where the access to the component may cause extra read/writes of
+      --  the atomic array object, which could be considered unexpected.
+
+      if Nkind (N) = N_Indexed_Component
+        and then (Is_Atomic (Array_Type)
+                   or else (Is_Entity_Name (Prefix (N))
+                             and then Is_Atomic (Entity (Prefix (N)))))
+        and then Is_Bit_Packed_Array (Array_Type)
+        and then Is_LHS (N)
+      then
+         Error_Msg_N ("?assignment to component of packed atomic array",
+                      Prefix (N));
+         Error_Msg_N ("?\may cause unexpected accesses to atomic object",
+                      Prefix (N));
+      end if;
    end Resolve_Indexed_Component;
 
    -----------------------------
@@ -7715,7 +7733,6 @@  package body Sem_Res is
 
                   Comp := Next_Entity (Comp);
                end loop;
-
             end if;
 
             Get_Next_Interp (I, It);
@@ -7784,6 +7801,23 @@  package body Sem_Res is
       --  Note: No Eval processing is required, because the prefix is of a
       --  record type, or protected type, and neither can possibly be static.
 
+      --  If the array type is atomic, and is packed, and we are in a left side
+      --  context, then this is worth a warning, since we have a situation
+      --  where the access to the component may cause extra read/writes of
+      --  the atomic array object, which could be considered unexpected.
+
+      if Nkind (N) = N_Selected_Component
+        and then (Is_Atomic (T)
+                   or else (Is_Entity_Name (Prefix (N))
+                             and then Is_Atomic (Entity (Prefix (N)))))
+        and then Is_Packed (T)
+        and then Is_LHS (N)
+      then
+         Error_Msg_N ("?assignment to component of packed atomic record",
+                      Prefix (N));
+         Error_Msg_N ("?\may cause unexpected accesses to atomic object",
+                      Prefix (N));
+      end if;
    end Resolve_Selected_Component;
 
    -------------------