Several subtle IODriver bug fixes
This commit is contained in:
48
test/Spec.hs
48
test/Spec.hs
@@ -1809,16 +1809,56 @@ ioDriverTests = testGroup "IO driver tests"
|
||||
]
|
||||
final @?= ofString "child done"
|
||||
st @?= Leaf
|
||||
|
||||
-- Scheduler hardening tests
|
||||
, testCase "runIO rejects non-IO tree with sentinel error" $ do
|
||||
result <- runIO unsafePerms (ofString "not an io program")
|
||||
case result of
|
||||
Left _ -> return ()
|
||||
Right _ -> assertFailure "Expected Left for invalid sentinel"
|
||||
|
||||
, testCase "cyclic await returns error instead of hanging" $ do
|
||||
(final, _) <- runIOSourceWith unsafePerms Leaf Leaf $
|
||||
unlines
|
||||
[ "main = io (bind (fork (await (pair \"task\" 0))) (h :"
|
||||
, " await h))"
|
||||
]
|
||||
final @?= ioErrResult 63
|
||||
|
||||
, testCase "writeBytes and readFile roundtrip binary data" $
|
||||
withSystemTempDirectory "tricu-io-bytes" $ \dir -> do
|
||||
let path = dir ++ "/binary.bin"
|
||||
final <- runIOSource $
|
||||
unlines
|
||||
[ "main = io (bind (writeBytes \"" ++ path ++ "\" [(0) (255) (128) (1)])"
|
||||
, " (_ : readFile \"" ++ path ++ "\"))"
|
||||
]
|
||||
final @?= ioOkResult (ofBytes (BS.pack [0, 255, 128, 1]))
|
||||
|
||||
, testCase "stress test: many sleeping tasks complete promptly" $ do
|
||||
let n = 100
|
||||
build 0 = "pure \"done\""
|
||||
build k = "bind (fork (bind (sleep 1) (_ : pure \"x\"))) (h : bind (await h) (_ : " ++ build (k - 1) ++ "))"
|
||||
(final, _) <- runIOSourceWith unsafePerms Leaf Leaf ("main = io (" ++ build n ++ ")")
|
||||
final @?= ofString "done"
|
||||
|
||||
, testCase "long fork await loop does not leak" $ do
|
||||
let n = 200
|
||||
build 0 = "pure \"done\""
|
||||
build k = "bind (fork (pure \"x\")) (h : bind (await h) (_ : " ++ build (k - 1) ++ "))"
|
||||
(final, _) <- runIOSourceWith unsafePerms Leaf Leaf ("main = io (" ++ build n ++ ")")
|
||||
final @?= ofString "done"
|
||||
]
|
||||
|
||||
runIOSourceWith :: IOPermissions -> T -> T -> String -> IO (T, T)
|
||||
runIOSourceWith perms readerEnv initialState source = do
|
||||
ioEnv <- evaluateFile "./lib/io.tri"
|
||||
evalEnv <- evalTricuWithStore Nothing ioEnv (parseTricu source)
|
||||
case checkIOSentinel (mainResult evalEnv) of
|
||||
Right (1, action) -> runIOWith perms readerEnv initialState action
|
||||
Right (v, _) -> assertFailure ("Unsupported IO ABI version: " ++ show v)
|
||||
Left err -> assertFailure ("Expected IO sentinel: " ++ err)
|
||||
let fullTree = mainResult evalEnv
|
||||
result <- runIOWith perms readerEnv initialState fullTree
|
||||
case result of
|
||||
Left err -> assertFailure ("IO runtime error: " ++ err)
|
||||
Right pair -> pure pair
|
||||
|
||||
runIOSource :: String -> IO T
|
||||
runIOSource source = fmap fst $ runIOSourceWith unsafePerms Leaf Leaf source
|
||||
|
||||
Reference in New Issue
Block a user