This plugs a small hole in the implementation of atomic synchronization: the
compiler fails to enforce it if a pragma/aspect Has_Atomic_Components is put
directly on an array object instead of an array type. It's not a regression
but the issue is annoying and the fix is trivial.
Tested on x86_64-suse-linux, applied on the mainline and 5 branch.
2016-02-17 Eric Botcazou <ebotca...@adacore.com>
* exp_ch4.adb (Expand_N_Indexed_Component): Active synchronization if
the prefix denotes an entity which Has_Atomic_Components.
* gcc-interface/trans.c (node_is_atomic): Return true if the prefix
denotes an entity which Has_Atomic_Components.
2016-02-17 Eric Botcazou <ebotca...@adacore.com>
* gnat.dg/atomic8.adb: New test.
--
Eric Botcazou-- { dg-do run }
procedure Atomic8 is
V : array (1 .. 2) of Natural := (0,0) with Atomic_Components;
task type TT1;
task body TT1 is
begin
while V (1) + V (2) < 1_000_000 loop
V (1) := V (1) + 1;
end loop;
end TT1;
task type TT2;
task body TT2 is
begin
while V (1) + V (2) < 1_000_000 loop
V (2) := V (2) + 1;
end loop;
end TT2;
begin
declare
T1 : TT1;
T2 : TT2;
begin
null;
end;
if V (1) + V (2) not in 1_000_000 | 1_000_001 then
raise Program_Error;
end if;
end;
Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb (revision 233448)
+++ exp_ch4.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2016, 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- --
@@ -6269,6 +6269,9 @@ package body Exp_Ch4 is
and then not Atomic_Synchronization_Disabled (Atp))
or else (Is_Atomic (Typ)
and then not Atomic_Synchronization_Disabled (Typ))
+ or else (Is_Entity_Name (P)
+ and then Has_Atomic_Components (Entity (P))
+ and then not Atomic_Synchronization_Disabled (Entity (P)))
then
Activate_Atomic_Synchronization (N);
end if;
Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c (revision 233448)
+++ gcc-interface/trans.c (working copy)
@@ -4028,6 +4028,9 @@ node_is_atomic (Node_Id gnat_node)
case N_Indexed_Component:
if (Has_Atomic_Components (Etype (Prefix (gnat_node))))
return true;
+ if (Is_Entity_Name (Prefix (gnat_node))
+ && Has_Atomic_Components (Entity (Prefix (gnat_node))))
+ return true;
/* ... fall through ... */
