diff options
author | Ben Gamari <ben@smart-cactus.org> | 2021-04-06 19:11:08 -0400 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2021-05-04 19:12:32 -0400 |
commit | 63bc827ed40e66cd305e2162dfbbd3746be7bf21 (patch) | |
tree | 1d653e1fd125ed243d321ff85f7d50a00ba02854 | |
parent | e835fb1f5baf4e2c5e4bd336e5266dd0728a77e1 (diff) | |
download | haskell-63bc827ed40e66cd305e2162dfbbd3746be7bf21.tar.gz |
testsuite: Add test for #19645
(cherry picked from commit 9f9fab1531d62f6d30c853722548393be264120b)
-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 b400735464..b32b93913f 100644 --- a/testsuite/tests/unboxedsums/all.T +++ b/testsuite/tests/unboxedsums/all.T @@ -32,3 +32,4 @@ test('T12711', only_ways(['ghci']), ghci_script, ['T12711.script']) test('UbxSumLevPoly', normal, compile, ['']) test('T14051', normal, multi_compile, ['T14051.hs', [('T14051a.hs', '')], '-O2 -v0']) +test('T19645', normal, compile_and_run, ['']) |