summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBasVanDijk <>2018-05-07 23:42:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-05-07 23:42:00 (GMT)
commitc038012cab64bf087c1ac6d50dd6f89b3fa86cf8 (patch)
treea37b3f63faa57a73b02db1a20d1e2807295b8629
parent2f98bdae17ca4c896a955a5b0f5c2698c685e7ad (diff)
version 0.3.6.2HEAD0.3.6.2master
-rw-r--r--changelog6
-rw-r--r--scientific.cabal2
-rw-r--r--src/Data/Scientific.hs28
-rw-r--r--test/test.hs53
4 files changed, 80 insertions, 9 deletions
diff --git a/changelog b/changelog
index 5e122ff..b52a3c4 100644
--- 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
index f36de98..9c53093 100644
--- 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
index e84691f..42dd2b8 100644
--- a/src/Data/Scientific.hs
+++ b/src/Data/Scientific.hs
@@ -465,6 +465,11 @@ fromRationalRepetendUnlimited rational
--
-- * @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:
-- <http://fiziko.bureau42.com/teaching_tidbits/turning_repeating_decimals_into_fractions.pdf turning_repeating_decimals_into_fractions.pdf>
@@ -642,7 +647,7 @@ whenFloating f s@(Scientific c e)
-- | 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
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 @@ toBoundedInteger s
{-# 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
index 72eff5d..f38f054 100644
--- a/test/test.hs
+++ b/test/test.hs
@@ -19,7 +19,7 @@ import Data.Word
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 @@ import Text.ParserCombinators.ReadP (readP_to_S)
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 ->