The compiler should issue the "atomic access cannot be guaranteed" error twice on the attached testcase, but it only issues it for the stand-alone variable.
Fixed thusly, tested on i586-suse-linux, applied on the mainline. 2011-10-26 Eric Botcazou <ebotca...@adacore.com> * gcc-interface/decl.c (gnat_to_gnu_field): Always check components declared as atomic. Move around conditionally executed code. 2011-10-26 Eric Botcazou <ebotca...@adacore.com> * gnat.dg/specs/atomic1.ads: New test. -- Eric Botcazou
Index: gcc-interface/decl.c =================================================================== --- gcc-interface/decl.c (revision 180423) +++ gcc-interface/decl.c (working copy) @@ -6853,10 +6853,8 @@ gnat_to_gnu_field (Entity_Id gnat_field, } } - /* If we are packing the record and the field is BLKmode, round the - size up to a byte boundary. */ - if (packed && TYPE_MODE (gnu_field_type) == BLKmode && gnu_size) - gnu_size = round_up (gnu_size, BITS_PER_UNIT); + if (Is_Atomic (gnat_field)) + check_ok_for_atomic (gnu_field_type, gnat_field, false); if (Present (Component_Clause (gnat_field))) { @@ -6946,9 +6944,6 @@ gnat_to_gnu_field (Entity_Id gnat_field, gnu_pos = NULL_TREE; } } - - if (Is_Atomic (gnat_field)) - check_ok_for_atomic (gnu_field_type, gnat_field, false); } /* If the record has rep clauses and this is the tag field, make a rep @@ -6961,7 +6956,14 @@ gnat_to_gnu_field (Entity_Id gnat_field, } else - gnu_pos = NULL_TREE; + { + gnu_pos = NULL_TREE; + + /* If we are packing the record and the field is BLKmode, round the + size up to a byte boundary. */ + if (packed && TYPE_MODE (gnu_field_type) == BLKmode && gnu_size) + gnu_size = round_up (gnu_size, BITS_PER_UNIT); + } /* We need to make the size the maximum for the type if it is self-referential and an unconstrained type. In that case, we can't
-- { dg-do compile } package Atomic1 is type Arr is array (Integer range <>) of Boolean; type UA is access all Arr; U : UA; pragma Atomic (U); -- { dg-error "atomic access" } type R is record U : UA; pragma Atomic (U); -- { dg-error "atomic access" } end record; end Atomic1;