Wide.hs (1181B)
1 {-# LANGUAGE BangPatterns #-} 2 {-# LANGUAGE MagicHash #-} 3 {-# LANGUAGE UnboxedTuples #-} 4 5 module Wide ( 6 tests 7 ) where 8 9 import qualified Data.Word.Wide as W 10 import Test.Tasty 11 import qualified Test.Tasty.HUnit as H 12 13 overflowing_add_no_carry :: H.Assertion 14 overflowing_add_no_carry = do 15 let !(r, c) = W.add_o 1 0 16 H.assertBool mempty (W.eq_vartime r 1) 17 H.assertBool mempty (c == 0) 18 19 overflowing_add_with_carry :: H.Assertion 20 overflowing_add_with_carry = do 21 let !(r, c) = W.add_o (2 ^ (128 :: Word) - 1) 1 22 H.assertBool mempty (W.eq_vartime r 0) 23 H.assertBool mempty (c == 1) 24 25 wrapping_add_no_carry :: H.Assertion 26 wrapping_add_no_carry = do 27 let !r = W.add 0 1 28 H.assertBool mempty (W.eq_vartime r 1) 29 30 wrapping_add_with_carry :: H.Assertion 31 wrapping_add_with_carry = do 32 let !r = W.add (2 ^ (128 :: Word) - 1) 1 33 H.assertBool mempty (W.eq_vartime r 0) 34 35 tests :: TestTree 36 tests = testGroup "wide tests" [ 37 H.testCase "overflowing add, no carry" overflowing_add_no_carry 38 , H.testCase "overflowing add, carry" overflowing_add_with_carry 39 , H.testCase "wrapping add, no carry" wrapping_add_no_carry 40 , H.testCase "wrapping add, carry" wrapping_add_with_carry 41 ] 42