GitHub/haskell-wasm
1
0
Fork 1
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

implemented assert_unlinkable assertion

Browse Source
This commit is contained in:
Ilya Rezvov
2018-04-19 13:32:07 -07:00
parent 1720730df5
commit a7962d69c2
2 changed files with 46 additions and 35 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Language/Wasm/Interpreter.hs
+33 -33
View File
@@ -321,25 +321,24 @@ emptyModInstance = ModuleInstance {
exports = Vector.empty exports = Vector.empty
} }
calcInstance :: Store -> Imports -> Module -> ModuleInstance calcInstance :: Store -> Imports -> Module -> Either String ModuleInstance
calcInstance (Store fs ts ms gs) imps Module {functions, types, tables, mems, globals, exports, imports} = calcInstance (Store fs ts ms gs) imps Module {functions, types, tables, mems, globals, exports, imports} = do
let funLen = length fs in let funLen = length fs
let tableLen = length ts in let tableLen = length ts
let memLen = length ms in let memLen = length ms
let globalLen = length gs in let globalLen = length gs
let getImpIdx (Import m n _) = let getImpIdx (Import m n _) =
case Map.lookup (m, n) imps of case Map.lookup (m, n) imps of
Just idx -> idx Just idx -> Right idx
Nothing -> error $ "Cannot find import from module " ++ show m ++ " with name " ++ show n Nothing -> Left $ "Cannot find import from module " ++ show m ++ " with name " ++ show n
in funImps <- mapM getImpIdx $ filter isFuncImport imports
let funImps = map getImpIdx $ filter isFuncImport imports in tableImps <- mapM getImpIdx $ filter isTableImport imports
let tableImps = map getImpIdx $ filter isTableImport imports in memImps <- mapM getImpIdx $ filter isMemImport imports
let memImps = map getImpIdx $ filter isMemImport imports in globalImps <- mapM getImpIdx $ filter isGlobalImport imports
let globalImps = map getImpIdx $ filter isGlobalImport imports in let funs = Vector.fromList $ map (\(ExternFunction i) -> i) funImps ++ [funLen..funLen + length functions - 1]
let funs = Vector.fromList $ map (\(ExternFunction i) -> i) funImps ++ [funLen..funLen + length functions - 1] in let tbls = Vector.fromList $ map (\(ExternTable i) -> i) tableImps ++ [tableLen..tableLen + length tables - 1]
let tbls = Vector.fromList $ map (\(ExternTable i) -> i) tableImps ++ [tableLen..tableLen + length tables - 1] in let memories = Vector.fromList $ map (\(ExternMemory i) -> i) memImps ++ [memLen..memLen + length mems - 1]
let memories = Vector.fromList $ map (\(ExternMemory i) -> i) memImps ++ [memLen..memLen + length mems - 1] in let globs = Vector.fromList $ map (\(ExternGlobal i) -> i) globalImps ++ [globalLen..globalLen + length globals - 1]
let globs = Vector.fromList $ map (\(ExternGlobal i) -> i) globalImps ++ [globalLen..globalLen + length globals - 1] in
let let
refExport (Export name (ExportFunc idx)) = refExport (Export name (ExportFunc idx)) =
ExportInstance name $ ExternFunction $ funs ! fromIntegral idx ExportInstance name $ ExternFunction $ funs ! fromIntegral idx
@@ -349,8 +348,7 @@ calcInstance (Store fs ts ms gs) imps Module {functions, types, tables, mems, gl
ExportInstance name $ ExternMemory $ memories ! fromIntegral idx ExportInstance name $ ExternMemory $ memories ! fromIntegral idx
refExport (Export name (ExportGlobal idx)) = refExport (Export name (ExportGlobal idx)) =
ExportInstance name $ ExternGlobal $ globs ! fromIntegral idx ExportInstance name $ ExternGlobal $ globs ! fromIntegral idx
in return $ ModuleInstance {
ModuleInstance {
funcTypes = Vector.fromList types, funcTypes = Vector.fromList types,
funcaddrs = funs, funcaddrs = funs,
tableaddrs = tbls, tableaddrs = tbls,
@@ -493,20 +491,22 @@ initialize inst Module {elems, datas, start} store = do
mem' <- newIORef $ MemoryInstance mem maxLen mem' <- newIORef $ MemoryInstance mem maxLen
return $ st { memInstances = memInstances st // [(idx, mem')] } return $ st { memInstances = memInstances st // [(idx, mem')] }
instantiate :: Store -> Imports -> Module -> IO (ModuleInstance, Store) instantiate :: Store -> Imports -> Module -> IO (Either String (ModuleInstance, Store))
instantiate st imps m = do instantiate st imps m =
let inst = calcInstance st imps m case calcInstance st imps m of
let functions = funcInstances st <> (allocFunctions inst $ Struct.functions m) Left err -> return $ Left err
globals <- (globalInstances st <>) <$> (allocAndInitGlobals inst st $ Struct.globals m) Right inst -> do
let tables = tableInstances st <> (allocTables $ Struct.tables m) let functions = funcInstances st <> (allocFunctions inst $ Struct.functions m)
mems <- (memInstances st <>) <$> (allocMems $ Struct.mems m) globals <- (globalInstances st <>) <$> (allocAndInitGlobals inst st $ Struct.globals m)
st' <- initialize inst m $ st { let tables = tableInstances st <> (allocTables $ Struct.tables m)
funcInstances = functions, mems <- (memInstances st <>) <$> (allocMems $ Struct.mems m)
tableInstances = tables, st' <- initialize inst m $ st {
memInstances = mems, funcInstances = functions,
globalInstances = globals tableInstances = tables,
} memInstances = mems,
return (inst, st') globalInstances = globals
}
return $ return (inst, st')
type Stack = [Value] type Stack = [Value]
src/Language/Wasm/Script.hs
+13 -2
View File
@@ -95,8 +95,10 @@ runScript onAssertFail script = do
addModule ident m st = addModule ident m st =
case Validate.validate m of case Validate.validate m of
Validate.Valid -> do Validate.Valid -> do
(modInst, store') <- Interpreter.instantiate (store st) (buildImports st) m res <- Interpreter.instantiate (store st) (buildImports st) m
return $ addToStore ident modInst $ st { lastModule = Just modInst, store = store' } case res of
Right (modInst, store') -> return $ addToStore ident modInst $ st { lastModule = Just modInst, store = store' }
Left reason -> error $ "Module instantiation failed dut to invalid module with reason: " ++ show reason
reason -> error $ "Module instantiation failed dut to invalid module with reason: " ++ show reason reason -> error $ "Module instantiation failed dut to invalid module with reason: " ++ show reason
getModule :: ScriptState -> Maybe Ident -> Maybe Interpreter.ModuleInstance getModule :: ScriptState -> Maybe Ident -> Maybe Interpreter.ModuleInstance
@@ -206,6 +208,15 @@ runScript onAssertFail script = do
case Binary.decodeModuleLazy binaryRep of case Binary.decodeModuleLazy binaryRep of
Right _ -> onAssertFail ("Module decoding should fail with failure string " ++ show failureString) assert Right _ -> onAssertFail ("Module decoding should fail with failure string " ++ show failureString) assert
Left _ -> return () Left _ -> return ()
runAssert st assert@(AssertUnlinkable moduleDef failureString) =
let (_, m) = buildModule moduleDef in
case Validate.validate m of
Validate.Valid -> do
res <- Interpreter.instantiate (store st) (buildImports st) m
case res of
Left err -> return ()
Right _ -> onAssertFail ("Module linking should fail with failure string " ++ show failureString) assert
reason -> error $ "Module linking failed dut to invalid module with reason: " ++ show reason
runAssert _ _ = return () runAssert _ _ = return ()
runCommand :: ScriptState -> Command -> IO ScriptState runCommand :: ScriptState -> Command -> IO ScriptState