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-12 14:26:57 -0400 |
commit | d681a7ebafb1ba1a29cb815609885451725cdd23 (patch) | |
tree | d7cfd9f500a33d66b517f1cb485907ff0ce26e44 | |
parent | 196b10e11000247119bc691b5c53a7ae8b1d946c (diff) | |
download | haskell-d681a7ebafb1ba1a29cb815609885451725cdd23.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, ['']) |