IOV2UTF8Tests.hs (4813B)
1 module IOV2UTF8Tests (ioV2UTF8Tests) where 2 3 import qualified IOV2.UTF8 as U 4 import qualified IOV2.Resources as R 5 import qualified IOV2.Driver as V 6 import Runtime (T(..), ofList, ofNumber, ofString, ofBytes) 7 import qualified Data.ByteString as BS 8 import Data.Char (chr) 9 import qualified Data.Text as Text 10 import qualified Data.Text.Encoding as E 11 import Control.Monad (forM_) 12 import Test.Tasty 13 import Test.Tasty.HUnit 14 15 category wanted value = case value of Left p -> R.category p @?= wanted; Right _ -> assertFailure wanted 16 request op payload = Fork (ofNumber 10) (Fork (ofString "utf8") (Fork (ofNumber 1) (Fork (ofString op) payload))) 17 bad op action = V.runDetailed action >>= \result -> case result of 18 V.Completed (Fork Leaf (Fork problem Leaf)) -> problem @?= ofList (map ofString ["invalid-argument","utf8/"++op,"","none"]) 19 _ -> assertFailure "expected ordinary argument failure" 20 21 ioV2UTF8Tests = localOption (mkTimeout 30000000) $ testGroup "Strict bounded UTF-8" 22 [ testCase "independent boundary vectors, NUL, BOM and noncharacters" $ do 23 forM_ [(0,[0]),(0x7f,[0x7f]),(0x80,[0xc2,0x80]),(0x7ff,[0xdf,0xbf]), 24 (0x800,[0xe0,0xa0,0x80]),(0xd7ff,[0xed,0x9f,0xbf]),(0xe000,[0xee,0x80,0x80]), 25 (0xfeff,[0xef,0xbb,0xbf]),(0xffff,[0xef,0xbf,0xbf]), 26 (0x10000,[0xf0,0x90,0x80,0x80]),(0x10ffff,[0xf4,0x8f,0xbf,0xbf])] $ \(scalar,octets) -> do 27 let bytes = BS.pack octets 28 U.encode [chr scalar] @?= Right bytes 29 U.decode True bytes @?= Right ([chr scalar],BS.empty) 30 forM_ [1..BS.length bytes-1] $ \split -> do 31 U.decode False (BS.take split bytes) @?= Right ([],BS.take split bytes) 32 U.decode True (BS.take split bytes) `seq` category "invalid-data" (U.decode True (BS.take split bytes)) 33 , testCase "every Unicode scalar agrees with the standard UTF-8 encoder" $ do 34 forM_ ([0..0xd7ff] ++ [0xe000..0x10ffff]) $ \scalar -> do 35 let text = [chr scalar] 36 bytes = E.encodeUtf8 (Text.pack text) 37 U.decode True bytes @?= Right (text,BS.empty) 38 , testCase "incomplete valid suffix is explicit and composes at every split" $ do 39 let text = "A\0λ😀\r\n\xfeff" 40 bytes = E.encodeUtf8 (Text.pack text) 41 forM_ [0..BS.length bytes] $ \split -> do 42 case U.decode False (BS.take split bytes) of 43 Left p -> assertFailure (show p) 44 Right (first,carry) -> do 45 assertBool "oversized carry" (BS.length carry <= 3) 46 U.decode True (carry <> BS.drop split bytes) @?= Right (drop (length first) text,BS.empty) 47 case U.decode True (carry <> BS.drop split bytes) of 48 Right (last,_) -> first ++ last @?= text 49 _ -> assertFailure "split decode failed" 50 , testCase "malformed and noncanonical prefixes fail even before final input" $ do 51 forM_ [[0x80],[0xc0],[0xc1],[0xf5],[0xff],[0xe0,0x80],[0xed,0xa0], 52 [0xf0,0x80],[0xf4,0x90],[0xe2,0x28],[0xf0,0x90,0x7f], 53 [0xc2,0x7f],[0xe0,0xa0,0x7f],[0xf0,0x90,0x80,0xc0]] $ \bytes -> 54 forM_ [False,True] $ \final -> category "invalid-data" (U.decode final (BS.pack bytes)) 55 case U.decode False ("good" <> BS.singleton 0xff) of 56 Left p -> R.detail p @?= "invalid UTF-8 leading byte at byte 4" 57 _ -> assertFailure "invalid suffix accepted" 58 , testCase "bounds and surrogate controls do not demand excess characters" $ do 59 U.encode (replicate 1024 '\x10ffff') @?= Right (BS.concat (replicate 1024 (BS.pack [0xf4,0x8f,0xbf,0xbf]))) 60 category "invalid-bound" (U.encode (replicate 1024 'a' ++ (error "excess scalar":error "excess tail"))) 61 forM_ [0xd800,0xdfff] $ \n -> category "invalid-data" (U.encode [chr n]) 62 category "invalid-bound" (U.decode False (BS.replicate 4097 0)) 63 U.decode True BS.empty @?= Right ([],BS.empty) 64 U.encode [] @?= Right BS.empty 65 , testCase "wire scalar controls reject aliases, surrogates, overflow and excess" $ do 66 forM_ [Fork Leaf Leaf,ofNumber 0xd800,ofNumber 0x110000] $ \scalar -> 67 bad "encode" (request "encode" (ofList [scalar])) 68 let excess = foldr Fork (Fork (error "excess wire scalar") (error "excess wire tail")) (replicate 1024 (ofNumber 97)) 69 bad "encode" (request "encode" excess) 70 bad "decode" (request "decode" (ofList [ofNumber 2,error "invalid final forced bytes"])) 71 bad "decode" (request "decode" (ofList [ofNumber 1,ofList [ofNumber 256]])) 72 , testCase "wire empty text and NUL are valid, distinct values" $ do 73 forM_ [(Leaf,BS.empty),(ofList [Leaf],BS.singleton 0)] $ \(text,bytes) -> 74 V.runDetailed (request "encode" text) >>= \result -> case result of 75 V.Completed value -> value @?= Fork (Stem Leaf) (Fork (ofBytes bytes) Leaf) 76 _ -> assertFailure "valid text rejected" 77 ]