Add regression test for #3000

Author: martijnbastiaan

clash-prelude/clash-prelude.cabal

@@ -452,6 +452,7 @@ test-suite unittests
                  Clash.Tests.XException
 
                  Clash.Tests.Laws.Enum
+                 Clash.Tests.Laws.Num
                  Clash.Tests.Laws.SaturatingNum
 
                  Hedgehog.Extra

clash-prelude/tests/Clash/Tests/Laws/Num.hs

@@ -0,0 +1,51 @@
+module Clash.Tests.Laws.Num (tests) where
+
+import Clash.Tests.Laws.SaturatingNum
+  ( genBoundedIntegral
+  , genUnsigned
+  )
+
+import Test.Tasty
+import Test.Tasty.Hedgehog.Extra
+
+import Clash.Sized.BitVector (Bit, BitVector)
+
+import Control.DeepSeq (NFData)
+import GHC.TypeLits (KnownNat)
+
+import Hedgehog
+
+genBit :: Gen Bit
+genBit = genBoundedIntegral
+
+genBitVector :: forall n. KnownNat n => Gen (BitVector n)
+genBitVector = genBoundedIntegral
+
+additiveInverse :: (Num a, Show a, Eq a) => Gen a -> TestTree
+additiveInverse genA = testPropertyXXX "x + negate x == 0" $ property $ do
+  a <- forAll genA
+  a + negate a === 0
+
+testAdditiveInverse :: (NFData a, Ord a, Show a, Eq a, Num a) => String -> Gen a -> TestTree
+testAdditiveInverse typeName genA =
+  testGroup typeName [testGroup "additiveInverse" [additiveInverse genA]]
+
+tests :: TestTree
+tests = testGroup "Num"
+  [ testAdditiveInverse "Bit" genBit
+
+  , testAdditiveInverse "Unsigned 0" (genUnsigned @0)
+  , testAdditiveInverse "Unsigned 1" (genUnsigned @1)
+  , testAdditiveInverse "Unsigned 32" (genUnsigned @32)
+  , testAdditiveInverse "Unsigned 127" (genUnsigned @127)
+  , testAdditiveInverse "Unsigned 128" (genUnsigned @128)
+
+  , testAdditiveInverse "BitVector 0" (genBitVector @0)
+  , testAdditiveInverse "BitVector 1" (genBitVector @1)
+  , testAdditiveInverse "BitVector 32" (genBitVector @32)
+  , testAdditiveInverse "BitVector 127" (genBitVector @127)
+  , testAdditiveInverse "BitVector 128" (genBitVector @128)
+
+  -- TODO: Index, Signed, UFixed, SFixed. See discussion in
+  --       https://github.com/clash-lang/clash-compiler/issues/3015
+  ]

clash-prelude/tests/Clash/Tests/Laws/SaturatingNum.hs

@@ -4,7 +4,16 @@
 {-# OPTIONS_GHC -fplugin=GHC.TypeLits.Normalise #-}
 {-# OPTIONS_GHC -fplugin=GHC.TypeLits.KnownNat.Solver #-}
 
-module Clash.Tests.Laws.SaturatingNum (tests) where
+module Clash.Tests.Laws.SaturatingNum
+  ( tests
+
+  , genBoundedIntegral
+  , genIndex
+  , genSFixed
+  , genSigned
+  , genUFixed
+  , genUnsigned
+  ) where
 
 import Test.Tasty
 import Test.Tasty.Hedgehog.Extra

clash-prelude/tests/unittests.hs

@@ -29,6 +29,7 @@ import qualified Clash.Tests.Vector
 import qualified Clash.Tests.XException
 
 import qualified Clash.Tests.Laws.Enum
+import qualified Clash.Tests.Laws.Num
 import qualified Clash.Tests.Laws.SaturatingNum
 
 tests :: TestTree
@@ -60,6 +61,7 @@ tests = testGroup "Unittests"
   , Clash.Tests.XException.tests
   , testGroup "Laws"
     [ Clash.Tests.Laws.Enum.tests
+    , Clash.Tests.Laws.Num.tests
     , Clash.Tests.Laws.SaturatingNum.tests
     ]
   ]