[commit: ghc] master: Add testcase for #14178 (8a1de42)
git at git.haskell.org
git at git.haskell.org
Fri Sep 1 14:58:37 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/8a1de424143f5b75e12976ca739e58fe04ae04d6/ghc
>---------------------------------------------------------------
commit 8a1de424143f5b75e12976ca739e58fe04ae04d6
Author: Ben Gamari <bgamari.foss at gmail.com>
Date: Fri Sep 1 10:52:47 2017 -0400
Add testcase for #14178
Reviewers: austin
Subscribers: rwbarton, thomie
GHC Trac Issues: #14178
Differential Revision: https://phabricator.haskell.org/D3905
>---------------------------------------------------------------
8a1de424143f5b75e12976ca739e58fe04ae04d6
testsuite/tests/simplCore/should_run/T14178.hs | 33 ++++++++++++++++++++++
.../should_run/T14178.stdout} | 1 +
testsuite/tests/simplCore/should_run/all.T | 1 +
3 files changed, 35 insertions(+)
diff --git a/testsuite/tests/simplCore/should_run/T14178.hs b/testsuite/tests/simplCore/should_run/T14178.hs
new file mode 100644
index 0000000..ef76324
--- /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/driver/T11763.stdout b/testsuite/tests/simplCore/should_run/T14178.stdout
similarity index 60%
copy from testsuite/tests/driver/T11763.stdout
copy to testsuite/tests/simplCore/should_run/T14178.stdout
index d86bac9..f91f66e 100644
--- a/testsuite/tests/driver/T11763.stdout
+++ b/testsuite/tests/simplCore/should_run/T14178.stdout
@@ -1 +1,2 @@
+8
OK
diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T
index 75ff431..4ba5a71 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, [''])
More information about the ghc-commits
mailing list