diff --git a/src/Language/Wasm/Binary.hs b/src/Language/Wasm/Binary.hs index 1c798ac..f05f6fe 100644 --- a/src/Language/Wasm/Binary.hs +++ b/src/Language/Wasm/Binary.hs @@ -17,6 +17,7 @@ import Data.Bits import Data.Word (Word8, Word32, Word64) import Data.Int (Int8, Int32, Int64) import Data.Serialize +import Control.Monad (when) import Data.Primitive.ByteArray as BA import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS @@ -340,6 +341,7 @@ instance Serialize MemArg where put MemArg { align, offset } = putULEB128 align >> putULEB128 offset get = do align <- getULEB128 32 + when (align >= 32) $ fail "malformed memop flags" offset <- getULEB128 32 return $ MemArg { align, offset } diff --git a/src/Language/Wasm/Validate.hs b/src/Language/Wasm/Validate.hs index 7d35645..e13126b 100644 --- a/src/Language/Wasm/Validate.hs +++ b/src/Language/Wasm/Validate.hs @@ -193,10 +193,13 @@ getLabel lbl = do withLabel :: [ValueType] -> Checker a -> Checker a withLabel result = withReaderT (\ctx -> ctx { labels = result : labels ctx }) -isMemArgValid :: Int -> MemArg -> Checker () -isMemArgValid sizeInBytes MemArg { align } = if 2 ^ align <= sizeInBytes then return () else throwError AlignmentOverflow +isMemArgValid :: Natural -> MemArg -> Checker () +isMemArgValid sizeInBytes MemArg { align } = + if 2 ^ align <= sizeInBytes + then return () + else throwError AlignmentOverflow -checkMemoryInstr :: Int -> MemArg -> Checker () +checkMemoryInstr :: Natural -> MemArg -> Checker () checkMemoryInstr size memarg = do isMemArgValid size memarg Ctx { mems } <- ask diff --git a/tests/Test.hs b/tests/Test.hs index 5412560..2a08dbe 100644 --- a/tests/Test.hs +++ b/tests/Test.hs @@ -19,7 +19,7 @@ main = do files <- filter (List.isSuffixOf ".wast") <$> Directory.listDirectory "tests/spec" - -- let files = ["table_grow.wast"] + -- let files = ["align.wast"] scriptTestCases <- (`mapM` files) $ \file -> do test <- LBS.readFile ("tests/spec/" ++ file) return $ testCase file $ do