Commit 2191ad85 authored by Ben Gamari's avatar Ben Gamari 🐢

testsuite: Add test for #16846

(cherry picked from commit 1faf4982)
parent 5e0f7f93
{-# LANGUAGE CPP #-}
{-# LANGUAGE ExistentialQuantification #-}
module Main (main) where
import Control.Concurrent.STM
data Free f a = Pure a | Free (f (Free f a))
data SuspendF a
= forall r. StepSTM (STM r)
| forall r. StepIO (IO r)
effect :: STM a -> Free SuspendF a
effect a = Free $ StepSTM a
io :: IO a -> Free SuspendF a
io a = Free $ StepIO a
comb :: [Free SuspendF a] -> Free SuspendF a
comb vs = io $ do
_ <- mapM go vs
undefined
go :: Free SuspendF a -> IO (STM ())
go (Free (StepIO a)) = a >>= \_ -> go $ Pure undefined
go (Free (StepSTM a)) = pure $ a >>= \_ -> pure ()
go (Pure _) = pure $ pure ()
runWidget :: Free SuspendF a -> IO a
runWidget w = case w of
Free (StepIO io) -> do
_ <- io
undefined
-- Uncommenting this hid the original bug.
--main :: IO ()
main = runWidget $ comb $ replicate 10000000 (effect retry)
T16846: Prelude.undefined
CallStack (from HasCallStack):
error, called at libraries/base/GHC/Err.hs:80:14 in base:GHC.Err
undefined, called at T16846.hs:22:3 in main:Main
......@@ -193,3 +193,4 @@ test('T15892',
extra_run_opts('+RTS -G1 -A32k -RTS') ],
compile_and_run, ['-O'])
test('T16449_2', exit_code(0), compile_and_run, [''])
test('T16846', [only_ways(['optasm']), exit_code(1)], compile_and_run, [''])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment