testsuite: Add test for #19645

3 files changed, 31 insertions, 0 deletions

diff --git a/testsuite/tests/unboxedsums/T19645.hs b/testsuite/tests/unboxedsums/T19645.hs
new file mode 100644
index 0000000000..be042fa408
--- /dev/null
+++ b/testsuite/tests/unboxedsums/T19645.hs
@@ -0,0 +1,29 @@
+{-# LANGUAGE MagicHash                 #-}
+{-# LANGUAGE UnboxedSums               #-}
+{-# LANGUAGE UnboxedTuples             #-}
+module Main (main) where
+
+import GHC.Base
+
+data MyArray t = MyArray (# t | ByteArray# #)
+
+getBytes :: MyArray t -> ByteArray#
+-- This would work on GHC versions < 9.0 when uncommented, but not on 9.0.1!
+-- getBytes (MyArray (# | arr #)) = case runRW# (\s -> (# touch# arr s, arr #)) of (# _, r #) -> r
+getBytes (MyArray (# | arr #)) = arr
+getBytes _ = mkByteArray 13
+-- Commenting out this NOINLINE pragma also makes it work successfully
+{-#  NOINLINE getBytes #-}
+
+mkByteArray :: Double -> ByteArray#
+mkByteArray (D# x) = case runRW#
+  ( \s0 -> case newByteArray# 8# s0 of
+      (# s1, mba #) -> unsafeFreezeByteArray# mba ( writeDoubleArray# mba 0# x s1)
+  ) of (# _, ba #) -> ba
+
+main :: IO ()
+main = print $ case getBytes x of a ->  D# (indexDoubleArray# a 0#)
+  where
+    x :: MyArray Double
+    x = MyArray (# | mkByteArray 7 #)
+
diff --git a/testsuite/tests/unboxedsums/T19645.stdout b/testsuite/tests/unboxedsums/T19645.stdout
new file mode 100644
index 0000000000..4fedf1d20e
--- /dev/null
+++ b/testsuite/tests/unboxedsums/T19645.stdout
@@ -0,0 +1 @@
+7.0
diff --git a/testsuite/tests/unboxedsums/all.T b/testsuite/tests/unboxedsums/all.T
index c697a42886..c3cf9f1559 100644
--- a/testsuite/tests/unboxedsums/all.T
+++ b/testsuite/tests/unboxedsums/all.T
@@ -26,3 +26,4 @@ test('T12711', only_ways(['ghci']), ghci_script, ['T12711.script'])
 
 test('UbxSumLevPoly', normal, compile, ['-Wno-overlapping-patterns'])
 test('T14051', normal, multi_compile, ['T14051.hs', [('T14051a.hs', '')], '-O2 -v0'])
+test('T19645', normal, compile_and_run, [''])