hamming/test/Hamming/Word16Spec.hs

{-

hamming
Copyright (C) Jonathan Lamothe <jonathan@jlamothe.net>

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Affero General Public License as
published by the Free Software Foundation, either version 3 of the
License, or (at your option) any later version.

This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
Affero General Public License for more details.

You should have received a copy of the GNU Affero General Public
License along with this program.  If not, see
<https://www.gnu.org/licenses/>.

-}

module Hamming.Word16Spec (spec) where

import Data.Bits (shiftL, xor, (.|.))
import Data.Word (Word16)

import Hamming

import Test.Hspec (Spec, context, describe, it, shouldBe)

spec :: Spec
spec = describe "Word16" $ do
  setCheckBitsSpec
  isValidSpec
  correctErrorsSpec

setCheckBitsSpec :: Spec
setCheckBitsSpec = describe "setCheckBits" $ mapM_
  ( \(desc, code, expected) -> context desc $ let
    actual = setCheckBits code
    in it ("should be " ++ show expected) $
      actual `shouldBe` expected
  )
  [ ( "all zeroes",     0,          0           )
  , ( "all ones",       0xffff,     0xffff      )
  , ( "no check bits",  noChkBits,  withChkBits )
  , ( "bad check bits", badChkBits, withChkBits )
  ]

isValidSpec :: Spec
isValidSpec = describe "isValid" $ mapM_
  ( \(desc, code, expected) -> context desc $ let
    actual = isValid code
    in it ("should be " ++ show expected) $
      actual `shouldBe` expected
  )
  [ ( "all zeroes",     0,           True  )
  , ( "all ones",       0xffff,      True  )
  , ( "valid",          withChkBits, True  )
  , ( "no check bits",  noChkBits,   False )
  , ( "bad check bits", badChkBits,  False )
  ]

correctErrorsSpec :: Spec
correctErrorsSpec = describe "correctErrors" $ mapM_
  ( \(desc, code, expected) -> context desc $ let
    actual = correctErrors code
    in it ("should be " ++ show expected) $
      actual `shouldBe` expected
  ) $ ("valid", withChkBits, Just withChkBits) :
  singleBitErrors ++ doubleBitErrors

singleBitErrors :: [(String, Word16, Maybe Word16)]
singleBitErrors = map
  ( \bit -> let
    mask = 1 `shiftL` bit
    code = withChkBits `xor` mask
    in ("bad bit " ++ show bit, code, Just withChkBits)
  ) [0..15]

doubleBitErrors :: [(String, Word16, Maybe Word16)]
doubleBitErrors =
  [ let
    mask = (1 `shiftL` a) .|. (1 `shiftL` b)
    code = withChkBits `xor` mask
    in
      ( "bad bits " ++ show a ++ " & " ++ show b
      , code
      , Nothing
      )
  | a <- [0..14]
  , b <- [1..15]
  , a < b
  ]

noChkBits :: Word16
noChkBits = 0x34c0

withChkBits :: Word16
withChkBits = 0x35c5

badChkBits :: Word16
badChkBits = 0x34d2

--jl