diff options
| -rw-r--r-- | testsuite/tests/unboxedsums/T19645.hs | 29 | ||||
| -rw-r--r-- | testsuite/tests/unboxedsums/T19645.stdout | 1 | ||||
| -rw-r--r-- | testsuite/tests/unboxedsums/all.T | 1 |
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, ['']) |