Fix gimplification of ordering comparisons of arrays of bytes

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.

gcc/
	* gimplify.cc (gimplify_scalar_mode_aggregate_compare): Add support
	for ordering comparisons.
	(gimplify_expr) <default>: Call gimplify_scalar_mode_aggregate_compare
	only for integral scalar modes.

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

diff --git a/gcc/gimplify.cc b/gcc/gimplify.cc
index 5a9627c4acf641894cc16a1283893e120b3cf2c3..02faaf7114cf2c8a66d93361ae16be79927c58e0 100644 (file)
--- 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;
 }
@@ -18825,7 +18863,7 @@ gimplify_expr (tree *expr_p, gimple_seq *pre_p, gimple_seq *post_p,
                      else
                        goto expr_2;
                    }
-                 else if (TYPE_MODE (type) != BLKmode)
+                 else if (SCALAR_INT_MODE_P (TYPE_MODE (type)))
                    ret = gimplify_scalar_mode_aggregate_compare (expr_p);
                  else
                    ret = gimplify_variable_sized_compare (expr_p);

diff --git a/gcc/testsuite/gnat.dg/array42.adb b/gcc/testsuite/gnat.dg/array42.adb
new file mode 100644 (file)
index 0000000..f47f9bb
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/array42.adb
@@ -0,0 +1,33 @@
+-- { 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;

diff --git a/gcc/testsuite/gnat.dg/array42_pkg.ads b/gcc/testsuite/gnat.dg/array42_pkg.ads
new file mode 100644 (file)
index 0000000..d87720b
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/array42_pkg.ads
@@ -0,0 +1,25 @@
+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;