diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,10 @@ # Revision history for bytesmith +## 0.2.0.1 -- 2019-09-24 + +* Correct an overflow-detection mistake in the implementation + of machine-word parsers. + ## 0.2.0.0 -- 2019-09-24 * Add big-endian word parsers. diff --git a/bytesmith.cabal b/bytesmith.cabal --- a/bytesmith.cabal +++ b/bytesmith.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: bytesmith -version: 0.2.0.0 +version: 0.2.0.1 synopsis: Nonresumable byte parser description: Parse bytes as fast as possible. This is a nonresumable parser diff --git a/src/Data/Bytes/Parser/Latin.hs b/src/Data/Bytes/Parser/Latin.hs --- a/src/Data/Bytes/Parser/Latin.hs +++ b/src/Data/Bytes/Parser/Latin.hs @@ -72,7 +72,8 @@ import Data.Char (ord) import Data.Kind (Type) import GHC.Exts (Int(I#),Char(C#),Word#,Int#,Char#,(+#),(-#),indexCharArray#) -import GHC.Exts (TYPE,RuntimeRep) +import GHC.Exts (TYPE,RuntimeRep,int2Word#,or#) +import GHC.Exts (ltWord#,gtWord#,notI#) import GHC.Word (Word(W#),Word8(W8#),Word16(W16#),Word32(W32#)) import qualified GHC.Exts as Exts @@ -429,8 +430,11 @@ -> Int# -- Leading digit, should be between @0@ and @9@. -> Parser e s Int# decTrailingInt# e !w = - Parser (\chunk0 s0 -> (# s0, decPosIntMore e (I# w) (boxBytes chunk0) #)) + Parser (\chunk0 s0 -> (# s0, decPosIntMore e (W# (int2Word# w)) maxIntAsWord (boxBytes chunk0) #)) +maxIntAsWord :: Word +maxIntAsWord = fromIntegral (maxBound :: Int) + -- | Parse a decimal-encoded number. If the number is too large to be -- represented by a machine integer, this fails with the provided -- error message. This allows the number to optionally be prefixed @@ -455,7 +459,7 @@ (\chunk0 s0 -> let !w = char2Word c - 48 in if w < 10 - then (# s0, decPosIntMore e (fromIntegral @Word @Int w) (boxBytes chunk0) #) + then (# s0, decPosIntMore e w maxIntAsWord (boxBytes chunk0) #) else (# s0, (# e | #) #) ) @@ -470,7 +474,7 @@ (\chunk0 s0 -> let !w = char2Word c - 48 in if w < 10 - then (# s0, decPosIntMore e (fromIntegral @Word @Int w) (boxBytes chunk0) #) + then (# s0, decPosIntMore e w maxIntAsWord (boxBytes chunk0) #) else (# s0, (# e | #) #) ) @@ -526,7 +530,7 @@ let !w = fromIntegral @Word8 @Word (PM.indexByteArray (array chunk0) (offset chunk0)) - 48 in if w < 10 - then (# s0, decPosIntMore e (fromIntegral @Word @Int w) (Bytes.unsafeDrop 1 chunk0) #) + then (# s0, decPosIntMore e w maxIntAsWord (Bytes.unsafeDrop 1 chunk0) #) else (# s0, (# e | #) #) else (# s0, (# e | #) #) @@ -539,7 +543,12 @@ let !w = fromIntegral @Word8 @Word (PM.indexByteArray (array chunk0) (offset chunk0)) - 48 in if w < 10 - then (# s0, decNegIntMore e (negate (fromIntegral @Word @Int w)) (Bytes.unsafeDrop 1 chunk0) #) + then + case decPosIntMore e w (maxIntAsWord + 1) (Bytes.unsafeDrop 1 chunk0) of + (# | (# x, y, z #) #) -> + (# s0, (# | (# (notI# x +# 1# ), y, z #) #) #) + (# err | #) -> + (# s0, (# err | #) #) else (# s0, (# e | #) #) else (# s0, (# e | #) #) @@ -562,43 +571,26 @@ else (# s0, (# e | #) #) -- This will not inline since it is recursive, but worker --- wrapper will still happen. -decNegIntMore :: - e -- Error message - -> Int -- Accumulator - -> Bytes -- Chunk - -> Result# e Int# -decNegIntMore e !acc !chunk0 = if length chunk0 > 0 - then - let !w = fromIntegral @Word8 @Word - (PM.indexByteArray (array chunk0) (offset chunk0)) - 48 - !acc' = acc * 10 - (fromIntegral @Word @Int w) - in if w < 10 - then if acc' <= acc - then decNegIntMore e acc' (Bytes.unsafeDrop 1 chunk0) - else (# e | #) - else (# | (# unI acc, unI (offset chunk0), unI (length chunk0) #) #) - else (# | (# unI acc, unI (offset chunk0), 0# #) #) - --- This will not inline since it is recursive, but worker -- wrapper will still happen. Fails if the accumulator --- exceeds the size of a machine integer. +-- exceeds the upper bound. decPosIntMore :: e -- Error message - -> Int -- Accumulator + -> Word -- Accumulator, precondition: less than or equal to bound + -> Word -- Inclusive Upper Bound, either (2^63 - 1) or 2^63 -> Bytes -- Chunk -> Result# e Int# -decPosIntMore e !acc !chunk0 = if len > 0 +decPosIntMore e !acc !upper !chunk0 = if len > 0 then let !w = fromIntegral @Word8 @Word (PM.indexByteArray (array chunk0) (offset chunk0)) - 48 - !acc' = acc * 10 + (fromIntegral @Word @Int w) in if w < 10 - then if acc' >= acc - then decPosIntMore e acc' (Bytes.unsafeDrop 1 chunk0) - else (# e | #) - else (# | (# unI acc, unI (offset chunk0), len# #) #) - else (# | (# unI acc, unI (offset chunk0), 0# #) #) + then + let (overflow,acc') = positivePushBase10 acc w upper + in if overflow + then (# e | #) + else decPosIntMore e acc' upper (Bytes.unsafeDrop 1 chunk0) + else (# | (# unI (fromIntegral acc), unI (offset chunk0), len# #) #) + else (# | (# unI (fromIntegral acc), unI (offset chunk0), 0# #) #) where !len@(I# len# ) = length chunk0 @@ -724,3 +716,15 @@ uneffectfulWord# f = Parser ( \b s0 -> (# s0, (f (boxBytes b)) #) ) +-- Precondition: the arguments are non-negative. Boolean is +-- true when overflow happens. Performs: a * 10 + b +-- Postcondition: when overflow is false, the resulting +-- word is less than or equal to the upper bound +positivePushBase10 :: Word -> Word -> Word -> (Bool,Word) +positivePushBase10 (W# a) (W# b) (W# upper) = + let !(# ca, r0 #) = Exts.timesWord2# a 10## + !r1 = Exts.plusWord# r0 b + !cb = int2Word# (gtWord# r1 upper) + !cc = int2Word# (ltWord# r1 0##) + !c = ca `or#` cb `or#` cc + in (case c of { 0## -> False; _ -> True }, W# r1) diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -56,13 +56,33 @@ @=? P.parseBytes (Latin.decUnsignedInt ()) (bytes "4654667,55") + , testCase "C" $ + P.Failure () + @=? + P.parseBytes (Latin.decUnsignedInt ()) + (bytes ('1' : show (maxBound :: Int))) + , testCase "D" $ + P.Failure () + @=? + P.parseBytes (Latin.decUnsignedInt ()) + (bytes "2481030337885070917891") + , testCase "E" $ + P.Failure () + @=? + P.parseBytes (Latin.decUnsignedInt ()) + (bytes (show (fromIntegral @Int @Word maxBound + 1))) + , testCase "F" $ + P.Success maxBound 0 + @=? + P.parseBytes (Latin.decUnsignedInt ()) + (bytes (show (maxBound :: Int))) , testProperty "property" $ \(QC.NonNegative i) -> P.parseBytes (Latin.decUnsignedInt ()) (bytes (show i)) === P.Success i 0 ] , testGroup "decPositiveInteger" - [ testCase "A" $ + [ testCase "A" $ P.parseBytes (Latin.decUnsignedInteger ()) (bytes "5469999463123462573426452736423546373235260") @=? @@ -74,25 +94,89 @@ === P.Success i 0 ] + , testGroup "decTrailingInteger" + [ testProperty "property" $ \(LargeInteger i) -> + i >= 0 + QC.==> + P.parseBytes (Latin.decTrailingInteger 2) (bytes (show i)) + === + (P.Success (read ('2' : show i) :: Integer) 0 :: P.Result () Integer) + ] , testGroup "decSignedInteger" - [ testCase "A" $ + [ testCase "A" $ P.parseBytes (Latin.decSignedInteger ()) (bytes "-54699994631234625734264527364235463732352601") @=? P.Success (-54699994631234625734264527364235463732352601) 0 + , testCase "B" $ + P.Success (3,(-206173954435705292503)) 0 + @=? + P.parseBytes + ( pure (,) + <*> Latin.decSignedInteger () + <* Latin.char () 'e' + <*> Latin.decSignedInteger () + ) (bytes "3e-206173954435705292503") , testProperty "property" $ \(LargeInteger i) -> P.parseBytes (Latin.decSignedInteger ()) (bytes (show i)) === P.Success i 0 ] - , testProperty "decSignedInt-A" $ \i -> - P.parseBytes (Latin.decSignedInt ()) (bytes (show i)) === P.Success i 0 - , testProperty "decSignedInt-B" $ \i -> - P.parseBytes - (Latin.decSignedInt ()) - (bytes ((if i >= 0 then "+" else "") ++ show i)) - === - P.Success i 0 + , testGroup "decSignedInt" + [ testProperty "A" $ \i -> + P.parseBytes (Latin.decSignedInt ()) (bytes (show i)) + === + P.Success i 0 + , testProperty "B" $ \i -> + P.parseBytes + (Latin.decSignedInt ()) + (bytes ((if i >= 0 then "+" else "") ++ show i)) + === + P.Success i 0 + , testCase "C" $ + P.Failure () + @=? + P.parseBytes (Latin.decSignedInt ()) + (bytes ('1' : show (maxBound :: Int))) + , testCase "D" $ + P.Failure () + @=? + P.parseBytes (Latin.decSignedInt ()) + (bytes ('-' : '3' : show (maxBound :: Int))) + , testCase "E" $ + P.Failure () + @=? + P.parseBytes (Latin.decSignedInt ()) + (bytes "2481030337885070917891") + , testCase "F" $ + P.Failure () + @=? + P.parseBytes (Latin.decSignedInt ()) + (bytes "-4305030950553840988981") + , testCase "G" $ + P.Success minBound 0 + @=? + P.parseBytes (Latin.decSignedInt ()) + (bytes (show (minBound :: Int))) + , testCase "H" $ + P.Success maxBound 0 + @=? + P.parseBytes (Latin.decSignedInt ()) + (bytes (show (maxBound :: Int))) + , testCase "I" $ + P.Failure () + @=? + P.parseBytes (Latin.decSignedInt ()) + (bytes (show (fromIntegral @Int @Word maxBound + 1))) + , testCase "J" $ + -- This is one number lower than the minimum bound for + -- a signed 64-bit number, but this test will pass on + -- 32-bit architectures as well. + P.Failure () + @=? + P.parseBytes (Latin.decSignedInt ()) + (bytes "-9223372036854775809") + ] , testCase "decWord-composition" $ P.Success (42,8) 0 @=? @@ -121,7 +205,7 @@ Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> QC.Property -bigEndianWord64 a b c d e f g h = +bigEndianWord64 a b c d e f g h = let arr = runST $ do m <- PM.newByteArray 11 PM.writeByteArray m 0 (0xFF :: Word8) @@ -155,8 +239,8 @@ deriving (Eq,Show) instance QC.Arbitrary LargeInteger where - arbitrary = QC.sized $ \sz -> do - n <- QC.choose (1, sz) + arbitrary = do + n <- QC.choose (1, 27) sign <- QC.arbitrary r <- (if sign then negate else id) . foldr f 0 <$> replicateM n QC.arbitrary