1\ Copyright (c) 2006-2016 Michael Scholz <mi-scholz@users.sourceforge.net> 2\ All rights reserved. 3\ 4\ Redistribution and use in source and binary forms, with or without 5\ modification, are permitted provided that the following conditions 6\ are met: 7\ 1. Redistributions of source code must retain the above copyright 8\ notice, this list of conditions and the following disclaimer. 9\ 2. Redistributions in binary form must reproduce the above copyright 10\ notice, this list of conditions and the following disclaimer in the 11\ documentation and/or other materials provided with the distribution. 12\ 13\ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND 14\ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 15\ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 16\ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE 17\ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 18\ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 19\ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 20\ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 21\ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 22\ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 23\ SUCH DAMAGE. 24\ 25\ @(#)string-test.fs 1.33 2/9/16 26 27require test-utils.fs 28 29: string-test ( -- ) 30 \ string-length 31 "hello" string-length 5 <> "string-length 5" test-expr 32 \ string?, char? 33 nil string? "nil string?" test-expr 34 #() string? "#() string?" test-expr 35 0 string? "0 string?" test-expr 36 "fth-test" string? not "\"fth-test\" string?" test-expr 37 nil char? "nil char?" test-expr 38 #() char? "#() char?" test-expr 39 0 char? "0 char?" test-expr 40 <char> m char? not "m char?" test-expr 41 \ make-string, >string, string-concat (alias for >string) 42 0 make-string "" string<> "make-string ''" test-expr 43 3 make-string " " string<> "3 make-string ' '" test-expr 44 3 :initial-element <char> x make-string "xxx" string<> 45 "3 x make-string: 'xxx'" test-expr 46 0 1 2 " foo " "b" "a" "r" 7 >string "012 foo bar" string<> 47 ">string: '012 foo bar'" test-expr 48 \ "" (empty string), $space, $spaces, $cr 49 "" 0 :initial-element <char> x make-string string<> 50 "\"\" (empty string)" test-expr 51 $space " " string<> "$space" test-expr 52 0 $spaces "" string<> "0 $spaces" test-expr 53 3 $spaces " " string<> "3 $spaces" test-expr 54 $cr "\n" string<> "$cr" test-expr 55 \ fth-format 56 "hello" fth-format "hello" string<> "fth-format (1)" test-expr 57 "hello %s %d times\n" #( "pumpkin" 10 ) fth-format 58 "hello pumpkin 10 times\n" string<> "fth-format (2)" test-expr 59 \ string-cmp 60 "foo" { s1 } 61 "bar" { s2 } 62 "foo" { s3 } 63 s1 s2 string-cmp 1 <> "s1 s2 string-cmp 1" test-expr 64 s1 s3 string-cmp 0<> "s1 s2 string-cmp 0" test-expr 65 s2 s3 string-cmp -1 <> "s1 s2 string-cmp -1" test-expr 66 s1 nil string-cmp 1 <> "s1 nil string-cmp 1" test-expr 67 nil nil string-cmp 0<> "nil nil string-cmp 0" test-expr 68 nil s3 string-cmp -1 <> "nil s3 string-cmp -1" test-expr 69 \ string=, string<>, string<, string> 70 s1 s2 string= "s1 s2 string=" test-expr 71 s1 s3 string= not "s1 s3 string=" test-expr 72 s3 s3 string= not "s3 s3 string=" test-expr 73 s1 s2 string<> not "s1 s2 string<>" test-expr 74 s1 s3 string<> "s1 s3 string<>" test-expr 75 s3 s3 string<> "s3 s3 string<>" test-expr 76 s1 s2 string< "s1 s2 string<" test-expr 77 s1 s3 string< "s1 s3 string<" test-expr 78 s3 s3 string< "s3 s3 string<" test-expr 79 s1 s2 string> not "s1 s2 string>" test-expr 80 s1 s3 string> "s1 s3 string>" test-expr 81 s3 s3 string> "s3 s3 string>" test-expr 82 \ string->array, string-copy 83 s1 string->array #( 102 111 111 ) array= not "string->array" test-expr 84 s1 string-copy to s2 85 s1 s2 string<> "string-copy (1)" test-expr 86 s2 string-reverse! drop 87 s1 "foo" string<> "string-copy (2)" test-expr 88 s2 "oof" string<> "string-copy (3)" test-expr 89 \ string-ref|set! 90 s1 0 string-ref <char> f <> "string-ref (0)" test-expr 91 s1 -1 string-ref <char> o <> "string-ref (-1)" test-expr 92 s1 0 <char> z string-set! 93 s1 0 string-ref <char> z <> "string-set! (0)" test-expr 94 s1 -1 <char> y string-set! 95 s1 -1 string-ref <char> y <> "string-set! (-1)" test-expr 96 s1 0 <char> f string-set! 97 s1 -1 <char> o string-set! 98 s1 "foo" string<> "reset after string-set!" test-expr 99 \ string-push|pop|unshift|shift 100 s1 $space string-push drop 101 s1 10 string-push drop 102 s1 "foo 10" string<> "string-push (1)" test-expr 103 "fth-test" "-string-test" string-push "fth-test-string-test" string<> 104 "string-push (2)" test-expr 105 "foo" to s1 106 s1 string-pop 111 <> "string-pop (1)" test-expr 107 s1 string-pop 111 <> "string-pop (2)" test-expr 108 s1 string-pop 102 <> "string-pop (3)" test-expr 109 s1 string-pop #f <> "string-pop (4)" test-expr 110 "fth-test" string-pop <char> t <> "string-pop (5)" test-expr 111 "foo" to s1 112 s1 $space string-unshift drop 113 s1 10 string-unshift drop 114 s1 "10 foo" string<> "string-unshift (1)" test-expr 115 "fth-test" "string-test-" string-unshift "string-test-fth-test" string<> 116 "string-unshift (2)" test-expr 117 "foo" to s1 118 s1 string-shift 102 <> "string-shift (1)" test-expr 119 s1 string-shift 111 <> "string-shift (2)" test-expr 120 s1 string-shift 111 <> "string-shift (3)" test-expr 121 s1 string-shift #f <> "string-shift (4)" test-expr 122 "fth-test" string-shift <char> f <> "string-shift (5)" test-expr 123 "" { str } 124 128 { len } 125 len 0 do str str string-push to str loop 126 len 0 do str string-pop drop loop 127 str "" string= unless 128 "128 string-push|pop: \"\" <> %s?" #( str ) fth-display 129 then 130 len 0 do str str string-unshift to str loop 131 len 0 do str string-shift drop loop 132 str "" string= unless 133 "128 string-unshift|shift: \"\" <> %s?" #( str ) fth-display 134 then 135 "" ( str ) 0 len 1- do 136 ( str ) i string-unshift $space string-unshift 137 -1 +loop dup string-shift drop to str 138 str #f string-split each ( x ) 139 string->number i <> "string-unshift loop" test-expr 140 end-each 141 \ string-append, string-reverse(!) 142 "foo" to s1 143 "bar" to s2 144 s1 s2 string-append to s3 145 s1 "foo" string<> "string-append (1)" test-expr 146 s2 "bar" string<> "string-append (2)" test-expr 147 s3 "foobar" string<> "string-append (3)" test-expr 148 "fth-test" { str1 } 149 str1 "-string-append" string-append "fth-test-string-append" string<> 150 "string-append" test-expr 151 s1 string-reverse to s2 152 s1 "foo" string<> "string-reverse (1)" test-expr 153 s2 "oof" string<> "string-reverse (2)" test-expr 154 s1 string-reverse! to s3 155 s1 "oof" string<> "string-reverse! (1)" test-expr 156 s3 "oof" string<> "string-reverse! (2)" test-expr 157 str1 string-reverse "tset-htf" string<> "string-reverse (3)" test-expr 158 str1 string-reverse! "tset-htf" string<> "string-reverse! (3)" test-expr 159 str1 string-reverse! "fth-test" string<> "string-reverse! (4)" test-expr 160 \ string-insert!, string-delete! 161 "foo" to s1 162 s1 1 10 string-insert! "f10oo" string<> "string-insert! (1)" test-expr 163 s1 "f10oo" string<> "string-insert! (2)" test-expr 164 "foo" to s1 165 s1 1 string-delete! 111 <> "string-delete! (1)" test-expr 166 s1 "fo" string<> "string-delete! (2)" test-expr 167 "fth-test" 0 "beg-" string-insert! { str2 } 168 str2 "beg-fth-test" string<> "string-insert! (3)" test-expr 169 str2 0 string-delete! drop 170 str2 "eg-fth-test" string<> "string-insert! (4)" test-expr 171 str2 0 string-delete! drop 172 str2 0 string-delete! drop 173 str2 0 string-delete! drop 174 "" ( str ) 0 len 1- do 175 ( str ) 0 i object->string $space $+ string-insert! 176 -1 +loop dup string-pop drop to str 177 str #f string-split each ( x ) 178 string->number i <> "string-insert! loop" test-expr 179 end-each 180 \ string-fill, string-index, string-member?, string-find 181 "foo" to s1 182 s1 <char> a string-fill "aaa" string<> "string-fill (1)" test-expr 183 s1 "aaa" string<> "string-fill (2)" test-expr 184 3 :initial-element <char> p make-string <char> f string-fill to s1 185 s1 "fff" string<> "string-fill (3)" test-expr 186 "hello world" "l" string-index 2 <> "string-index (1)" test-expr 187 "hello world" "orl" string-index 7 <> "string-index (2)" test-expr 188 "hello world" "k" string-index -1 <> "string-index (3)" test-expr 189 "hello world" "l" string-member? #t <> "string-member? (1)" test-expr 190 "hello world" "orl" string-member? #t <> "string-member? (2)" test-expr 191 "hello world" "k" string-member? #f <> "string-member? (3)" test-expr 192 "hello world" "l" string-find "llo world" string<> 193 "string-find (1)" test-expr 194 "hello world" /ell/ string-find "ello world" string<> 195 "string-find (2)" test-expr 196 "hello world" /k/ string-find #f <> 197 "string-find (3)" test-expr 198 \ string-split 199 "foo:bar:baz" ":" string-split #( "foo" "bar" "baz" ) array= not 200 "string-split (:)" test-expr 201 "foo:bar:baz" "/:/" string-split #( "foo" "bar" "baz" ) array= not 202 "string-split (/:/)" test-expr 203 "foo bar baz" nil string-split #( "foo" "bar" "baz" ) array= not 204 "string-split (n)" test-expr 205 "foo bar baz" #f string-split #( "foo" "bar" "baz" ) array= not 206 "string-split (#f)" test-expr 207 \ string-substring 208 "hello world" 2 4 string-substring "ll" string<> 209 "string-substring (1)" test-expr 210 "hello world" -4 -2 string-substring "or" string<> 211 "string-substring (2)" test-expr 212 "hello world" -4 nil string-substring "orld" string<> 213 "string-substring (3)" test-expr 214 \ string-upcase(!), string-downcase(!), string-capitalize(!) 215 "Foo" to s1 216 s1 string-upcase to s2 217 s1 "Foo" string<> "string-upcase (1)" test-expr 218 s2 "FOO" string<> "string-upcase (2)" test-expr 219 s1 string-upcase! to s2 220 s1 "FOO" string<> "string-upcase! (1)" test-expr 221 s2 "FOO" string<> "string-upcase! (2)" test-expr 222 "Foo" to s1 223 s1 string-downcase to s2 224 s1 "Foo" string<> "string-downcase (1)" test-expr 225 s2 "foo" string<> "string-downcase (2)" test-expr 226 s1 string-downcase! to s2 227 s1 "foo" string<> "string-downcase! (1)" test-expr 228 s2 "foo" string<> "string-downcase! (2)" test-expr 229 "foO" to s1 230 s1 string-capitalize to s2 231 s1 "foO" string<> "string-capitalize (1)" test-expr 232 s2 "Foo" string<> "string-capitalize (2)" test-expr 233 s1 string-capitalize! to s2 234 s1 "Foo" string<> "string-capitalize! (1)" test-expr 235 s2 "Foo" string<> "string-capitalize! (2)" test-expr 236 \ string-replace(!) 237 "foo" to s1 238 s1 "o" "a" string-replace to s2 239 s1 "oo" "a" string-replace to s3 240 s1 "foo" string<> "string-replace (1)" test-expr 241 s2 "faa" string<> "string-replace (2)" test-expr 242 s3 "fa" string<> "string-replace (3)" test-expr 243 "foo" to s1 244 "foo" to s2 245 s1 "o" "a" string-replace! drop 246 s2 "oo" "a" string-replace! drop 247 s1 "faa" string<> "string-replace (1)" test-expr 248 s2 "fa" string<> "string-replace (2)" test-expr 249 "foo" "o" "oo" string-replace "foooo" string<> 250 "string-replace (with same char)" test-expr 251 "foo" "o" "oo" string-replace! "foooo" string<> 252 "string-replace! (with same char)" test-expr 253 "foo" "o" "" string-replace "f" string<> 254 "string-replace (delete)" test-expr 255 "foo" "o" "" string-replace! "f" string<> 256 "string-replace! (delete)" test-expr 257 \ string-chomp(!) 258 "foo\n" to s1 259 "bar" to s2 260 s1 string-chomp "foo" string<> "string-chomp (1)" test-expr 261 s2 string-chomp "bar" string<> "string-chomp (2)" test-expr 262 s1 string-chomp! drop 263 s2 string-chomp! drop 264 s1 "foo" string<> "string-chomp! (1)" test-expr 265 s2 "bar" string<> "string-chomp! (2)" test-expr 266 \ string-format 267 "%04d %8.2f %b %X %o" #( 128 pi 255 255 255 ) string-format 268 "0128 3.14 11111111 FF 377" string<> 269 "string-format (1)" test-expr 270 precision { prec } 271 5 set-precision 272 "0x%x\t%p %p\n" #( 127 #( pi ) #( pi ) ) string-format 273 "\ 2740x7f\t#<array[1]: #<float: 3.14159>> #<array[1]: #<float: 3.14159>>\n" 275 string<> "string-format (2)" test-expr 276 prec set-precision 277 \ string-eval(-with-status) 278 "3 4 +" string-eval 7 <> "string-eval (1)" test-expr 279 7 "3 4 + +" string-eval 14 <> "string-eval (2)" test-expr 280 7 "3 4 + +" string-eval 10 * 140 <> "string-eval (3)" test-expr 281 "3 4 +" string-eval-with-status nip OUT_OF_TEXT <> 282 "string-eval-with-status (1)" test-expr 283 7 "3 4 + +" string-eval-with-status nip OUT_OF_TEXT <> 284 "string-eval-with-status (2)" test-expr 285 \ string>$, $>string 286 "hello" string>$ s" hello" compare 0<> "string>$?" test-expr 287 s" hello" $>string "hello" string<> "$>string?" test-expr 288; 289 290*fth-test-count* 0 [do] string-test [loop] 291 292\ string-test.fs ends here 293