TH: fix Show/Eq/Ord instances for Bytes (#16457)

We shouldn't compare pointer values but the actual bytes.

3 files changed, 47 insertions, 0 deletions

diff --git a/testsuite/tests/th/TH_BytesShowEqOrd.hs b/testsuite/tests/th/TH_BytesShowEqOrd.hs
new file mode 100644
index 0000000000..e7640a7df3
--- /dev/null
+++ b/testsuite/tests/th/TH_BytesShowEqOrd.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE BangPatterns #-}
+
+module Main where
+
+import Language.Haskell.TH.Lib
+import GHC.Ptr
+import Foreign.ForeignPtr
+
+main :: IO ()
+main = do
+
+   let
+      !x = "abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz"#
+      !y = "ABCDEabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz"#
+
+   p1 <- newForeignPtr_ (Ptr x)
+   p2 <- newForeignPtr_ (Ptr y)
+
+   let
+      b1 = mkBytes p1  0 5
+      b2 = mkBytes p1 10 5
+      b3 = mkBytes p1 26 5
+      b4 = mkBytes p2  5 5
+      b5 = mkBytes p2 10 5
+
+   let myCmp a b = putStrLn $ "compare " ++ show a ++ " to " ++ show b ++ " => " ++ show (compare a b)
+
+   putStr "same pointer, same offset, same bytes: "
+   myCmp b1 b1
+   putStr "same pointer, different offset, same bytes: "
+   myCmp b1 b3
+   putStr "same pointer, different offset, different bytes: "
+   myCmp b1 b2
+   putStr "same pointer, different offset, different bytes: "
+   myCmp b2 b1
+   putStr "different pointer, different offset, same bytes: "
+   myCmp b1 b4
+   putStr "different pointer, different offset, different bytes: "
+   myCmp b1 b5
diff --git a/testsuite/tests/th/TH_BytesShowEqOrd.stdout b/testsuite/tests/th/TH_BytesShowEqOrd.stdout
new file mode 100644
index 0000000000..8da996586c
--- /dev/null
+++ b/testsuite/tests/th/TH_BytesShowEqOrd.stdout
@@ -0,0 +1,6 @@
+same pointer, same offset, same bytes: compare abcde to abcde => EQ
+same pointer, different offset, same bytes: compare abcde to abcde => EQ
+same pointer, different offset, different bytes: compare abcde to klmno => LT
+same pointer, different offset, different bytes: compare klmno to abcde => GT
+different pointer, different offset, same bytes: compare abcde to abcde => EQ
+different pointer, different offset, different bytes: compare abcde to fghij => LT
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index 127bdf665c..458b45d67f 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -504,3 +504,4 @@ test('T17688a', normal, compile, [''])
 test('T17688b', normal, compile, [''])
 test('TH_PprStar', normal, compile, ['-v0 -dsuppress-uniques'])
 test('TH_StringLift', normal, compile, [''])
+test('TH_BytesShowEqOrd', normal, compile_and_run, [''])