1 USING: arrays assocs fry grouping io.encodings.utf8 io.files
2 kernel math math.order math.parser sequences splitting
3 strings tools.test unicode ;
4 IN: unicode.collation.tests
6 : test-equality ( str1 str2 -- ? ? ? ? )
7 { primary= secondary= tertiary= quaternary= }
8 [ execute( a b -- ? ) ] 2with map
11 { f f f f } [ "hello" "hi" test-equality ] unit-test
12 { t f f f } [ "hello" "h\u0000e9llo" test-equality ] unit-test
13 { t t f f } [ "hello" "HELLO" test-equality ] unit-test
14 { t t t f } [ "hello" "h e l l o." test-equality ] unit-test
15 { t t t t } [ "hello" "\0hello\0" test-equality ] unit-test
16 { { "good bye" "goodbye" "hello" "HELLO" } }
17 [ { "HELLO" "goodbye" "good bye" "hello" } sort-strings ] unit-test
19 : collation-test-lines ( -- lines )
20 "vocab:unicode/UCA/CollationTest/CollationTest_SHIFTED.txt" utf8 file-lines
21 [ "#" head? ] reject harvest ;
23 : parse-collation-test-shifted ( -- lines )
25 [ ";" split first " " split [ hex> ] "" map-as ] map ;
27 : tail-from-last ( string char -- string' )
28 '[ _ = ] dupd find-last drop 1 + tail ; inline
30 : line>test-weights ( string -- pair )
32 " " split [ hex> ] map
34 "#" split1 nip CHAR: [ tail-from-last
37 [ " " split harvest [ hex> ] map ] map
40 : parse-collation-test-weights ( -- weights )
42 [ line>test-weights ] map ;
44 : calculate-collation ( chars collation -- collation-calculated collation-answer )
45 [ >string collation-key/nfd drop ] [ { 0 } join ] bi* ;
47 : find-bad-collations ( pairs -- seq )
48 [ first2 calculate-collation sequence= ] reject ;
51 [ parse-collation-test-weights find-bad-collations ] unit-test
54 parse-collation-test-shifted
56 [ string<=> { +lt+ +eq+ } member? ] assoc-reject
59 ! FIXME: ducet table is wrong
60 { +lt+ } [ { 4019 98 } { 4019 3953 1 3968 97 } [ >string ] bi@ string<=> ] unit-test
61 { +lt+ } [ { 4018 820 3969 } { 3959 33 } [ >string ] bi@ string<=> ] unit-test
62 { +lt+ } [ { 4019 3953 820 3968 } { 3961 33 } [ >string ] bi@ string<=> ] unit-test
65 { { 12748 12741 0 32 74 32 0 2 2 2 0 65535 65535 65535 } }
66 [ { 3958 3953 820 } >string collation-key/nfd drop ] unit-test
68 { { 12748 12741 0 32 74 32 0 2 2 2 0 65535 65535 65535 } }
69 [ { 4018 820 3953 3968 } >string collation-key/nfd drop ] unit-test
71 { { 12748 12741 0 32 74 32 0 2 2 2 0 65535 65535 65535 } }
72 [ { 0x0FB2 0x0334 0x0F80 0x0F71 } >string collation-key/nfd drop ] unit-test
74 { { 12748 12741 0 32 74 32 0 2 2 2 0 65535 65535 65535 } }
75 [ { 4018 820 3969 } >string collation-key/nfd drop ] unit-test
77 { { 12750 12741 0 32 74 32 0 2 2 2 0 65535 65535 65535 } }
78 [ { 3960 3953 820 } >string collation-key/nfd drop ] unit-test
80 { { 12750 12741 0 32 74 32 0 2 2 2 0 65535 65535 65535 } }
81 [ { 4019 820 3953 3968 } >string collation-key/nfd drop ] unit-test
83 { { 12750 12741 0 32 74 32 0 2 2 2 0 65535 65535 65535 } }
84 [ { 4019 820 3968 3953 } >string collation-key/nfd drop ] unit-test
86 { { 12750 12741 0 32 74 32 0 2 2 2 0 65535 65535 65535 } }
87 [ { 4019 3953 820 3968 } >string collation-key/nfd drop ] unit-test
89 { { 12722 12741 12744 7817 0 32 32 32 32 0 2 2 2 2 0 65535 65535 65535 65535 } }
90 [ { 4019 3953 1 3968 97 } >string collation-key/nfd drop ] unit-test