diff --git a/slist.cabal b/slist.cabal index 919468c..0664cd4 100644 --- a/slist.cabal +++ b/slist.cabal @@ -71,4 +71,18 @@ test-suite slist-doctest main-is: Doctest.hs build-depends: doctest , Glob - ghc-options: -threaded \ No newline at end of file + ghc-options: -threaded + +test-suite slist-test + import: common-options + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + other-modules: Test.Slist.Size + build-depends: slist + , hedgehog ^>= 1.0 + , hspec + , hspec-hedgehog ^>= 0.0.1 + ghc-options: -threaded + -rtsopts + -with-rtsopts=-N diff --git a/src/Slist/Size.hs b/src/Slist/Size.hs index 4718001..186d69e 100644 --- a/src/Slist/Size.hs +++ b/src/Slist/Size.hs @@ -36,15 +36,28 @@ data Size {- | Efficient implementations of numeric operations with 'Size's. -Any operations with 'Infinity' size results into 'Infinity'. - -TODO: checking on overflow when '+' or '*' sizes. +Any operations with 'Infinity' size results into 'Infinity'. When +'Infinity' is a left argument, all operations are also +right-lazy. Operations are checked for integral overflow under the +assumption that all values inside 'Size' are positive. + +>>> Size 10 + Size 5 +Size 15 +>>> Size 5 * Infinity +Infinity +>>> Infinity + error "Unevaluated size" +Infinity +>>> Size (10 ^ 10) * Size (10 ^ 10) +Infinity -} instance Num Size where (+) :: Size -> Size -> Size Infinity + _ = Infinity _ + Infinity = Infinity - (Size x) + (Size y) = Size $ x + y + (Size x) + (Size y) = + if x + y < x -- integer overflow + then Infinity + else Size $ x + y {-# INLINE (+) #-} (-) :: Size -> Size -> Size @@ -56,7 +69,13 @@ instance Num Size where (*) :: Size -> Size -> Size Infinity * _ = Infinity _ * Infinity = Infinity - (Size x) * (Size y) = Size (x * y) + (Size x) * (Size y) + | x == 0 || y == 0 = 0 + | otherwise = + let result = x * y in + if x == result `div` y + then Size (x * y) + else Infinity -- multiplication overflow {-# INLINE (*) #-} abs :: Size -> Size diff --git a/stack.yaml b/stack.yaml index d6bb8b6..1d7cc25 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1 +1 @@ -resolver: nightly-2019-11-08 +resolver: nightly-2020-05-01 diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 index 0000000..0316bd6 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,9 @@ +module Main (main) where + +import Test.Hspec (hspec) + +import Test.Slist.Size (sizeSpec) + + +main :: IO () +main = hspec sizeSpec diff --git a/test/Test/Slist/Size.hs b/test/Test/Slist/Size.hs new file mode 100644 index 0000000..45421ba --- /dev/null +++ b/test/Test/Slist/Size.hs @@ -0,0 +1,95 @@ +{- HLINT ignore "Redundant fromInteger" -} +{- HLINT ignore "Reduce duplication" -} + +module Test.Slist.Size + ( sizeSpec + ) where + +import Hedgehog (Gen, PropertyT, forAll, (===)) +import Test.Hspec (Spec, describe, it) +import Test.Hspec.Hedgehog (hedgehog) + +import Slist.Size (Size (..)) + +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range + + +type Property = PropertyT IO () + +sizeSpec :: Spec +sizeSpec = describe "Size tests" $ + describe "'Num' laws" $ do + it "Neutrality of 0 over addition" zeroAdditionNeutrality + it "Commutativity of (+)" additionCommutativity + it "Associativity of (+)" additionAssotiavity + it "Neutrality of 1 over multiplication" oneMultiplicationNeutrality + it "Commutativity of (*)" multiplicationCommutavity + it "Associativity of (*)" multiplicationAssociativity + it "Distributivity of (*) with respect to (+)" distributivity + it "'abs' and 'signum' correspondence" absSignum + +zeroAdditionNeutrality :: Property +zeroAdditionNeutrality = hedgehog $ do + x <- forAll genSize + + fromInteger 0 + x === x + x + fromInteger 0 === x + +additionCommutativity :: Property +additionCommutativity = hedgehog $ do + x <- forAll genSize + y <- forAll genSize + + x + y === y + x + +additionAssotiavity :: Property +additionAssotiavity = hedgehog $ do + x <- forAll genSize + y <- forAll genSize + z <- forAll genSize + + (x + y) + z === x + (y + z) + +oneMultiplicationNeutrality :: Property +oneMultiplicationNeutrality = hedgehog $ do + x <- forAll genSize + + fromInteger 1 * x === x + x * fromInteger 1 === x + +multiplicationCommutavity :: Property +multiplicationCommutavity = hedgehog $ do + x <- forAll genSize + y <- forAll genSize + + x * y === y * x + +multiplicationAssociativity :: Property +multiplicationAssociativity = hedgehog $ do + x <- forAll genSize + y <- forAll genSize + z <- forAll genSize + + (x * y) * z === x * (y * z) + +distributivity :: Property +distributivity = hedgehog $ do + x <- forAll genSize + y <- forAll genSize + z <- forAll genSize + + x * (y + z) === (x * y) + (x * z) + (y + z) * x === (y * x) + (z * x) + +absSignum :: Property +absSignum = hedgehog $ do + x <- forAll genSize + + abs x * signum x === x + +genSize :: Gen Size +genSize = Gen.frequency + [ (1, pure Infinity) + , (9, Size <$> Gen.int (Range.constant 0 maxBound)) + ]