From 348c3ae62ec5579323defd9179aa6b870e0b744b Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Thu, 19 Sep 2019 08:12:52 +0000 Subject: [PATCH] [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 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 | 8 ++++++++ gcc/ada/exp_ch6.adb | 32 +++++++++++++++++++------------- gcc/testsuite/ChangeLog | 4 ++++ gcc/testsuite/gnat.dg/pack26.adb | 23 +++++++++++++++++++++++ 4 files changed, 54 insertions(+), 13 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/pack26.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 429e17ff286..78b1c0b7db5 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2019-09-19 Eric Botcazou + + * 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 * xref_lib.adb (Get_Symbol_Name): If we reach EOF in the first diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index d3540c3e35d..c569ca33af7 100644 --- a/gcc/ada/exp_ch6.adb +++ b/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. diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 20d22de9a94..1e026289249 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2019-09-19 Eric Botcazou + + * gnat.dg/pack26.adb: New testcase. + 2019-09-19 Hongtao Liu PR target/87007 diff --git a/gcc/testsuite/gnat.dg/pack26.adb b/gcc/testsuite/gnat.dg/pack26.adb new file mode 100644 index 00000000000..636529600d4 --- /dev/null +++ b/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 -- 2.30.2