1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
{-# LANGUAGE OverloadedStrings #-}
module Main (main) where
import Test.Hspec
import Test.Hspec.QuickCheck
import Test.QuickCheck
import Data.MessagePack as MP
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Text as Txt
import Data.Maybe (isJust)
import Graphics.Text.Font.Choose
import Graphics.Text.Font.Choose.Internal.Test
main :: IO ()
main = hspec $ do
describe "Canary" $ do
it "runs fine" $ do
True `shouldBe` True
describe "Roundtrips" $ do
describe "converts MessagePack & back" $ do
prop "CharSet" $ \x ->
MP.unpack (MP.pack x) `shouldBe` Just (x :: CharSet')
prop "FontSet" $ \x -> let y = Prelude.map unPattern x
in MP.unpack (MP.pack y) `shouldBe` Just y
prop "LangSet" $ \x ->
MP.unpack (MP.pack x) `shouldBe` Just (x :: LangSet')
prop "ObjectSet" $ \x ->
MP.unpack (MP.pack x) `shouldBe` Just (x :: ObjectSet)
prop "Pattern" $ \x ->
MP.unpack (MP.pack x) `shouldBe` Just (x :: Pattern')
prop "Range" $ \x ->
MP.unpack (MP.pack x) `shouldBe` Just (x :: Range)
prop "StrSet" $ \x ->
MP.unpack (MP.pack x) `shouldBe` Just (x :: StrSet)
prop "Value" $ \x ->
MP.unpack (MP.pack x) `shouldBe` Just (x :: Value)
describe "through C datastructures" $ do
prop "StrSet" $ \x -> validStrSet x ==>
roundtrip testStrSet x `shouldBe` Just (x :: StrSet)
prop "CharSet" $ \x -> validCharSet' x ==>
roundtrip testCharSet x `shouldBe` Just (x :: CharSet')
prop "LangSet" $ \x -> validLangSet' x ==>
roundtrip testLangSet x `shouldBe` Just (x :: LangSet')
prop "Range" $ \x -> validRange x ==>
roundtrip testRange x `shouldBe` Just (x :: Range)
prop "Matrix" $ \x -> roundtrip testMatrix x `shouldBe`
Just (x :: (Double, Double, Double, Double))
prop "Value" $ \x -> validValue x ==>
roundtrip testValue x `shouldBe` Just (x :: Value)
prop "Trivial Pattern" $ \x -> validValue x ==>
let pat = Pattern' $ M.fromList [("test", [(Strong, x)])]
in roundtrip testPattern pat `shouldBe` Just pat
prop "Tuple Pattern" $ \(x, y) -> validValue x && validValue y ==>
let pat = Pattern' $ M.fromList [("a", [(Strong, x)]), ("b", [(Strong, y)])]
in roundtrip testPattern pat `shouldBe` Just pat
let toAscii :: Char -> Char
toAscii ch = toEnum $ fromEnum ch `mod` 128
prop "Random-key pattern" $ \x -> all (\y -> toAscii y /= '\0') x ==>
let pat = Pattern' $ M.fromList [(Txt.pack $ map toAscii $ take 17 x, [(Strong, ValueBool True)])]
in roundtrip testPattern pat `shouldBe` Just pat
prop "Pattern" $ \x -> validPattern' x ==>
roundtrip testPattern x `shouldBe` Just (x :: Pattern')
prop "FontSet" $ \x -> let y = filter validPattern $ Prelude.map unPattern x
in validFontSet y ==> roundtrip testFontSet y `shouldBe` Just y
describe "FontConfig Testsuite transliteration" $ do
it "All system fonts should have files" $ do
conf <- current
res <- fonts conf System
let files = getValue "file" `map` res :: [Maybe String]
all isJust files `shouldBe` True
it "Locale compare" $ do
S.singleton "ku-am" `cmp` S.singleton "ku-iq" `shouldBe` DifferentTerritory
S.singleton "ku-am" `cmp` S.singleton "ku-ir" `shouldBe` DifferentTerritory
S.singleton "ku-am" `cmp` S.singleton "ku-tr" `shouldBe` DifferentTerritory
S.singleton "ku-iq" `cmp` S.singleton "ku-ir" `shouldBe` DifferentTerritory
S.singleton "ku-iq" `cmp` S.singleton "ku-tr" `shouldBe` DifferentTerritory
S.singleton "ku-ir" `cmp` S.singleton "ku-tr" `shouldBe` DifferentTerritory
S.singleton "ps-af" `cmp` S.singleton "ps-pk" `shouldBe` DifferentTerritory
S.singleton "ti-er" `cmp` S.singleton "ti-et" `shouldBe` DifferentTerritory
S.singleton "zh-cn" `cmp` S.singleton "zh-hk" `shouldBe` DifferentTerritory
S.singleton "zh-cn" `cmp` S.singleton "zh-mo" `shouldBe` DifferentTerritory
S.singleton "zh-cn" `cmp` S.singleton "zh-sg" `shouldBe` DifferentTerritory
S.singleton "zh-cn" `cmp` S.singleton "zh-tw" `shouldBe` DifferentTerritory
S.singleton "zh-hk" `cmp` S.singleton "zh-mo" `shouldBe` DifferentTerritory
S.singleton "zh-hk" `cmp` S.singleton "zh-sg" `shouldBe` DifferentTerritory
S.singleton "zh-hk" `cmp` S.singleton "zh-tw" `shouldBe` DifferentTerritory
S.singleton "zh-mo" `cmp` S.singleton "zh-sg" `shouldBe` DifferentTerritory
S.singleton "zh-mo" `cmp` S.singleton "zh-tw" `shouldBe` DifferentTerritory
S.singleton "zh-sg" `cmp` S.singleton "zh-tw" `shouldBe` DifferentTerritory
S.singleton "mn-mn" `cmp` S.singleton "mn-cn" `shouldBe` DifferentTerritory
S.singleton "pap-an" `cmp` S.singleton "pap-aw" `shouldBe` DifferentTerritory
-- A couple additional ones so we know its not always responding with DifferentTerritory!
S.singleton "mn-mn" `cmp` S.singleton "mn-mn" `shouldBe` SameLang
S.singleton "mn-mn" `cmp` S.singleton "pap-an" `shouldBe` DifferentLang