{-| Description: Copyright: (c) 2020 Samuel May License: MPL-2.0 Maintainer: ag.eitilt@gmail.com Stability: experimental Portability: portable -} module Test.Willow.Property.Encoding.ShiftJis ( tests ) where import qualified Hedgehog as H import qualified Hedgehog.Gen as H.G import qualified Hedgehog.Range as H.R import Web.Willow.Common.Encoding import Test.Willow.Property.Common tests :: H.Group tests = packGroup "Web.Willow.Common.Encoding.ShiftJis" -- Single byte tests handled in "unit" due to limited number [ decodeEndOfStream , decodeTwoByteInvalid , decodeOneByteLookup , decodeTwoByteLookup ] decodeEndOfStream :: Test decodeEndOfStream = packTest "incomplete character" $ do first <- H.forAll . H.G.choice $ map H.G.word8 [ H.R.linear 0x81 0x9F , H.R.linear 0xE0 0xFC ] checkEndOfStream ShiftJis [first] decodeTwoByteInvalid :: Test decodeTwoByteInvalid = packTest "invalid second byte" $ do first <- H.forAll . H.G.choice $ map H.G.word8 [ H.R.linear 0x81 0x9F , H.R.linear 0xE0 0xFC ] second <- H.forAll $ H.G.choice [ H.G.word8 $ H.R.linear 0x00 0x3F , H.G.constant 0x7F , H.G.word8 $ H.R.linear 0xFC 0xFF ] let check = if second <= 0x7F then checkInvalid else checkInvalidAll check ShiftJis [first, second] decodeOneByteLookup :: Test decodeOneByteLookup = packTest "one-byte sequence" $ do first <- H.forAll . H.G.choice $ map H.G.word8 [ H.R.linear 0x00 0x80 , H.R.linear 0xA0 0xDF , H.R.linear 0xFD 0xFF ] checkTrailing ShiftJis [first] decodeTwoByteLookup :: Test decodeTwoByteLookup = packTest "two-byte sequence" $ do first <- H.forAll . H.G.choice $ map H.G.word8 [ H.R.linear 0x81 0x9F , H.R.linear 0xE0 0xFC ] second <- H.forAll . H.G.choice $ map H.G.word8 [ H.R.linear 0x40 0x7E , H.R.linear 0x80 0xFC ] let check = if second <= 0x7F then checkTrailing else checkTrailingAll check ShiftJis [first, second]