fixed

commit ed8b10400ae32927c139d8e63b8749489f6250e3
parent bdbabb7d66332fe28243fb2d1da53aaa73cc7792
Author: Jared Tobin <jared@jtobin.io>
Date:   Sun, 30 Nov 2025 15:21:02 +0400

test: wider skeleton

Diffstat:
M
lib/Data/Word/Wider.hs
 | 
17
+++++++++++++++--
M
test/Main.hs
 | 
10
++++++----
M
test/Wide.hs
 | 
4
++--
A
test/Wider.hs
 | 
43
+++++++++++++++++++++++++++++++++++++++++++

4 files changed, 66 insertions(+), 8 deletions(-)
diff --git a/lib/Data/Word/Wider.hs b/lib/Data/Word/Wider.hs
@@ -22,7 +22,10 @@ import qualified Data.Bits as B
 import qualified Data.Choice as C
 import Data.Word.Limb (Limb(..))
 import qualified Data.Word.Limb as L
-import GHC.Exts (Word(..), Int(..), Int#, word2Int#, (-#), (*#))
+import GHC.Exts ( Word(..), Int(..), Int#
+                , (-#), (*#)
+                , word2Int#, eqWord#, andI#, isTrue#
+                )
 import Prelude hiding (div, mod, or, and, not, quot, rem, recip)
 
 -- utilities ------------------------------------------------------------------
@@ -66,7 +69,17 @@ instance NFData Wider where
   rnf (Wider a) = case a of
     (# _, _, _, _ #) -> ()
 
--- ordering -------------------------------------------------------------------
+-- comparison -----------------------------------------------------------------
+
+-- | Compare 'Wider' words for equality in variable time.
+eq_vartime :: Wider -> Wider -> Bool
+eq_vartime a b =
+  let !(Wider (# Limb a0, Limb a1, Limb a2, Limb a3 #)) = a
+      !(Wider (# Limb b0, Limb b1, Limb b2, Limb b3 #)) = b
+  in  isTrue# $
+        andI#
+          (andI# (eqWord# a0 b0) (eqWord# a1 b1))
+          (andI# (eqWord# a2 b2) (eqWord# a3 b3))
 
 lt#
   :: (# Limb, Limb, Limb, Limb #)
diff --git a/test/Main.hs b/test/Main.hs
@@ -4,13 +4,15 @@
 
 module Main where
 
-import Limb as L
-import Wide as W
+import qualified Limb
+import qualified Wide
+import qualified Wider
 import Test.Tasty
 
 main :: IO ()
 main = defaultMain $ testGroup "ppad-fixed" [
-    L.tests
-  , W.tests
+    Limb.tests
+  , Wide.tests
+  , Wider.tests
   ]
 
diff --git a/test/Wide.hs b/test/Wide.hs
@@ -12,13 +12,13 @@ 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
+  let !(r, c) = W.add_o 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
+  let !(r, c) = W.add_o (2 ^ (128 :: Word) - 1) 1
   H.assertBool mempty (W.eq_vartime r 0)
   H.assertBool mempty (c == 1)
 
diff --git a/test/Wider.hs b/test/Wider.hs
@@ -0,0 +1,43 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+
+module Wider (
+    tests
+  ) where
+
+import qualified Data.Word.Wider as W
+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_o 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_o (2 ^ (256 :: 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 ^ (256 :: Word) - 1) 1
+  H.assertBool mempty (W.eq_vartime r 0)
+
+tests :: TestTree
+tests = testGroup "wider 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
+  ]
+
+