fix validator for new elems

This commit is contained in:
Ilya Rezvov
2022-02-09 21:49:03 -07:00
parent c08e81fa40
commit 286ee40489
+13 -17
View File
@@ -19,7 +19,7 @@ import Data.Maybe (fromMaybe, maybeToList, catMaybes)
import Numeric.Natural (Natural) import Numeric.Natural (Natural)
import Prelude hiding ((<>)) import Prelude hiding ((<>))
import Control.Monad (foldM) import Control.Monad (foldM, forM_, when, unless)
import Control.Monad.Reader (ReaderT, runReaderT, withReaderT, ask) import Control.Monad.Reader (ReaderT, runReaderT, withReaderT, ask)
import Control.Monad.Except (Except, runExcept, throwError) import Control.Monad.Except (Except, runExcept, throwError)
@@ -569,24 +569,20 @@ elemsShouldBeValid m@Module { elems, functions, tables, imports } =
foldMap (isElemValid ctx) elems foldMap (isElemValid ctx) elems
where where
isElemValid :: Ctx -> ElemSegment -> ValidationResult isElemValid :: Ctx -> ElemSegment -> ValidationResult
isElemValid ctx (ElemSegment tableIdx offset funs) = isElemValid ctx (ElemSegment elemType mode elements) = do
let check = runChecker ctx $ do forM_ elements $ \elem -> runChecker ctx $ do
getExpressionType elem
isConstExpression elem
case mode of
Active tableIdx offset -> runChecker ctx $ do
isConstExpression offset isConstExpression offset
t <- getExpressionType offset t <- getExpressionType offset
if isArrowMatch (empty ==> I32) t unless (isArrowMatch (empty ==> I32) t) $ do
then return () throwError $ TypeMismatch t (empty ==> I32)
else throwError $ TypeMismatch t (empty ==> I32) let tableImports = filter isTableImport imports
in when (tableIdx >= fromIntegral (length tableImports + length tables)) $ do
let tableImports = filter isTableImport imports in throwError $ TableIndexOutOfRange tableIdx
let isTableIndexValid = _ -> return ()
if tableIdx < (fromIntegral $ length tableImports + length tables)
then return ()
else Left (TableIndexOutOfRange tableIdx)
in
let funImports = filter isFuncImport imports in
let funsLength = fromIntegral $ length functions + length funImports in
let isFunsValid = foldMap (\i -> if i < funsLength then return () else Left FunctionIndexOutOfRange) funs in
check <> isFunsValid <> isTableIndexValid
datasShouldBeValid :: Validator datasShouldBeValid :: Validator
datasShouldBeValid m@Module { datas, mems, imports } = datasShouldBeValid m@Module { datas, mems, imports } =