core/strings/strings-tests.factor

   1 USING: arrays continuations io.streams.null kernel
   2 kernel.private literals make math math.order memory namespaces
   3 prettyprint sbufs sequences strings strings.private tools.test
   4 vectors ;
   5
   6 { CHAR: b } [ 1 >bignum "abc" nth ] unit-test
   7
   8 { } [ 10 [ [ -1000000 <sbuf> ] ignore-errors ] times ] unit-test
   9
  10 { "abc" } [ [ "a" "b" "c" ] [ [ % ] each ] "" make ] unit-test
  11
  12 { "abc" } [ "ab" "c" append ] unit-test
  13 { "abc" } [ "a" "b" "c" 3append ] unit-test
  14
  15 { 3 } [ "a" "hola" subseq-start ] unit-test
  16 { f } [ "x" "hola" subseq-start ] unit-test
  17 { 0 } [ "" "a" subseq-start ] unit-test
  18 { 0 } [ "" "" subseq-start ] unit-test
  19 { 0 } [ "hola" "hola" subseq-start ] unit-test
  20 { 1 } [ "ol" "hola" subseq-start ] unit-test
  21 { f } [ "amigo" "hola" subseq-start ] unit-test
  22 { f } [ "holaa" "hola" subseq-start ] unit-test
  23
  24 { "Beginning" } [ "Beginning and end" 9 head ] unit-test
  25
  26 { f } [ CHAR: I "team" member? ] unit-test
  27 { t } [ "ea" "team" subseq? ] unit-test
  28 { f } [ "actore" "Factor" subseq? ] unit-test
  29 { t } [ "team" "ea" subsequence? ] unit-test
  30 { f } [ "Factor" "actore" subsequence? ] unit-test
  31
  32 { "end" } [ "Beginning and end" 14 tail ] unit-test
  33
  34 { t } [ "abc" "abd" before? ] unit-test
  35 { t } [ "z" "abd" after? ] unit-test
  36 { "abc" } [ "abc" "abd" min ] unit-test
  37 { "z" } [ "z" "abd" max ] unit-test
  38
  39 [ 0 10 "hello" subseq ] must-fail
  40
  41 { "Replacing+spaces+with+plus" }
  42 [
  43     "Replacing spaces with plus"
  44     [ dup CHAR: \s = [ drop CHAR: + ] when ] map
  45 ]
  46 unit-test
  47
  48 { "05" } [ "5" 2 CHAR: 0 pad-head ] unit-test
  49 { "666" } [ "666" 2 CHAR: 0 pad-head ] unit-test
  50
  51 [ 1 "" nth ] must-fail
  52 [ -6 "hello" nth ] must-fail
  53
  54 { t } [ "hello world" dup >vector >string = ] unit-test
  55
  56 { "ab" } [ 2 "abc" resize-string ] unit-test
  57 { "abc\0\0\0" } [ 6 "abc" resize-string ] unit-test
  58
  59 { "\u001234b" } [ 2 "\u001234bc" resize-string ] unit-test
  60 { "\u001234bc\0\0\0" } [ 6 "\u001234bc" resize-string ] unit-test
  61
  62 ! Random tester found this
  63 [ 2 -7 resize-string ]
  64 [ ${ KERNEL-ERROR ERROR-TYPE 11 -7 } = ] must-fail-with
  65
  66 ! Make sure 24-bit strings work
  67 "hello world" "s" set
  68
  69 { } [ 0x1234 1 "s" get set-nth ] unit-test
  70 { 0x1234 } [ 1 "s" get nth ] unit-test
  71
  72 { } [ 0x4321 3 "s" get set-nth ] unit-test
  73 { 0x4321 } [ 3 "s" get nth ] unit-test
  74
  75 { } [ 0x654321 5 "s" get set-nth ] unit-test
  76 { 0x654321 } [ 5 "s" get nth ] unit-test
  77
  78 {
  79     {
  80         CHAR: h
  81         0x1234
  82         CHAR: l
  83         0x4321
  84         CHAR: o
  85         0x654321
  86         CHAR: w
  87         CHAR: o
  88         CHAR: r
  89         CHAR: l
  90         CHAR: d
  91     }
  92 } [
  93     "s" get >array
  94 ] unit-test
  95
  96 ! Make sure string initialization works
  97 { 0x123456 } [ 100 0x123456 <string> first ] unit-test
  98
  99 ! Make sure we clear aux vector when storing octets
 100 { "\u123456hi" } [ "ih\u123456" clone reverse! ] unit-test
 101
 102 ! Make sure aux vector is not shared
 103 { "\udeadbe" } [
 104     "\udeadbe" clone
 105     CHAR: \u123456 over clone set-first
 106 ] unit-test
 107
 108 ! Regressions
 109 { } [
 110     [
 111         4 [
 112             100 [ "obdurak" clone ] replicate
 113             gc
 114             dup [
 115                 1234 0 rot set-string-nth
 116             ] each
 117             1000 [
 118                 1000 f <array> drop
 119             ] times
 120             .
 121         ] times
 122     ] with-null-writer
 123 ] unit-test
 124
 125 { t } [
 126     10000 [
 127         drop
 128         300 100 CHAR: \u123456
 129         [ <string> clone resize-string first ] keep =
 130     ] all-integers?
 131 ] unit-test
 132
 133 "X" "s" set
 134 { } [ 0x100,0000 0 "s" get set-nth ] unit-test
 135 { 0 } [ 0 "s" get nth ] unit-test
 136
 137 { } [ -1 0 "s" get set-nth ] unit-test
 138 { 0x7fffff } [ 0 "s" get nth ] unit-test