diff options
| -rw-r--r-- | testsuite/tests/simplCore/should_run/T14178.hs | 33 | ||||
| -rw-r--r-- | testsuite/tests/simplCore/should_run/T14178.stdout | 2 | ||||
| -rw-r--r-- | testsuite/tests/simplCore/should_run/all.T | 1 |
3 files changed, 36 insertions, 0 deletions
diff --git a/testsuite/tests/simplCore/should_run/T14178.hs b/testsuite/tests/simplCore/should_run/T14178.hs new file mode 100644 index 0000000000..ef76324994 --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T14178.hs @@ -0,0 +1,33 @@ +import System.Exit +import Control.Monad.Trans.State.Strict + +eval :: Int -> State Int a -> a +eval p = fst . flip runState p + +advance :: Int -> State Int () +advance = modify' . (+) + +loc :: State Int Int +loc = get + +emit1 :: State Int () +emit1 = advance 1 + +emitN :: Int -> State Int () +-- adding in the 0 case, breaks with HEAD. 8.2.1 is fine with it. +-- emitN 0 = advance 0 +emitN 0 = pure () +emitN n = advance n + +align8 :: State Int () +align8 = do + bits <- (`mod` 8) <$> loc + emitN (8 - bits) + +main :: IO () +main = do + let p = eval 0 (emit1 >> align8 >> loc) + putStrLn $ show p + if p == 8 + then putStrLn "OK" >> exitSuccess + else putStrLn "FAIL" >> exitFailure diff --git a/testsuite/tests/simplCore/should_run/T14178.stdout b/testsuite/tests/simplCore/should_run/T14178.stdout new file mode 100644 index 0000000000..f91f66e37e --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T14178.stdout @@ -0,0 +1,2 @@ +8 +OK diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T index 75ff431910..4ba5a71e94 100644 --- a/testsuite/tests/simplCore/should_run/all.T +++ b/testsuite/tests/simplCore/should_run/all.T @@ -77,3 +77,4 @@ test('T13733', expect_broken(13733), compile_and_run, ['']) test('T13429', normal, compile_and_run, ['']) test('T13429_2', normal, compile_and_run, ['']) test('T13750', normal, compile_and_run, ['']) +test('T14178', normal, compile_and_run, ['']) |