diff options
author | Ben Gamari <ben@smart-cactus.org> | 2019-07-31 14:07:43 -0400 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2019-08-21 06:36:02 -0400 |
commit | 489916c6674f1445e0076f1e6d533696a4a9f6c6 (patch) | |
tree | e8bdc5ac045e0349f19e4b4b9b535cafc301328f | |
parent | a1e2f46101281e7ec046075241f34a72ba6ecab8 (diff) | |
download | haskell-489916c6674f1445e0076f1e6d533696a4a9f6c6.tar.gz |
testsuite: Add testsuite for #16978
(cherry picked from commit 3b31a94df4cf7e55d93dfcad9b96d0f49f4d3f8d)
-rw-r--r-- | testsuite/tests/simplCore/should_compile/T16978.hs | 29 | ||||
-rw-r--r-- | testsuite/tests/simplCore/should_compile/all.T | 1 |
2 files changed, 30 insertions, 0 deletions
diff --git a/testsuite/tests/simplCore/should_compile/T16978.hs b/testsuite/tests/simplCore/should_compile/T16978.hs new file mode 100644 index 0000000000..cf78013dfd --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T16978.hs @@ -0,0 +1,29 @@ +-- | Caused Core Lint failure due to floating of unlifted join point to the +-- top-level. +module Bug where + +import Control.Monad.Trans.State.Strict (State, modify') +import Data.Text (Text) +import qualified Data.Text.Lazy.Builder as B + +data Value = String !Text | Null + +type Render a = State B.Builder a + +tellBuilder :: B.Builder -> Render () +tellBuilder b' = modify' f where + f b = b <> b' + +renderNode :: Value -> Render () +renderNode v = + renderValue v >>= outputRaw + +outputRaw :: Text -> Render () +outputRaw = tellBuilder . B.fromText +{-# INLINE outputRaw #-} + +renderValue :: Value -> Render Text +renderValue v = case v of + String str -> return str + _ -> let x = x in x +{-# INLINE renderValue #-} diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index 3302daff0c..8d6799cbad 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -327,5 +327,6 @@ test('T15631', run_command, ['$MAKE -s --no-print-directory T15631']) test('T15673', normal, compile, ['-O']) +test('T16978', normal, compile, ['-O']) test('T16979a', normal, compile, ['-O']) test('T16979b', normal, compile, ['-O']) |