fixed

commit 27f3ac0804a2ac595dba1ed95e714abf95b61a87
parent af405307c1a52c233e87c5b73773fbca0ae04146
Author: Jared Tobin <jared@jtobin.io>
Date:   Sun, 30 Nov 2025 13:10:32 +0400

test: basic wide tests

Diffstat:
M
ppad-fixed.cabal
 | 
1
+
M
test/Main.hs
 | 
6
+++++-
A
test/Wide.hs
 | 
44
++++++++++++++++++++++++++++++++++++++++++++

3 files changed, 50 insertions(+), 1 deletion(-)
diff --git a/ppad-fixed.cabal b/ppad-fixed.cabal
@@ -47,6 +47,7 @@ test-suite fixed-tests
   main-is:             Main.hs
   other-modules:
       Limb
+      Wide
 
   ghc-options:
     -rtsopts -Wall -O2
diff --git a/test/Main.hs b/test/Main.hs
@@ -5,8 +5,12 @@
 module Main where
 
 import Limb as L
+import Wide as W
 import Test.Tasty
 
 main :: IO ()
-main = defaultMain $ L.tests
+main = defaultMain $ testGroup "ppad-fixed" [
+    L.tests
+  , W.tests
+  ]
 
diff --git a/test/Wide.hs b/test/Wide.hs
@@ -0,0 +1,44 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+
+module Wide (
+    tests
+  ) where
+
+import qualified Data.Choice as C
+import qualified Data.Word.Wide as W
+import GHC.Exts
+import Test.Tasty
+import qualified Test.Tasty.HUnit as H
+
+overflowing_add_no_carry :: H.Assertion
+overflowing_add_no_carry = do
+  let !(r, c) = W.add_c 1 0
+  H.assertBool mempty (W.eq_vartime r 1)
+  H.assertBool mempty (c == 0)
+
+overflowing_add_with_carry :: H.Assertion
+overflowing_add_with_carry = do
+  let !(r, c) = W.add_c (2 ^ (128 :: Word) - 1) 1
+  H.assertBool mempty (W.eq_vartime r 0)
+  H.assertBool mempty (c == 1)
+
+wrapping_add_no_carry :: H.Assertion
+wrapping_add_no_carry = do
+  let !r = W.add 0 1
+  H.assertBool mempty (W.eq_vartime r 1)
+
+wrapping_add_with_carry :: H.Assertion
+wrapping_add_with_carry = do
+  let !r = W.add (2 ^ (128 :: Word) - 1) 1
+  H.assertBool mempty (W.eq_vartime r 0)
+
+tests :: TestTree
+tests = testGroup "wide tests" [
+    H.testCase "overflowing add, no carry" overflowing_add_no_carry
+  , H.testCase "overflowing add, carry" overflowing_add_with_carry
+  , H.testCase "wrapping add, no carry" wrapping_add_no_carry
+  , H.testCase "wrapping add, carry" wrapping_add_with_carry
+  ]
+