From 009070260dd9ac941d30b119638a6f3839eb2e6b Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 12 Aug 2019 09:01:33 +0000 Subject: [PATCH] [Ada] Fix internal error on comparison of unaligned slices This fixes an internal error in the code generator when it is trying to take the address of a slice which does not start on a byte boundary, in order to generate a comparison between slices with a dynamic length. This case is not supported by the code generator and comes from an explicit representation clause on a record type, so it must be detected and handled by the front-end by expanding the comparison on an element-by-element basis. 2019-08-12 Eric Botcazou gcc/ada/ * exp_ch4.adb (Expand_N_Op_Eq): Expand the array equality if either operand is a possibly unaligned slice. * exp_ch6.adb (Expand_Simple_Function_Return): Do not generate a copy for a possibly unaligned object if it is represented as a scalar. * exp_util.adb (Is_Possibly_Unaligned_Slice): Do not always return false if the target doesn't have strict alignment. gcc/testsuite/ * gnat.dg/slice10.adb: New testcase. From-SVN: r274303 --- gcc/ada/ChangeLog | 10 ++++++++++ gcc/ada/exp_ch4.adb | 2 ++ gcc/ada/exp_ch6.adb | 17 +++++++++-------- gcc/ada/exp_util.adb | 6 ------ gcc/testsuite/ChangeLog | 4 ++++ gcc/testsuite/gnat.dg/slice10.adb | 29 +++++++++++++++++++++++++++++ 6 files changed, 54 insertions(+), 14 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/slice10.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f2870e8dbc0..fa543dfb803 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2019-08-12 Eric Botcazou + + * exp_ch4.adb (Expand_N_Op_Eq): Expand the array equality if + either operand is a possibly unaligned slice. + * exp_ch6.adb (Expand_Simple_Function_Return): Do not generate a + copy for a possibly unaligned object if it is represented as a + scalar. + * exp_util.adb (Is_Possibly_Unaligned_Slice): Do not always + return false if the target doesn't have strict alignment. + 2019-08-12 Bob Duff * sem_ch12.adb (Instantiate_Package_Body): Remove suppression of diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 43be9c9acb3..6f2fe325507 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -8068,7 +8068,9 @@ package body Exp_Ch4 is and then not Is_Floating_Point_Type (Component_Type (Typl)) and then not Is_Atomic_Or_VFA (Component_Type (Typl)) and then not Is_Possibly_Unaligned_Object (Lhs) + and then not Is_Possibly_Unaligned_Slice (Lhs) and then not Is_Possibly_Unaligned_Object (Rhs) + and then not Is_Possibly_Unaligned_Slice (Rhs) and then Support_Composite_Compare_On_Target then null; diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 3f2d0e31783..4ba9d84804b 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -203,8 +203,8 @@ package body Exp_Ch6 is -- For all parameter modes, actuals that denote components and slices of -- packed arrays are expanded into suitable temporaries. -- - -- For non-scalar objects that are possibly unaligned, add call by copy - -- code (copy in for IN and IN OUT, copy out for OUT and IN OUT). + -- For nonscalar objects that are possibly unaligned, add call by copy code + -- (copy in for IN and IN OUT, copy out for OUT and IN OUT). -- -- For OUT and IN OUT parameters, add predicate checks after the call -- based on the predicates of the actual type. @@ -2019,7 +2019,7 @@ package body Exp_Ch6 is elsif Is_Ref_To_Bit_Packed_Array (Actual) then Add_Simple_Call_By_Copy_Code; - -- If a non-scalar actual is possibly bit-aligned, we need a copy + -- If a nonscalar actual is possibly bit-aligned, we need a copy -- because the back-end cannot cope with such objects. In other -- cases where alignment forces a copy, the back-end generates -- it properly. It should not be generated unconditionally in the @@ -2235,7 +2235,7 @@ package body Exp_Ch6 is elsif Is_Ref_To_Bit_Packed_Array (Actual) then Add_Simple_Call_By_Copy_Code; - -- If a non-scalar actual is possibly unaligned, we need a copy + -- 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)) @@ -7413,12 +7413,13 @@ package body Exp_Ch6 is end; end if; - -- If we are returning an object that may not be bit-aligned, then copy - -- the value into a temporary first. This copy may need to expand to a - -- loop of component operations. + -- If we are returning a nonscalar object that is possibly unaligned, + -- then copy the value into a temporary first. This copy may need to + -- expand to a loop of component operations. if Is_Possibly_Unaligned_Slice (Exp) - or else Is_Possibly_Unaligned_Object (Exp) + or else (Is_Possibly_Unaligned_Object (Exp) + and then not Represented_As_Scalar (Etype (Exp))) then declare ExpR : constant Node_Id := Relocate_Node (Exp); diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index b677a72587d..2a3132b0605 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -8485,12 +8485,6 @@ package body Exp_Util is return False; end if; - -- We only need to worry if the target has strict alignment - - if not Target_Strict_Alignment then - return False; - end if; - -- If it is a slice, then look at the array type being sliced declare diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index f7f62763823..ee65d1b4789 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2019-08-12 Eric Botcazou + + * gnat.dg/slice10.adb: New testcase. + 2019-08-12 Gary Dismukes * gnat.dg/generic_inst7.adb, gnat.dg/generic_inst7_pkg.adb, diff --git a/gcc/testsuite/gnat.dg/slice10.adb b/gcc/testsuite/gnat.dg/slice10.adb new file mode 100644 index 00000000000..4793258003d --- /dev/null +++ b/gcc/testsuite/gnat.dg/slice10.adb @@ -0,0 +1,29 @@ +-- { dg-do run } + +procedure Slice10 is + + subtype Str is String (1 .. 3); + + type T is record + B : Boolean; + S : Str; + end record; + + for T use record + B at 0 range 0 .. 0; + S at 0 range 1 .. 24; + end record; + + function Match (X, Y: T; Length : Positive) return Boolean is + begin + return X.S (1 .. Length) = Y.S (1 .. Length); + end; + + X, Y : T := (B => True, S => "123"); + +begin + X.B := False; + if not match (X, Y, 3) then + raise Program_Error; + end if; +end; -- 2.30.2