This fixes a regression introduced by the previous change that improved
the handling of explicit by-reference mechanism. For the very specific
case of a component of a bit-packed array, the front-end still needs to
insert a copy around the call because this is where the rewriting into
the sequence of mask-and-shifts is done for the code generator.
Tested on x86_64-pc-linux-gnu, committed on trunk
2019-09-19 Eric Botcazou <ebotca...@adacore.com>
gcc/ada/
* exp_ch6.adb (Add_Simple_Call_By_Copy_Code): Add
Bit_Packed_Array parameter and documet it. Always insert a copy
if it is set True.
(Expand_Actuals): Adjust the calls to
Add_Simple_Call_By_Copy_Code.
gcc/testsuite/
* gnat.dg/pack26.adb: New testcase.--- gcc/ada/exp_ch6.adb
+++ gcc/ada/exp_ch6.adb
@@ -1252,10 +1252,11 @@ package body Exp_Ch6 is
-- also takes care of any constraint checks required for the type
-- conversion case (on both the way in and the way out).
- procedure Add_Simple_Call_By_Copy_Code;
+ procedure Add_Simple_Call_By_Copy_Code (Bit_Packed_Array : Boolean);
-- This is similar to the above, but is used in cases where we know
-- that all that is needed is to simply create a temporary and copy
- -- the value in and out of the temporary.
+ -- the value in and out of the temporary. If Bit_Packed_Array is True,
+ -- the procedure is called for a bit-packed array actual.
procedure Add_Validation_Call_By_Copy_Code (Act : Node_Id);
-- Perform copy-back for actual parameter Act which denotes a validation
@@ -1269,11 +1270,11 @@ package body Exp_Ch6 is
function Is_Legal_Copy return Boolean;
-- Check that an actual can be copied before generating the temporary
- -- to be used in the call. If the actual is of a by_reference type then
- -- the program is illegal (this can only happen in the presence of
- -- rep. clauses that force an incorrect alignment). If the formal is
- -- a by_reference parameter imposed by a DEC pragma, emit a warning to
- -- the effect that this might lead to unaligned arguments.
+ -- to be used in the call. If the formal is of a by_reference type or
+ -- is aliased, then the program is illegal (this can only happen in
+ -- the presence of representation clauses that force a misalignment)
+ -- If the formal is a by_reference parameter imposed by a DEC pragma,
+ -- emit a warning that this might lead to unaligned arguments.
function Make_Var (Actual : Node_Id) return Entity_Id;
-- Returns an entity that refers to the given actual parameter, Actual
@@ -1610,7 +1611,7 @@ package body Exp_Ch6 is
-- Add_Simple_Call_By_Copy_Code --
----------------------------------
- procedure Add_Simple_Call_By_Copy_Code is
+ procedure Add_Simple_Call_By_Copy_Code (Bit_Packed_Array : Boolean) is
Decl : Node_Id;
F_Typ : Entity_Id := Etype (Formal);
Incod : Node_Id;
@@ -1621,7 +1622,12 @@ package body Exp_Ch6 is
Temp : Entity_Id;
begin
- if not Is_Legal_Copy then
+ -- ??? We need to do the copy for a bit-packed array because this is
+ -- where the rewriting into a mask-and-shift sequence is done. But of
+ -- course this may break the program if it expects bits to be really
+ -- passed by reference. That's what we have done historically though.
+
+ if not Bit_Packed_Array and then not Is_Legal_Copy then
return;
end if;
@@ -2076,7 +2082,7 @@ package body Exp_Ch6 is
-- [in] out parameters.
elsif Is_Ref_To_Bit_Packed_Array (Actual) then
- Add_Simple_Call_By_Copy_Code;
+ Add_Simple_Call_By_Copy_Code (Bit_Packed_Array => True);
-- If a nonscalar actual is possibly bit-aligned, we need a copy
-- because the back-end cannot cope with such objects. In other
@@ -2092,7 +2098,7 @@ package body Exp_Ch6 is
Component_May_Be_Bit_Aligned (Entity (Selector_Name (Actual)))
and then not Represented_As_Scalar (Etype (Formal))
then
- Add_Simple_Call_By_Copy_Code;
+ Add_Simple_Call_By_Copy_Code (Bit_Packed_Array => False);
-- References to slices of bit-packed arrays are expanded
@@ -2295,14 +2301,14 @@ package body Exp_Ch6 is
-- Is this really necessary in all cases???
elsif Is_Ref_To_Bit_Packed_Array (Actual) then
- Add_Simple_Call_By_Copy_Code;
+ Add_Simple_Call_By_Copy_Code (Bit_Packed_Array => True);
-- If a nonscalar actual is possibly unaligned, we need a copy
elsif Is_Possibly_Unaligned_Object (Actual)
and then not Represented_As_Scalar (Etype (Formal))
then
- Add_Simple_Call_By_Copy_Code;
+ Add_Simple_Call_By_Copy_Code (Bit_Packed_Array => False);
-- Similarly, we have to expand slices of packed arrays here
-- because the result must be byte aligned.
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/pack26.adb
@@ -0,0 +1,23 @@
+-- { dg-do run }
+
+pragma Extend_System (Aux_DEC);
+
+with System;
+
+procedure Pack26 is
+
+ type Bool_Array is array (1 .. 8) of Boolean;
+ pragma pack (Bool_Array);
+
+ All_True : Bool_Array := (others => True);
+ Old_Value : Boolean := False;
+
+begin
+
+ System.Clear_Interlocked (All_True (2), Old_Value);
+
+ if not Old_Value then
+ raise Program_Error;
+ end if;
+
+end;
\ No newline at end of file
