diff options
| author | Ben Gamari <bgamari.foss@gmail.com> | 2018-03-25 14:00:12 -0400 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2018-03-25 14:33:27 -0400 |
| commit | 7bb1fde13be3b319bb567b1faa84436600aa47ab (patch) | |
| tree | 8209c94f02fc335036c39a7e7270558004d21a0d /testsuite/tests/profiling | |
| parent | ceb914771aece0aa6d87339227ce406c7179d1d1 (diff) | |
| download | haskell-7bb1fde13be3b319bb567b1faa84436600aa47ab.tar.gz | |
testsuite: Add test for #14931
Reviewers: alpmestan
Reviewed By: alpmestan
Subscribers: rwbarton, thomie, carter
GHC Trac Issues: #14931
Differential Revision: https://phabricator.haskell.org/D4518
Diffstat (limited to 'testsuite/tests/profiling')
4 files changed, 45 insertions, 0 deletions
diff --git a/testsuite/tests/profiling/should_compile/Makefile b/testsuite/tests/profiling/should_compile/Makefile index 9101fbd40a..012890aa9d 100644 --- a/testsuite/tests/profiling/should_compile/Makefile +++ b/testsuite/tests/profiling/should_compile/Makefile @@ -1,3 +1,8 @@ TOP=../../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk + +T14931: + "$(TEST_HC)" $(TEST_HC_OPTS) -v0 -c -O -static -dynamic-too -dynosuf dyn_o -dynhisuf dyn_hi T14931_State.hs + "$(TEST_HC)" $(TEST_HC_OPTS) -v0 -c -O -prof -osuf p_o -hisuf p_hi T14931_State.hs + "$(TEST_HC)" $(TEST_HC_OPTS) -v0 -c -O -prof -osuf p_o -hisuf p_hi T14931_Bug.hs diff --git a/testsuite/tests/profiling/should_compile/T14931_Bug.hs b/testsuite/tests/profiling/should_compile/T14931_Bug.hs new file mode 100644 index 0000000000..4e6f2136a8 --- /dev/null +++ b/testsuite/tests/profiling/should_compile/T14931_Bug.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TemplateHaskell #-} +module T14931_Bug where + +import Prelude (Int, IO, Bool(..), Num(..), Monad(..), not, print) +import qualified Language.Haskell.TH.Syntax as TH +import T14931_State + +wat :: IO () +wat = print $(let playGame [] = do + (_, score) <- get + return score + playGame (x:xs) = do + (on, score) <- get + case x of + 'a' | on -> put (on, score + 1) + 'b' | on -> put (on, score - 1) + 'c' -> put (not on, score) + _ -> put (on, score) + playGame xs + + startState :: (Bool, Int) + startState = (False, 0) + in TH.lift (evalState (playGame "abcaaacbbcabbab") startState) ) diff --git a/testsuite/tests/profiling/should_compile/T14931_State.hs b/testsuite/tests/profiling/should_compile/T14931_State.hs new file mode 100644 index 0000000000..9008c06a96 --- /dev/null +++ b/testsuite/tests/profiling/should_compile/T14931_State.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE UndecidableInstances #-} +module T14931_State (MonadState(..), Lazy.evalState) where + +import qualified Control.Monad.Trans.State.Lazy as Lazy (StateT, get, put, evalState) + +class Monad m => MonadState s m | m -> s where + get :: m s + put :: s -> m () + +instance Monad m => MonadState s (Lazy.StateT s m) where + get = Lazy.get + put = Lazy.put diff --git a/testsuite/tests/profiling/should_compile/all.T b/testsuite/tests/profiling/should_compile/all.T index 1ebcb07be4..4664658aab 100644 --- a/testsuite/tests/profiling/should_compile/all.T +++ b/testsuite/tests/profiling/should_compile/all.T @@ -6,3 +6,4 @@ test('prof002', [only_ways(['normal']), req_profiling], compile_and_run, ['-prof test('T2410', [only_ways(['normal']), req_profiling], compile, ['-O2 -prof -fprof-cafs']) test('T5889', [only_ways(['normal']), req_profiling, extra_files(['T5889/A.hs', 'T5889/B.hs'])], multimod_compile, ['A B', '-O -prof -fno-prof-count-entries -v0']) test('T12790', [only_ways(['normal']), req_profiling], compile, ['-O -prof']) +test('T14931', [only_ways(['normal']), req_profiling], run_command, ['$MAKE -s --no-print-directory T14931']) |