[PATCH] Fix gimplification of ordering comparisons of arrays of bytes

[Eric Botcazou]

Hi,

the Ada compiler now defers to the gimplifier for ordering comparisons of 
arrays of bytes (Ada parlance for <, >, <= and >=) because the gimplifier in 
turn defers to memcmp for them, which implements the required semantics.

However the gimplifier has a special processing for aggregate types whose mode 
is not BLKmode and this processing deviates from the memcmp semantics when the 
target is little-endian.

Tested on x86-64/Linux, OK for the mainline?


2024-07-08  Eric Botcazou  <ebotca...@adacore.com>

        * gimplify.cc (gimplify_scalar_mode_aggregate_compare): Add support
        for ordering comparisons.


2024-07-08  Eric Botcazou  <ebotca...@adacore.com>

        * gnat.dg/array42.adb,/gnat.dg/array42_pkg.ads: New test.

-- 
Eric Botcazou
diff --git a/gcc/gimplify.cc b/gcc/gimplify.cc
index 5a9627c4acf..c81900af970 100644
--- a/gcc/gimplify.cc
+++ b/gcc/gimplify.cc
@@ -6728,18 +6728,56 @@ gimplify_variable_sized_compare (tree *expr_p)
 static enum gimplify_status
 gimplify_scalar_mode_aggregate_compare (tree *expr_p)
 {
-  location_t loc = EXPR_LOCATION (*expr_p);
+  const location_t loc = EXPR_LOCATION (*expr_p);
+  const enum tree_code code = TREE_CODE (*expr_p);
   tree op0 = TREE_OPERAND (*expr_p, 0);
   tree op1 = TREE_OPERAND (*expr_p, 1);
-
   tree type = TREE_TYPE (op0);
   tree scalar_type = lang_hooks.types.type_for_mode (TYPE_MODE (type), 1);
 
   op0 = fold_build1_loc (loc, VIEW_CONVERT_EXPR, scalar_type, op0);
   op1 = fold_build1_loc (loc, VIEW_CONVERT_EXPR, scalar_type, op1);
 
-  *expr_p
-    = fold_build2_loc (loc, TREE_CODE (*expr_p), TREE_TYPE (*expr_p), op0, op1);
+  /* We need to perform ordering comparisons in memory order like memcmp and,
+     therefore, may need to byte-swap operands for little-endian targets.  */
+  if (code != EQ_EXPR && code != NE_EXPR)
+    {
+      gcc_assert (BYTES_BIG_ENDIAN == WORDS_BIG_ENDIAN);
+      gcc_assert (TREE_CODE (scalar_type) == INTEGER_TYPE);
+      tree fndecl;
+
+      if (BYTES_BIG_ENDIAN)
+	fndecl = NULL_TREE;
+      else
+	switch (int_size_in_bytes (scalar_type))
+	  {
+	  case 1:
+	    fndecl = NULL_TREE;
+	    break;
+	  case 2:
+	    fndecl = builtin_decl_implicit (BUILT_IN_BSWAP16);
+	    break;
+	  case 4:
+	    fndecl = builtin_decl_implicit (BUILT_IN_BSWAP32);
+	    break;
+	  case 8:
+	    fndecl = builtin_decl_implicit (BUILT_IN_BSWAP64);
+	    break;
+	  case 16:
+	    fndecl = builtin_decl_implicit (BUILT_IN_BSWAP128);
+	    break;
+	  default:
+	    gcc_unreachable ();
+	  }
+
+      if (fndecl)
+	{
+	  op0 = build_call_expr_loc (loc, fndecl, 1, op0);
+	  op1 = build_call_expr_loc (loc, fndecl, 1, op1);
+	}
+    }
+
+  *expr_p = fold_build2_loc (loc, code, TREE_TYPE (*expr_p), op0, op1);
 
   return GS_OK;
 }

-- { dg-do run }

with Array42_Pkg; use Array42_Pkg;

procedure Array42 is

  procedure Raise_Error_If_False (Test : Boolean; N : Positive) is
  begin
    if not Test then
      raise Program_Error with "Test" & N'Img & " fails";
    end if;
  end;

begin
  Raise_Error_If_False (LT2  ("12", "21"), 1);
  Raise_Error_If_False (LT4  ("1234", "4321"), 2);
  Raise_Error_If_False (LT8  ("12345678", "87654321"), 3);
  Raise_Error_If_False (LT8  ("12345678", "87654321"), 4);
  Raise_Error_If_False (LT16 ("12345678ABCDEFGH", "HGFEDCBA87654321"), 5);

  Raise_Error_If_False (LT5  ("12345", "54321"), 6);
  Raise_Error_If_False (LE5  ("12345", "54321"), 7);
  Raise_Error_If_False (not GT5  ("12345", "54321"), 8);
  Raise_Error_If_False (not GE5  ("12345", "54321"), 9);

  Raise_Error_If_False (LT45  ("1234", "12345"), 10);
  Raise_Error_If_False (not LT54  ("12345", "1234"), 11);
  Raise_Error_If_False (LT54  ("12345", "1235"), 12);

  Raise_Error_If_False (LT ("1234", "12345"), 13);
  Raise_Error_If_False (not LT ("12345", "1234"), 14);
  Raise_Error_If_False (LT ("12345", "1235"), 15);
end;

package Array42_Pkg is

  subtype S2  is String (1 .. 2);
  subtype S4  is String (1 .. 4);
  subtype S5  is String (1 .. 5);
  subtype S8  is String (1 .. 8);
  subtype S12 is String (1 .. 12);
  subtype S16 is String (1 .. 16);

  function LT2  (A, B : S2)  return Boolean is (A < B);
  function LT4  (A, B : S4)  return Boolean is (A < B);
  function LT8  (A, B : S8)  return Boolean is (A < B);
  function LT16 (A, B : S16) return Boolean is (A < B);

  function LT5  (A, B : S5)  return Boolean is (A < B);
  function LE5  (A, B : S5)  return Boolean is (A <= B);
  function GT5  (A, B : S5)  return Boolean is (A > B);
  function GE5  (A, B : S5)  return Boolean is (A >= B);

  function LT45 (A : S4; B : S5) return Boolean is (A < B);
  function LT54 (A : S5; B : S4) return Boolean is (A < B);

  function LT (A, B : String) return Boolean is (A < B);

end Array42_Pkg;