https://gcc.gnu.org/g:738711703db9f42490f06211a3e8fba07a84dbce
commit r15-1970-g738711703db9f42490f06211a3e8fba07a84dbce
Author: Eric Botcazou <ebotca...@adacore.com>
Date: Thu Jul 11 10:49:13 2024 +0200
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:
---
gcc/gimplify.cc | 48 +++++++++++++++++++++++++++++++----
gcc/testsuite/gnat.dg/array42.adb | 33 ++++++++++++++++++++++++
gcc/testsuite/gnat.dg/array42_pkg.ads | 25 ++++++++++++++++++
3 files changed, 101 insertions(+), 5 deletions(-)
diff --git a/gcc/gimplify.cc b/gcc/gimplify.cc
index 5a9627c4acf6..02faaf7114cf 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;
}
@@ -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
index 000000000000..f47f9bb6b922
--- /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
index 000000000000..d87720b2031b
--- /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;
