Commit 5a3b96af authored by Simon Peyton Jones's avatar Simon Peyton Jones

Test Trac #4935

parent b5c2c311
......@@ -36,3 +36,9 @@ T4918:
EvalTest:
'$(TEST_HC)' -c -O EvalTest.hs -ddump-simpl -dsuppress-uniques | grep 'rght.*Dmd'
# When SpecConstr works there are no STUArrays at all
# The "-(...)" ignores the (expected) non-zero exit code from grep
# when there are (as expected) no matches
T4945:
-('$(TEST_HC)' -c -O2 -fno-liberate-case T4945.hs -ddump-simpl -dsuppress-uniques | grep 'STUArray')
module Main where
import Data.Int
import Data.Array.Base
import Data.Array.ST
import Control.Monad.ST
import System.Environment
main :: IO ()
main = do
[_nr, _len] <- getArgs
let nRounds = read _nr :: Int
len = read _len :: Int
stToIO $ do
arr <- newArray (1, len) 0
let spin :: STUArray s Int Int -> Int -> Int -> Int -> ST s ()
spin _ r i n | i > n = return ()
spin arr r i n = do x <- unsafeRead arr i
unsafeWrite arr i $ x + r
spin arr r (i + 1) n
loop :: STUArray s Int Int -> Int -> ST s ()
loop _ r | r > nRounds = return ()
loop arr r = do
k <- getNumElements arr
spin arr r 0 (k - 1)
loop arr (r + 1)
loop arr 1
......@@ -106,3 +106,8 @@ test('T4918',
normal,
run_command,
['$MAKE -s --no-print-directory T4918'])
test('T4945',
normal,
run_command,
['$MAKE -s --no-print-directory T4945'])
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment