Small host execution ergos

This commit is contained in:
2026-05-09 18:18:25 -05:00
parent 2773109b87
commit d0886ad886
4 changed files with 510 additions and 26 deletions

View File

@@ -2734,4 +2734,65 @@ manifestReadingTests = testGroup "Manifest Reading Tests"
let env = evalTricu library (parseTricu input)
let algoT = result env
toString algoT @?= Right "sha256"
, testCase "readArboricxExecutable: reconstructs default export tree" $ do
(srcConn, termHash, originalTerm) <- storeTermInTempDB $ unlines
[ "main = t t" ]
wireData <- exportBundle srcConn [termHash]
let input = "matchResult "
++ " (code rest : err code rest) "
++ " (tree rest : ok tree []) "
++ " (readArboricxExecutable " ++ bytesExpr (map toInteger $ BS.unpack wireData) ++ ")"
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT originalTerm (bytesT [])
close srcConn
, testCase "readArboricxExecutableByName: selects named export" $ do
srcConn <- newContentStore
let parsed = parseTricu $ unlines
[ "leaf = t"
, "stem = t t"
, "main = stem"
]
env = evalTricu Map.empty parsed
leafTerm = maybe (error "leaf missing") id (Map.lookup "leaf" env)
stemTerm = maybe (error "stem missing") id (Map.lookup "stem" env)
leafHash <- storeTerm srcConn ["leaf"] leafTerm
stemHash <- storeTerm srcConn ["stem"] stemTerm
wireData <- exportNamedBundle srcConn [("leaf", leafHash), ("stem", stemHash)]
let input = "matchResult "
++ " (code rest : err code rest) "
++ " (tree rest : ok tree []) "
++ " (readArboricxExecutableByName " ++ bytesExpr (map (fromIntegral . fromEnum) "stem") ++ " " ++ bytesExpr (map toInteger $ BS.unpack wireData) ++ ")"
library <- evaluateFile "./lib/arboricx.tri"
let resultEnv = evalTricu library (parseTricu input)
result resultEnv @?= okT stemTerm (bytesT [])
close srcConn
, testCase "runArboricx: applies host-provided argument to default export" $ do
(srcConn, termHash, _) <- storeTermInTempDB $ unlines
[ "main = (x : x)" ]
wireData <- exportBundle srcConn [termHash]
let input = "matchResult "
++ " (code rest : err code rest) "
++ " (value rest : value) "
++ " (runArboricx " ++ bytesExpr (map toInteger $ BS.unpack wireData) ++ " \"hello\")"
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
toString (result env) @?= Right "hello"
close srcConn
, testCase "runArboricxArgs: applies host-provided argument list in order" $ do
(srcConn, termHash, _) <- storeTermInTempDB $ unlines
[ "main = (x y : x)" ]
wireData <- exportBundle srcConn [termHash]
let input = "matchResult "
++ " (code rest : err code rest) "
++ " (value rest : value) "
++ " (runArboricxArgs " ++ bytesExpr (map toInteger $ BS.unpack wireData) ++ " [(\"left\") (\"right\")])"
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
toString (result env) @?= Right "left"
close srcConn
]