1 USING: arrays assocs grouping hash-sets http.client
2 http.download io.encodings.binary io.encodings.string
3 io.encodings.utf8 io.files io.files.temp kernel math math.order
4 math.parser sequences sets splitting strings tools.test unicode ;
5 IN: unicode.collation.tests
7 : test-equality ( str1 str2 -- ? ? ? ? )
8 { primary= secondary= tertiary= quaternary= }
9 [ execute( a b -- ? ) ] 2with map
12 { f f f f } [ "hello" "hi" test-equality ] unit-test
13 { t f f f } [ "hello" "h\u0000e9llo" test-equality ] unit-test
14 { t t f f } [ "hello" "HELLO" test-equality ] unit-test
15 { t t t f } [ "hello" "h e l l o." test-equality ] unit-test
16 { t t t t } [ "hello" "\0hello\0" test-equality ] unit-test
17 { { "good bye" "goodbye" "hello" "HELLO" } }
18 [ { "HELLO" "goodbye" "good bye" "hello" } sort-strings ] unit-test
20 : collation-test-lines ( -- lines )
21 "https://downloads.factorcode.org/misc/UCA/15.1.0/CollationTest_SHIFTED.txt"
22 "CollationTest_SHIFTED_15.1.0.txt" cache-file download-to
23 utf8 file-lines [ "#" head? ] reject harvest ;
25 : parse-collation-test-shifted ( -- lines )
27 [ ";" split first split-words [ hex> ] "" map-as ] map ;
29 : tail-from-last ( string char -- string' )
30 '[ _ = ] dupd find-last drop 1 + tail ; inline
32 : line>test-weights ( string -- pair )
34 split-words [ hex> ] map
36 "#" split1 nip CHAR: [ tail-from-last
39 [ split-words harvest [ hex> ] map ] map
42 ! These tests actually would pass if I didn't fix up
43 ! the ducet table for Tibetan. It took me way too long to realize
44 ! that the Unicode committee recommends fixing Tibetan collation
45 ! yet ships tests that collation fails if you fix it.
46 ! (Specifically the ducet entries for { 0x0FB2 0x0F71 } and { 0x0FB3 0x0F71 }
47 ! cause these tests to fail)
48 : xfailed-collation-tests ( -- seq )
52 { 4018 820 3953 3968 }
53 { 4018 820 3968 3953 }
54 { 4018 3953 1 3968 97 }
58 { 4019 820 3953 3968 }
59 { 4019 820 3968 3953 }
60 { 4019 3953 820 3968 }
61 { 4019 3953 1 3968 97 }
64 : parse-collation-test-weights ( -- weights )
66 [ line>test-weights ] map
67 [ first xfailed-collation-tests in? ] reject ;
69 : calculate-collation ( chars collation -- collation-calculated collation-answer )
70 [ >string collation-key/nfd drop ] [ { 0 } join ] bi* ;
72 : find-bad-collations ( pairs -- seq )
73 [ first2 calculate-collation sequence= ] reject ;
76 [ parse-collation-test-weights find-bad-collations ] unit-test
79 parse-collation-test-shifted
82 ! Remove these two expected-fail Tibetan collation comparison tests
83 ! They are bad tests once you fix up the ducet table with { 0x0FB2 0x0F71 } and { 0x0FB3 0x0F71 }
85 { { 4018 820 3969 } { 3959 33 } }
86 { { 4019 3953 820 3968 } { 3961 33 } }
87 { { 4019 98 } { 4019 3953 1 3968 97 } }
88 { { 4028 98 } { 4018 3953 1 3968 97 } }
89 } [ [ >string ] bi@ ] assoc-map >hash-set diff members
91 [ string<=> { +lt+ +eq+ } member? ] assoc-reject
94 ! XXX: Once again, these tests pass if you don't
95 ! fix up the ducet table for { 0x0FB2 0x0F71 } and { 0x0FB3 0x0F71 }
96 ! { +lt+ } [ { 4018 820 3969 } { 3959 33 } [ >string ] bi@ string<=> ] unit-test
97 ! { +lt+ } [ { 4019 3953 820 3968 } { 3961 33 } [ >string ] bi@ string<=> ] unit-test