diff options
| author | Alexis King <lexi.lambda@gmail.com> | 2023-05-12 15:08:18 -0500 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2023-05-13 08:45:18 -0400 |
| commit | d85ed900b271109185251cb0494d51048a4cf213 (patch) | |
| tree | ff77df793137704d6399e57e771493cbb60a2fe2 /testsuite | |
| parent | 5cad28e73bf9a1a535fa9ed22800156c1ba2e6c8 (diff) | |
| download | haskell-d85ed900b271109185251cb0494d51048a4cf213.tar.gz | |
Use a uniform return convention in bytecode for unary results
fixes #22958
Diffstat (limited to 'testsuite')
| -rw-r--r-- | testsuite/tests/ghci/should_run/T22958a.hs | 15 | ||||
| -rw-r--r-- | testsuite/tests/ghci/should_run/T22958a.stdout | 1 | ||||
| -rw-r--r-- | testsuite/tests/ghci/should_run/T22958b.hs | 25 | ||||
| -rw-r--r-- | testsuite/tests/ghci/should_run/T22958b.stdout | 4 | ||||
| -rw-r--r-- | testsuite/tests/ghci/should_run/all.T | 2 |
5 files changed, 47 insertions, 0 deletions
diff --git a/testsuite/tests/ghci/should_run/T22958a.hs b/testsuite/tests/ghci/should_run/T22958a.hs new file mode 100644 index 0000000000..7ec94bc4c7 --- /dev/null +++ b/testsuite/tests/ghci/should_run/T22958a.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} +import GHC.Exts +import GHC.IO + +unit :: () +unit = () + +i :: State# RealWorld -> (# State# RealWorld, () #) +i s = case seq# unit s of (# s', a #) -> (# s', a #) + +bad :: IO () +bad = IO i + +main :: IO () +main = bad >>= print diff --git a/testsuite/tests/ghci/should_run/T22958a.stdout b/testsuite/tests/ghci/should_run/T22958a.stdout new file mode 100644 index 0000000000..6a452c185a --- /dev/null +++ b/testsuite/tests/ghci/should_run/T22958a.stdout @@ -0,0 +1 @@ +() diff --git a/testsuite/tests/ghci/should_run/T22958b.hs b/testsuite/tests/ghci/should_run/T22958b.hs new file mode 100644 index 0000000000..da849286aa --- /dev/null +++ b/testsuite/tests/ghci/should_run/T22958b.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnliftedDatatypes #-} +import GHC.Exts + +type D1 :: TYPE (BoxedRep Unlifted) +data D1 = MkD1 !Int + +showD1 :: D1 -> String +showD1 (MkD1 i) = "MkD1 " ++ show i + +type D2 :: TYPE (BoxedRep Lifted) +data D2 = MkD2 !Int deriving stock Show + +risky :: forall {r} (a :: TYPE (BoxedRep Unlifted)) (b :: TYPE r). a -> b +risky = unsafeCoerce# +{-# NOINLINE risky #-} + +main :: IO () +main = do + putStrLn (showD1 (unsafeCoerce# (MkD1 11))) -- foo11 + print (unsafeCoerce# (MkD1 12) :: D2) -- foo12 + putStrLn (showD1 (risky (MkD1 11))) -- bar11 + print (risky (MkD1 12) :: D2) -- bar12 diff --git a/testsuite/tests/ghci/should_run/T22958b.stdout b/testsuite/tests/ghci/should_run/T22958b.stdout new file mode 100644 index 0000000000..63f2383a2f --- /dev/null +++ b/testsuite/tests/ghci/should_run/T22958b.stdout @@ -0,0 +1,4 @@ +MkD1 11 +MkD2 12 +MkD1 11 +MkD2 12 diff --git a/testsuite/tests/ghci/should_run/all.T b/testsuite/tests/ghci/should_run/all.T index aaa8dfe856..a748cc9fa6 100644 --- a/testsuite/tests/ghci/should_run/all.T +++ b/testsuite/tests/ghci/should_run/all.T @@ -88,3 +88,5 @@ test('UnliftedDataType2', just_ghci, compile_and_run, ['']) test('T22829', just_ghci + [extra_hc_opts("-Wmissing-import-lists -Werror")], compile_and_run, ['']) test('T23229', just_ghci + [extra_hc_opts("-this-unit-id my-package -Wno-missing-methods T23229")], ghci_script, ['T23229.script']) +test('T22958a', just_ghci, compile_and_run, ['']) +test('T22958b', just_ghci, compile_and_run, ['']) |