diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,3 +1,12 @@ +0.3.3.5 + * Fixed bug when converting the Scientific: + `scientific 0 someBigExponent` to a bounded Integral using toBoundedInteger + or to a bounded RealFloat using toBoundedRealFloat. + If someBigExponent was big enough to trigger the big-exponent protection + the beforementioned functions didn't return 0. + + This is fixed by explicitly handling a coefficient of 0. + 0.3.3.4 * Relax upper version bounds of base and deepseq for the test suite and benchmarks. diff --git a/scientific.cabal b/scientific.cabal --- a/scientific.cabal +++ b/scientific.cabal @@ -1,5 +1,5 @@ name: scientific -version: 0.3.3.4 +version: 0.3.3.5 synopsis: Numbers represented using scientific notation description: @Data.Scientific@ provides a space efficient and arbitrary precision diff --git a/src/Data/Scientific.hs b/src/Data/Scientific.hs --- a/src/Data/Scientific.hs +++ b/src/Data/Scientific.hs @@ -455,6 +455,7 @@ -- Infinity or 0 will be returned as 'Left'. toBoundedRealFloat :: forall a. (RealFloat a) => Scientific -> Either a a toBoundedRealFloat s@(Scientific c e) + | c == 0 = Right 0 | e > limit && e > hiLimit = Left $ sign (1/0) -- Infinity | e < -limit && e < loLimit && e + d < loLimit = Left $ sign 0 | otherwise = Right $ realToFrac s @@ -489,14 +490,14 @@ -- that could fill up all space and crash your program. toBoundedInteger :: forall i. (Integral i, Bounded i) => Scientific -> Maybe i toBoundedInteger s + | c == 0 = fromIntegerBounded 0 | integral = if dangerouslyBig then Nothing - else if n < toInteger (minBound :: i) || - n > toInteger (maxBound :: i) - then Nothing - else Just $ fromInteger n + else fromIntegerBounded n | otherwise = Nothing where + c = coefficient s + integral = e >= 0 || e' >= 0 e = base10Exponent s @@ -507,6 +508,12 @@ dangerouslyBig = e > limit && e > integerLog10' (max (abs $ toInteger (minBound :: i)) (abs $ toInteger (maxBound :: i))) + + fromIntegerBounded :: Integer -> Maybe i + fromIntegerBounded i + | i < toInteger (minBound :: i) || + i > toInteger (maxBound :: i) = Nothing + | otherwise = Just $ fromInteger i -- This should not be evaluated if the given Scientific is dangerouslyBig -- since it could consume all space and crash the process: diff --git a/test/test.hs b/test/test.hs --- a/test/test.hs +++ b/test/test.hs @@ -4,6 +4,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -12,6 +13,7 @@ import Control.Applicative import Control.Monad import Data.Int +import Data.Word import Data.Scientific as Scientific import Test.Tasty import Test.Tasty.Runners.AntXML @@ -155,16 +157,17 @@ (floatingOrInteger (realToFrac d) :: Either Double Integer) == Left d) ] , testGroup "toBoundedInteger" - [ testProperty "correct conversion" $ \s -> - case toBoundedInteger s :: Maybe Int64 of - Just i -> i == (fromIntegral $ (coefficient s') * 10^(base10Exponent s')) - where - s' = normalize s - Nothing -> isFloating s || - s < fromIntegral (minBound :: Int64) || - s > fromIntegral (maxBound :: Int64) + [ testGroup "correct conversion" + [ testProperty "Int64" $ toBoundedIntegerConversion (undefined :: Int64) + , testProperty "Word64" $ toBoundedIntegerConversion (undefined :: Word64) + , testProperty "NegativeNum" $ toBoundedIntegerConversion (undefined :: NegativeInt) + ] ] ] + , testGroup "toBoundedRealFloat" + [ testCase "0 * 10^1000 == 0" $ + toBoundedRealFloat (scientific 0 1000) @?= Right (0 :: Float) + ] , testGroup "toBoundedInteger" [ testGroup "to Int64" $ [ testCase "succ of maxBound" $ @@ -175,6 +178,8 @@ let i = pred . fromIntegral $ (minBound :: Int64) s = scientific i 0 in (toBoundedInteger s :: Maybe Int64) @?= Nothing + , testCase "0 * 10^1000 == 0" $ + toBoundedInteger (scientific 0 1000) @?= Just (0 :: Int64) ] ] , testGroup "Predicates" @@ -217,6 +222,20 @@ -- Scientific.fromFloatDigits (Scientific.toRealFloat s :: realFloat) == s ] +toBoundedIntegerConversion + :: forall i. (Integral i, Bounded i, Show i) + => i -> Scientific -> Bool +toBoundedIntegerConversion _ s = + case toBoundedInteger s :: Maybe i of + Just i -> i == (fromIntegral $ (coefficient s') * 10^(base10Exponent s')) && + i >= minBound && + i <= maxBound + where + s' = normalize s + Nothing -> isFloating s || + s < fromIntegral (minBound :: i) || + s > fromIntegral (maxBound :: i) + testProperty :: (SC.Testable IO test, QC.Testable test) => TestName -> test -> TestTree testProperty n test = smallQuick n test test @@ -290,6 +309,13 @@ 1 -> m _ -> error "round default defn: Bad value" +newtype NegativeInt = NegativeInt Int + deriving (Show, Enum, Eq, Ord, Num, Real, Integral) + +instance Bounded NegativeInt where + minBound = -100 + maxBound = -10 + ---------------------------------------------------------------------- -- SmallCheck instances ---------------------------------------------------------------------- @@ -312,7 +338,11 @@ ---------------------------------------------------------------------- instance QC.Arbitrary Scientific where - arbitrary = scientific <$> QC.arbitrary <*> intGen + arbitrary = QC.frequency + [ (70, scientific <$> QC.arbitrary <*> intGen) + , (20, scientific <$> QC.arbitrary <*> bigIntGen) + , (10, scientific <$> pure 0 <*> bigIntGen) + ] shrink s = zipWith scientific (QC.shrink $ Scientific.coefficient s) (QC.shrink $ Scientific.base10Exponent s) @@ -324,6 +354,9 @@ normalizedScientificGen :: QC.Gen Scientific normalizedScientificGen = Scientific.normalize <$> QC.arbitrary + +bigIntGen :: QC.Gen Int +bigIntGen = QC.sized $ \size -> QC.resize (size * 1000) intGen intGen :: QC.Gen Int #if MIN_VERSION_QuickCheck(2,7,0)