[Ada] Fix fallout of previous change for bit-packed arrays

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.

2019-09-19  Eric Botcazou  <ebotcazou@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.

From-SVN: r275933

gcc/ada/ChangeLog

@@ -1,3 +1,11 @@
+2019-09-19  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* 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.
+
 2019-09-19  Bob Duff  <duff@adacore.com>
 
 	* xref_lib.adb (Get_Symbol_Name): If we reach EOF in the first

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.

gcc/testsuite/ChangeLog

@@ -1,3 +1,7 @@
+2019-09-19  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/pack26.adb: New testcase.
+
 2019-09-19  Hongtao Liu <hongtao.liu@intel.com>
 
 	PR target/87007

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;