basis/unicode/collation/collation-tests.factor

   1 USING: arrays assocs fry grouping io io.encodings.utf8 io.files
   2 io.streams.null kernel math math.order math.parser multiline
   3 random sequences splitting strings tools.test unicode words ;
   4 IN: unicode.collation.tests
   5
   6 : test-equality ( str1 str2 -- ? ? ? ? )
   7     { primary= secondary= tertiary= quaternary= }
   8     [ execute( a b -- ? ) ] 2with map
   9     first4 ;
  10
  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
  18
  19 : parse-collation-test-shifted ( -- lines )
  20     "vocab:unicode/UCA/CollationTest/CollationTest_SHIFTED.txt" utf8 file-lines
  21     [ "#@" split first ] map harvest
  22     [ ";" split first ] map
  23     [ " " split [ hex> ] "" map-as ] map ;
  24
  25 : tail-from-last ( string char -- string' )
  26     '[ _ = ] dupd find-last drop 1 + tail ; inline
  27
  28 : line>test-weights ( string -- pair )
  29     ";" split1 [
  30         " " split [ hex> ] map
  31     ] [
  32         "#" split1 nip CHAR: [ tail-from-last
  33         "]" split1 drop
  34         "|" split 4 head
  35         [ " " split harvest [ hex> ] map ] map
  36     ] bi* 2array ;
  37
  38 : parse-collation-test-weights ( -- weights )
  39     "vocab:unicode/UCA/CollationTest/CollationTest_SHIFTED.txt" utf8 file-lines
  40     [ "#" head? ] reject harvest
  41     [ line>test-weights ] map ;
  42
  43 : calculate-collation ( chars collation -- collation-calculated collation-answer )
  44     [ >string collation-key/nfd drop ] [ { 0 } join ] bi* ;
  45
  46 : find-bad-collations ( pairs -- seq )
  47     [ first2 dupd calculate-collation 3array ] map
  48     [ first3 sequence= nip ] reject ;
  49
  50 { { } }
  51 [ parse-collation-test-weights find-bad-collations ] unit-test
  52
  53 { { } } [
  54     parse-collation-test-shifted
  55     2 clump
  56     [ string<=> { +lt+ +eq+ } member? ] assoc-reject
  57 ] unit-test
  58
  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
  63
  64
  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
  67
  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
  70
  71 { { 12748 12741 0 32 74 32 0 2 2 2 0 65535 65535 65535 } }
  72 [ { 4018 820 3968 3953 } >string collation-key/nfd drop ] unit-test
  73
  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
  76
  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
  79
  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
  82
  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
  85
  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
  88
  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