diff options
-rw-r--r-- | testsuite/tests/simplCore/should_compile/T22347.hs | 20 | ||||
-rw-r--r-- | testsuite/tests/simplCore/should_compile/T22347a.hs | 20 | ||||
-rw-r--r-- | testsuite/tests/simplCore/should_compile/all.T | 2 |
3 files changed, 42 insertions, 0 deletions
diff --git a/testsuite/tests/simplCore/should_compile/T22347.hs b/testsuite/tests/simplCore/should_compile/T22347.hs new file mode 100644 index 0000000000..727eedf8db --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T22347.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module M where + +import Control.Monad.ST +import Data.Array.ST +import Data.Array.Unboxed + +bfs :: Array Int [Int] -> ST s (STArray s Int ()) +bfs g = do + vis :: STArray s Int () <- newArray (bounds g) () + ch :: STArray s Int () <- newArray (bounds g) () + let go [] = pure () :: ST s () + go q = do + flip mapM_ q $ \u -> do + readArray vis (head (g!u)) + readArray ch u + writeArray ch u () + go [] + go [] + pure ch diff --git a/testsuite/tests/simplCore/should_compile/T22347a.hs b/testsuite/tests/simplCore/should_compile/T22347a.hs new file mode 100644 index 0000000000..727eedf8db --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T22347a.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module M where + +import Control.Monad.ST +import Data.Array.ST +import Data.Array.Unboxed + +bfs :: Array Int [Int] -> ST s (STArray s Int ()) +bfs g = do + vis :: STArray s Int () <- newArray (bounds g) () + ch :: STArray s Int () <- newArray (bounds g) () + let go [] = pure () :: ST s () + go q = do + flip mapM_ q $ \u -> do + readArray vis (head (g!u)) + readArray ch u + writeArray ch u () + go [] + go [] + pure ch diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index 9f21bd4178..5d80e76d58 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -437,6 +437,8 @@ test('T22097', [grep_errmsg(r'case.*wgoEven') ], multimod_compile, ['T22097', '- test('T13873', [ grep_errmsg(r'SPEC') ], compile, ['-O -ddump-rules']) test('T22357', normal, compile, ['-O']) +test('T22347', normal, compile, ['-O -fno-full-laziness']) +test('T22347a', normal, compile, ['-O2 -fno-full-laziness']) # T17366: expecting to see a rule # Rule fired: SPEC/T17366 f @(Tagged tag) @_ (T17366) |