Skip to content

Commit 43d0e70

Browse files
wismillwismill
committed
Add tests
1 parent a660006 commit 43d0e70

File tree

1 file changed

+163
-12
lines changed

1 file changed

+163
-12
lines changed

‎test/Properties.hs‎

Lines changed: 163 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -4,14 +4,23 @@
44

55
module Main (main) where
66

7+
import Data.Char (chr, ord)
8+
import Data.Bits (xor)
9+
import Data.Foldable (traverse_)
10+
import Data.Ix (Ix(..))
11+
import Data.Maybe (isJust)
712
import Data.Text (Text)
8-
import qualified Data.Text.Normalize as T
913
import Data.Text.Normalize (NormalizationMode)
1014
import QuickCheckUtils ()
11-
import Test.Hspec.QuickCheck (modifyMaxSuccess, prop)
15+
import Test.Hspec.QuickCheck (modifyMaxSuccess, modifyMaxSize, prop)
1216
import Test.Hspec as H
1317
import Test.QuickCheck (NonNegative(..))
1418
import Unicode.Internal.Division (quotRem21, quotRem28)
19+
import Unicode.Char.Normalization (compose, composeStarters, isCombiningStarter)
20+
21+
import qualified Data.Text.Normalize as T
22+
import qualified Data.Unicode.Internal.Char.DerivedNormalizationProperties as QC
23+
import qualified Unicode.Char as UC
1524

1625
#ifdef HAS_ICU
1726
import Data.Text (pack)
@@ -53,23 +62,165 @@ t_normalize mode = t_nonEmpty $ T.normalize mode
5362
#endif
5463

5564
main :: IO ()
56-
main =
57-
hspec
58-
$ H.parallel
59-
$ modifyMaxSuccess (const 10000)
60-
$ do
65+
main = hspec $ H.parallel $ do
66+
modifyMaxSuccess (const 10000) $ describe "Divisions" $ do
6167
prop "quotRem28" $ \(NonNegative n) -> n `quotRem` 28 == quotRem28 n
6268
prop "quotRem28 maxBound" $ \(NonNegative n) ->
6369
let n1 = maxBound - n
64-
in n1 `quotRem` 28 == quotRem28 n1
70+
in n1 `quotRem` 28 == quotRem28 n1
6571
prop "quotRem21" $ \(NonNegative n) -> n `quotRem` 21 == quotRem21 n
6672
prop "quotRem21 maxBound" $ \(NonNegative n) ->
6773
let n1 = maxBound - n
68-
in n1 `quotRem` 21 == quotRem21 n1
74+
in n1 `quotRem` 21 == quotRem21 n1
6975
#ifdef HAS_ICU
70-
it "Compare \127340 with ICU" $
71-
t_normalizeCompareICU T.NFKD (pack "\127340") `H.shouldBe` True
72-
prop "Comparing random strings with ICU..." t_normalizeCompareICU
76+
modifyMaxSuccess (max 100000) $ modifyMaxSize (max 500) $
77+
describe "Compare with ICU" $ do
78+
it "Compare \127340 with ICU" $
79+
t_normalizeCompareICU T.NFKD (pack "\127340") `H.shouldBe` True
80+
prop "Comparing random strings with ICU..." t_normalizeCompareICU
7381
#else
82+
modifyMaxSuccess (const 10000) $
7483
prop "Checking non-empty results for random strings..." t_normalize
7584
#endif
85+
describe "Expected Hangul properties for composition" $ do
86+
let checkQC f n c = c `shouldSatisfy` ((== n) . f . chr)
87+
let checkNFC = checkQC QC.isNFC_QC
88+
let checkNFKC = checkQC QC.isNFKC_QC
89+
let checkNoDecomp mode = (`shouldNotSatisfy` UC.isDecomposable mode . chr)
90+
let checkJamo n c = checkNFC n c
91+
>> checkNFKC n c
92+
>> checkNoDecomp UC.Canonical c
93+
>> checkNoDecomp UC.Kompat c
94+
>> (c `shouldNotSatisfy` UC.isCombining . chr)
95+
describe "Jamo L" $ do
96+
let cs = [UC.jamoLFirst .. UC.jamoLLast]
97+
it "QC == Yes, no decomposition, starter" $
98+
traverse_ (checkJamo QC.YesStarter) cs
99+
it "Compose only with Jamo V" $
100+
let {
101+
check (l, c) =
102+
if inRange (UC.jamoVFirst, UC.jamoVLast) (ord c)
103+
then pure ()
104+
else if UC.isCombining c
105+
then l `shouldNotSatisfy` isJust . (`compose` c)
106+
else l `shouldNotSatisfy`
107+
(\c' -> isJust (composeStarters c' c)
108+
|| isCombiningStarter c')
109+
} in traverse_ check
110+
[ (l, c)
111+
| l <- chr <$> cs
112+
, c <- [minBound..maxBound]
113+
]
114+
describe "jamoLLast < cp < jamoVFirst" $ do
115+
let cs = [succ UC.jamoLLast .. pred UC.jamoVFirst]
116+
it "QC = Yes, no decomposition, starter" $
117+
traverse_ (checkJamo QC.YesStarter) cs
118+
it "Does not compose" $
119+
let {
120+
check (c, j) = if UC.isCombining c
121+
then j `shouldNotSatisfy` isJust . (compose c)
122+
else j `shouldNotSatisfy`
123+
(\c' -> isJust (composeStarters c' c)
124+
|| isCombiningStarter c')
125+
} in traverse_ check
126+
[ (c, j)
127+
| j <- chr <$> cs
128+
, c <- [minBound..maxBound]
129+
]
130+
describe "Jamo V" $ do
131+
let cs = [UC.jamoVFirst .. UC.jamoVLast]
132+
it "QC = Maybe, no decomposition, starter" $
133+
traverse_ (checkJamo QC.MaybeStarterNoDecomp) cs
134+
it "Compose only with Jamo L" $
135+
let {
136+
check (c, v) =
137+
if inRange (UC.jamoLFirst, UC.jamoLLast) (ord c)
138+
then pure ()
139+
else if UC.isCombining c
140+
then v `shouldNotSatisfy` isJust . (compose c)
141+
else v `shouldNotSatisfy`
142+
(\c' -> isJust (composeStarters c' c)
143+
|| isCombiningStarter c')
144+
} in traverse_ check
145+
[ (c, v)
146+
| v <- chr <$> cs
147+
, c <- [minBound..maxBound]
148+
]
149+
describe "jamoVLast < cp <= jamoTFirst" $ do
150+
let cs = [succ UC.jamoVLast .. UC.jamoTFirst]
151+
it "QC = Yes, no decomposition, starter" $
152+
traverse_ (checkJamo QC.YesStarter) cs
153+
it "Does not compose" $
154+
let {
155+
check (c, j) = if UC.isCombining c
156+
then j `shouldNotSatisfy` isJust . (compose c)
157+
else j `shouldNotSatisfy`
158+
(\c' -> isJust (composeStarters c' c)
159+
|| isCombiningStarter c')
160+
} in traverse_ check
161+
[ (c, j)
162+
| j <- chr <$> cs
163+
, c <- [minBound..maxBound]
164+
]
165+
describe "Jamo T" $ do
166+
let cs = [succ UC.jamoTFirst .. UC.jamoTLast]
167+
it "QC = Maybe, no decomposition, starter" $
168+
traverse_ (checkJamo QC.MaybeStarterNoDecomp) cs
169+
it "Compose only with LV" $ do
170+
let {
171+
check (c, t) =
172+
if UC.isHangul c && UC.isHangulLV c
173+
then pure ()
174+
else if UC.isCombining c
175+
then t `shouldNotSatisfy` isJust . (compose c)
176+
else t `shouldNotSatisfy`
177+
(\c' -> isJust (composeStarters c' c)
178+
|| isCombiningStarter c')
179+
} in traverse_ check
180+
[ (c, t)
181+
| t <- chr <$> [succ UC.jamoTFirst .. UC.jamoTLast]
182+
, c <- [minBound..maxBound]
183+
]
184+
describe "Precomposed Hangul" $ do
185+
it "QC = Yes, no decomposition via ‘decompose’, starter" $ do
186+
let checkHangul = checkJamo QC.YesStarter
187+
traverse_ checkHangul [UC.hangulFirst .. UC.hangulLast]
188+
describe "Expected properties for QC" $ do
189+
it "isCombiningStarter => not decomposable" $ do
190+
let mkCheck mode c = if UC.isCombiningStarter c
191+
then c `shouldNotSatisfy` UC.isDecomposable mode
192+
else pure ()
193+
let check c = mkCheck UC.Canonical c >> mkCheck UC.Kompat c
194+
traverse_ check [minBound..maxBound]
195+
it "NFD & NFKD" $ do
196+
let {
197+
mkCheck f mode c = if f c
198+
then do
199+
c `shouldNotSatisfy` UC.isDecomposable mode
200+
c `shouldNotSatisfy` UC.isHangul
201+
else c `shouldSatisfy`
202+
(\c' -> UC.isDecomposable mode c' `xor` UC.isHangul c')
203+
}
204+
let check c = mkCheck QC.isNFD_QC UC.Canonical c
205+
>> mkCheck QC.isNFKD_QC UC.Kompat c
206+
traverse_ check [minBound..maxBound]
207+
it "NFC & NFKC" $ do
208+
let {
209+
mkCheck f mode c = case f c of
210+
-- Yes, starter
211+
QC.YesStarter -> c `shouldNotSatisfy` UC.isCombining
212+
-- Maybe, starter, no decomposition
213+
QC.MaybeStarterNoDecomp -> do
214+
c `shouldNotSatisfy` UC.isCombining
215+
c `shouldNotSatisfy` UC.isDecomposable mode
216+
-- Combining
217+
QC.Combining -> do
218+
c `shouldSatisfy` UC.isCombining
219+
c `shouldNotSatisfy` UC.isDecomposable mode
220+
-- Decomposable
221+
QC.Decomposable -> c `shouldSatisfy` UC.isDecomposable mode
222+
qc -> error (show qc)
223+
}
224+
let check c = mkCheck QC.isNFC_QC UC.Canonical c
225+
>> mkCheck QC.isNFKC_QC UC.Kompat c
226+
traverse_ check [minBound..maxBound]

0 commit comments

Comments
 (0)