diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,3 +1,9 @@ +0.3.6.2 + * Due to a regression introduced in 0.3.4.14 the RealFrac methods + and floatingOrInteger became vulnerable to a space blowup when + applied to scientifics with huge exponents. This has now been + fixed again. + 0.3.6.1 * Fix build on GHC < 8. diff --git a/scientific.cabal b/scientific.cabal --- a/scientific.cabal +++ b/scientific.cabal @@ -1,5 +1,5 @@ name: scientific -version: 0.3.6.1 +version: 0.3.6.2 synopsis: Numbers represented using scientific notation description: "Data.Scientific" provides the number type 'Scientific'. Scientific numbers are diff --git a/src/Data/Scientific.hs b/src/Data/Scientific.hs --- a/src/Data/Scientific.hs +++ b/src/Data/Scientific.hs @@ -465,6 +465,11 @@ -- -- * @r < -(base10Exponent s)@ -- +-- /WARNING:/ @toRationalRepetend@ needs to compute the 'Integer' magnitude: +-- @10^^n@. Where @n@ is based on the 'base10Exponent` of the scientific. If +-- applied to a huge exponent this could fill up all space and crash your +-- program! So don't apply this function to untrusted input. +-- -- The formula to convert the @Scientific@ @s@ -- with a repetend starting at index @r@ is described in the paper: -- @@ -642,7 +647,7 @@ -- | Precondition: the 'Scientific' @s@ needs to be an integer: -- @base10Exponent (normalize s) >= 0@ toIntegral :: (Num a) => Scientific -> a -toIntegral (Scientific c e) = fromInteger c * fromInteger (magnitude e) +toIntegral (Scientific c e) = fromInteger c * magnitude e {-# INLINE toIntegral #-} @@ -679,11 +684,11 @@ uninitialised = error "Data.Scientific: uninitialised element" -- | @magnitude e == 10 ^ e@ -magnitude :: Int -> Integer +magnitude :: Num a => Int -> a magnitude e | e < maxExpt = cachedPow10 e | otherwise = cachedPow10 hi * 10 ^ (e - hi) where - cachedPow10 = Primitive.indexArray expts10 + cachedPow10 = fromInteger . Primitive.indexArray expts10 hi = maxExpt - 1 @@ -830,9 +835,20 @@ {-# SPECIALIZE toBoundedInteger :: Scientific -> Maybe Word32 #-} {-# SPECIALIZE toBoundedInteger :: Scientific -> Maybe Word64 #-} --- | @floatingOrInteger@ determines if the scientific is floating point --- or integer. In case it's floating-point the scientific is converted --- to the desired 'RealFloat' using 'toRealFloat'. +-- | @floatingOrInteger@ determines if the scientific is floating point or +-- integer. +-- +-- In case it's floating-point the scientific is converted to the desired +-- 'RealFloat' using 'toRealFloat' and wrapped in 'Left'. +-- +-- In case it's integer to scientific is converted to the desired 'Integral' and +-- wrapped in 'Right'. +-- +-- /WARNING:/ To convert the scientific to an integral the magnitude @10^e@ +-- needs to be computed. If applied to a huge exponent this could take a long +-- time. Even worse, when the destination type is unbounded (i.e. 'Integer') it +-- could fill up all space and crash your program! So don't apply this function +-- to untrusted input but use 'toBoundedInteger' instead. -- -- Also see: 'isFloating' or 'isInteger'. floatingOrInteger :: (RealFloat r, Integral i) => Scientific -> Either r i diff --git a/test/test.hs b/test/test.hs --- a/test/test.hs +++ b/test/test.hs @@ -19,7 +19,7 @@ import Data.Scientific as Scientific import Test.Tasty import Test.Tasty.Runners.AntXML -import Test.Tasty.HUnit (testCase, (@?=), Assertion) +import Test.Tasty.HUnit (testCase, (@?=), Assertion, assertBool) import qualified Test.SmallCheck as SC import qualified Test.SmallCheck.Series as SC import qualified Test.Tasty.SmallCheck as SC (testProperty) @@ -38,7 +38,56 @@ main :: IO () main = testMain $ testGroup "scientific" - [ smallQuick "normalization" + [ testGroup "DoS protection" + [ testGroup "Eq" + [ testCase "1e1000000" $ assertBool "" $ + (read "1e1000000" :: Scientific) == (read "1e1000000" :: Scientific) + ] + , testGroup "Ord" + [ testCase "compare 1234e1000000 123e1000001" $ + compare (read "1234e1000000" :: Scientific) (read "123e1000001" :: Scientific) @?= GT + ] + + , testGroup "RealFrac" + [ testGroup "floor" + [ testCase "1e1000000" $ (floor (read "1e1000000" :: Scientific) :: Int) @?= 0 + , testCase "-1e-1000000" $ (floor (read "-1e-1000000" :: Scientific) :: Int) @?= (-1) + , testCase "1e-1000000" $ (floor (read "1e-1000000" :: Scientific) :: Int) @?= 0 + ] + , testGroup "ceiling" + [ testCase "1e1000000" $ (ceiling (read "1e1000000" :: Scientific) :: Int) @?= 0 + , testCase "-1e-1000000" $ (ceiling (read "-1e-1000000" :: Scientific) :: Int) @?= 0 + , testCase "1e-1000000" $ (ceiling (read "1e-1000000" :: Scientific) :: Int) @?= 1 + ] + , testGroup "round" + [ testCase "1e1000000" $ (round (read "1e1000000" :: Scientific) :: Int) @?= 0 + , testCase "-1e-1000000" $ (round (read "-1e-1000000" :: Scientific) :: Int) @?= 0 + , testCase "1e-1000000" $ (round (read "1e-1000000" :: Scientific) :: Int) @?= 0 + ] + , testGroup "truncate" + [ testCase "1e1000000" $ (truncate (read "1e1000000" :: Scientific) :: Int) @?= 0 + , testCase "-1e-1000000" $ (truncate (read "-1e-1000000" :: Scientific) :: Int) @?= 0 + , testCase "1e-1000000" $ (truncate (read "1e-1000000" :: Scientific) :: Int) @?= 0 + ] + , testGroup "properFracton" + [ testCase "1e1000000" $ properFraction (read "1e1000000" :: Scientific) @?= (0 :: Int, 0) + , testCase "-1e-1000000" $ let s = read "-1e-1000000" :: Scientific + in properFraction s @?= (0 :: Int, s) + , testCase "1e-1000000" $ let s = read "1e-1000000" :: Scientific + in properFraction s @?= (0 :: Int, s) + ] + ] + , testGroup "toRealFloat" + [ testCase "1e1000000" $ assertBool "Should be infinity!" $ isInfinite $ + (toRealFloat (read "1e1000000" :: Scientific) :: Double) + , testCase "1e-1000000" $ (toRealFloat (read "1e-1000000" :: Scientific) :: Double) @?= 0 + ] + , testGroup "toBoundedInteger" + [ testCase "1e1000000" $ (toBoundedInteger (read "1e1000000" :: Scientific) :: Maybe Int) @?= Nothing + ] + ] + + , smallQuick "normalization" (SC.over normalizedScientificSeries $ \s -> s /= 0 SC.==> abs (Scientific.coefficient s) `mod` 10 /= 0) (QC.forAll normalizedScientificGen $ \s ->