Attach contracts to definitions
Contracts now live directly on definitions via @ / =@ annotations and
travel automatically with exported values.
- Remove !export from lexer/parser/AST/evaluator/manifest/resolver and CLI.
- Simplify workspace module export logic: export all top-level local
definitions by default.
- Update Frontend.ContractDesugar:
- Named binder annotations (x@nat?) expand to per-argument withContract.
- Phantom annotations (@nat?) expand to a local raw helper plus a wrapper,
keeping fixed points shared and only depending on withContract.
- Merge lib/guardedBase.tri into lib/base.tri and annotate partial/sensitive
base functions: head, tail, last, add, sub, mul, div, mod, pow, min,
max, length, sum, product.
- Add check contract helper to lib/base.tri.
- Update demos/contractBasics.tri and README to reflect @/=@-only design.
- Update test suite: remove guardedBase import, replace explicit !export
test with a test verifying that contract annotations on an exported
definition are enforced on import.
- Fix remaining base.tri definitions (div/mod/pow) to stay point-free.
This commit is contained in:
42
test/Spec.hs
42
test/Spec.hs
@@ -19,7 +19,7 @@ import qualified Network.Socket as NS
|
||||
import Control.Monad (forM, forM_)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import System.IO.Temp (withSystemTempDirectory)
|
||||
import System.Directory (createDirectory, doesFileExist, doesDirectoryExist, listDirectory)
|
||||
import System.Directory (createDirectory, doesFileExist, doesDirectoryExist, listDirectory, getCurrentDirectory)
|
||||
import System.FilePath ((</>))
|
||||
import Data.Bits (xor)
|
||||
import Data.Char (digitToInt)
|
||||
@@ -58,8 +58,7 @@ allTestLibsEnv = unsafePerformIO $ do
|
||||
io <- evaluateFile "./lib/io.tri"
|
||||
sock <- evaluateFile "./lib/socket.tri"
|
||||
intensional <- evaluateFile "./lib/intensionalContracts.tri"
|
||||
guarded <- evaluateFile "./lib/guardedBase.tri"
|
||||
pure (Map.unions [base, bytes, bin, http, arbor, io, sock, intensional, guarded])
|
||||
pure (Map.unions [base, bytes, bin, http, arbor, io, sock, intensional])
|
||||
{-# NOINLINE allTestLibsEnv #-}
|
||||
|
||||
tests :: TestTree
|
||||
@@ -1678,7 +1677,7 @@ demos = testGroup "Test provided demo functionality"
|
||||
decodeResult res @?= "[t t, 10]"
|
||||
, testCase "Safe base wrappers demo" $ do
|
||||
res <- liftIO $ evaluateFileResult "./demos/contractBasics.tri"
|
||||
decodeResult res @?= "[t t, 1]"
|
||||
decodeResult res @?= "[3, t t, t, t t]"
|
||||
]
|
||||
|
||||
decoding :: TestTree
|
||||
@@ -1942,7 +1941,6 @@ contentStoreTests = testGroup "Content Store Tests"
|
||||
"main"
|
||||
(ObjectRef (unDomain treeTermDomain) root)
|
||||
"arboricx.abi.tree.v1"
|
||||
Nothing
|
||||
]
|
||||
root <- putTreeTerm store term
|
||||
h <- putManifest store (manifestFor root)
|
||||
@@ -1959,7 +1957,6 @@ contentStoreTests = testGroup "Content Store Tests"
|
||||
"value"
|
||||
(ObjectRef (unDomain treeTermDomain) termH)
|
||||
"arboricx.abi.tree.v1"
|
||||
Nothing
|
||||
]
|
||||
manifestBytes = encodeManifest manifest
|
||||
manifestH = hashObject manifestDomain manifestBytes
|
||||
@@ -2013,32 +2010,20 @@ contentStoreTests = testGroup "Content Store Tests"
|
||||
Nothing -> assertFailure "expected workspace module manifest"
|
||||
Just manifest -> map moduleExportName (moduleManifestExports manifest) @?= ["value"]
|
||||
|
||||
, testCase "Workspace modules: explicit !export with contract" $
|
||||
withSystemTempDirectory "tricu-workspace-explicit-export" $ \dir -> do
|
||||
, testCase "Workspace modules: contract annotations travel with exported definitions" $
|
||||
withSystemTempDirectory "tricu-workspace-contract-export" $ \dir -> do
|
||||
let store = StorePath (dir </> "store")
|
||||
libPath = dir </> "util.tri"
|
||||
mainPath = dir </> "main.tri"
|
||||
writeFile (dir </> "tricu.workspace") "module util = util.tri\n"
|
||||
writeFile libPath "alwaysOk = (x : x)\n\naddOne x = x\n!export addOne : alwaysOk\n"
|
||||
writeFile mainPath "!import \"util\" Util\n\nmain = Util.addOne 5\n"
|
||||
cwd <- getCurrentDirectory
|
||||
writeFile (dir </> "tricu.workspace") ("module base = \"" ++ cwd </> "lib/base.tri\"\nmodule util = \"" ++ dir </> "util.tri\"\n")
|
||||
writeFile libPath "!import \"base\" !Local\n\nalwaysOk = (value rest : ok value rest)\n\nneverOk = (value rest : err \"nope\" rest)\n\nsafeId n@alwaysOk =@alwaysOk n\n\nbadId n@neverOk =@neverOk n\n"
|
||||
writeFile mainPath "!import \"util\" Util\n\nmain = Util.safeId 5\n"
|
||||
env <- evaluateFileWithStore (Just store) mainPath
|
||||
result env @?= ofNumber 5
|
||||
mAlias <- readAlias store ModuleAlias "util"
|
||||
case mAlias of
|
||||
Nothing -> assertFailure "expected workspace build to write util module alias"
|
||||
Just ref -> do
|
||||
mManifest <- getManifest store (objectRefHash ref)
|
||||
case mManifest of
|
||||
Nothing -> assertFailure "expected workspace module manifest"
|
||||
Just manifest -> do
|
||||
map moduleExportName (moduleManifestExports manifest) @?= ["addOne"]
|
||||
case moduleManifestExports manifest of
|
||||
[ex] -> do
|
||||
assertBool "expected contract ref" (moduleExportContract ex /= Nothing)
|
||||
case moduleExportContract ex of
|
||||
Just cref -> objectRefKind cref @?= unDomain treeTermDomain
|
||||
Nothing -> assertFailure "expected contract ref"
|
||||
_ -> assertFailure "expected exactly one export"
|
||||
writeFile mainPath "!import \"util\" Util\n\nmain = Util.badId 5\n"
|
||||
envFail <- evaluateFileWithStore (Just store) mainPath
|
||||
decodeResult (result envFail) @?= "\"nope\""
|
||||
|
||||
, testCase "Module imports: resolve manifest exports from store" $
|
||||
withSystemTempDirectory "tricu-module-import" $ \dir -> do
|
||||
@@ -2050,7 +2035,6 @@ contentStoreTests = testGroup "Content Store Tests"
|
||||
"value"
|
||||
(ObjectRef (unDomain treeTermDomain) root)
|
||||
"arboricx.abi.tree.v1"
|
||||
Nothing
|
||||
]
|
||||
root <- putTreeTerm store term
|
||||
manifestHash <- putManifest store (manifestFor root)
|
||||
@@ -2083,7 +2067,7 @@ contentStoreTests = testGroup "Content Store Tests"
|
||||
, testCase "Module resolver diagnostics: missing tree term names export and hash" $ do
|
||||
let root = "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
|
||||
manifest = ModuleManifest []
|
||||
[ ModuleExport "value" (ObjectRef (unDomain treeTermDomain) root) "arboricx.abi.tree.v1" Nothing ]
|
||||
[ ModuleExport "value" (ObjectRef (unDomain treeTermDomain) root) "arboricx.abi.tree.v1" ]
|
||||
resolver = ObjectResolver
|
||||
{ resolverAlias = \kind name -> return $ if kind == ModuleAlias && name == "demo"
|
||||
then Just (ObjectRef (unDomain manifestDomain) "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb")
|
||||
|
||||
Reference in New Issue
Block a user