srfi-13.test 51 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674
  1. ;;;; srfi-13.test --- Test suite for Guile's SRFI-13 functions. -*- scheme -*-
  2. ;;;; Martin Grabmueller, 2001-05-07
  3. ;;;;
  4. ;;;; Copyright (C) 2001, 2004, 2005, 2006, 2011, 2012 Free Software Foundation, Inc.
  5. ;;;;
  6. ;;;; This library is free software; you can redistribute it and/or
  7. ;;;; modify it under the terms of the GNU Lesser General Public
  8. ;;;; License as published by the Free Software Foundation; either
  9. ;;;; version 3 of the License, or (at your option) any later version.
  10. ;;;;
  11. ;;;; This library is distributed in the hope that it will be useful,
  12. ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  14. ;;;; Lesser General Public License for more details.
  15. ;;;;
  16. ;;;; You should have received a copy of the GNU Lesser General Public
  17. ;;;; License along with this library; if not, write to the Free Software
  18. ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  19. (define-module (test-strings)
  20. #:use-module (test-suite lib)
  21. #:use-module (srfi srfi-13)
  22. #:use-module (srfi srfi-14))
  23. (define exception:strict-infix-grammar
  24. (cons 'misc-error "^strict-infix"))
  25. ;; Create a string from integer char values, eg. (string-ints 65) => "A"
  26. (define (string-ints . args)
  27. (apply string (map integer->char args)))
  28. ;; Some abbreviations
  29. ;; BMP - Basic Multilingual Plane (codepoints below U+FFFF)
  30. ;; SMP - Suplementary Multilingual Plane (codebpoints from U+10000 to U+1FFFF)
  31. ;;;
  32. ;;; string-any
  33. ;;;
  34. (with-test-prefix "string-any"
  35. (pass-if "null string"
  36. (not (string-any #\a "")))
  37. (pass-if "start index == end index"
  38. (not (string-any #\a "aaa" 1 1)))
  39. (with-test-prefix "bad char_pred"
  40. (pass-if-exception "integer" exception:wrong-type-arg
  41. (string-any 123 "abcde"))
  42. (pass-if-exception "string" exception:wrong-type-arg
  43. (string-any "zzz" "abcde")))
  44. (with-test-prefix "char"
  45. (pass-if "no match"
  46. (not (string-any #\C "abcde")))
  47. (pass-if "one match"
  48. (string-any #\C "abCde"))
  49. (pass-if "one match: BMP"
  50. (string-any (integer->char #x0100) "ab\u0100de"))
  51. (pass-if "one match: SMP"
  52. (string-any (integer->char #x010300) "ab\U010300de"))
  53. (pass-if "more than one match"
  54. (string-any #\X "abXXX"))
  55. (pass-if "no match, start index"
  56. (not (string-any #\A "Abcde" 1)))
  57. (pass-if "one match, start index"
  58. (string-any #\C "abCde" 1))
  59. (pass-if "more than one match, start index"
  60. (string-any #\X "abXXX" 1))
  61. (pass-if "no match, start and end index"
  62. (not (string-any #\X "XbcdX" 1 4)))
  63. (pass-if "one match, start and end index"
  64. (string-any #\C "abCde" 1 4))
  65. (pass-if "more than one match, start and end index"
  66. (string-any #\X "abXXX" 1 4)))
  67. (with-test-prefix "charset"
  68. (pass-if "no match"
  69. (not (string-any char-set:upper-case "abcde")))
  70. (pass-if "one match"
  71. (string-any char-set:upper-case "abCde"))
  72. (pass-if "more than one match"
  73. (string-any char-set:upper-case "abCDE"))
  74. (pass-if "no match, start index"
  75. (not (string-any char-set:upper-case "Abcde" 1)))
  76. (pass-if "one match, start index"
  77. (string-any char-set:upper-case "abCde" 1))
  78. (pass-if "more than one match, start index"
  79. (string-any char-set:upper-case "abCDE" 1))
  80. (pass-if "no match, start and end index"
  81. (not (string-any char-set:upper-case "AbcdE" 1 4)))
  82. (pass-if "one match, start and end index"
  83. (string-any char-set:upper-case "abCde" 1 4))
  84. (pass-if "more than one match, start and end index"
  85. (string-any char-set:upper-case "abCDE" 1 4)))
  86. (with-test-prefix "pred"
  87. (pass-if "no match"
  88. (not (string-any char-upper-case? "abcde")))
  89. (pass-if "one match"
  90. (string-any char-upper-case? "abCde"))
  91. (pass-if "more than one match"
  92. (string-any char-upper-case? "abCDE"))
  93. (pass-if "no match, start index"
  94. (not (string-any char-upper-case? "Abcde" 1)))
  95. (pass-if "one match, start index"
  96. (string-any char-upper-case? "abCde" 1))
  97. (pass-if "more than one match, start index"
  98. (string-any char-upper-case? "abCDE" 1))
  99. (pass-if "no match, start and end index"
  100. (not (string-any char-upper-case? "AbcdE" 1 4)))
  101. (pass-if "one match, start and end index"
  102. (string-any char-upper-case? "abCde" 1 4))
  103. (pass-if "more than one match, start and end index"
  104. (string-any char-upper-case? "abCDE" 1 4))))
  105. ;;;
  106. ;;; string-titlecase
  107. ;;;
  108. (with-test-prefix "string-titlecase"
  109. (pass-if "all-lower"
  110. (string=? "Foo" (string-titlecase "foo")))
  111. (pass-if "all-upper"
  112. (string=? "Foo" (string-titlecase "FOO")))
  113. (pass-if "two-words"
  114. (string=? "Hello, World!" (string-titlecase "hello, world!")))
  115. (pass-if "titlecase-characters"
  116. (string=? (list->string '(#\762))
  117. (string-titlecase (list->string '(#\763))))))
  118. ;;;
  119. ;;; string-append/shared
  120. ;;;
  121. (with-test-prefix "string-append/shared"
  122. (pass-if "no args"
  123. (string=? "" (string-append/shared)))
  124. (with-test-prefix "one arg"
  125. (pass-if "empty"
  126. (string=? "" (string-append/shared "")))
  127. (pass-if "non-empty"
  128. (string=? "xyz" (string-append/shared "xyz"))))
  129. (with-test-prefix "two args"
  130. (pass-if (string=? "" (string-append/shared "" "")))
  131. (pass-if (string=? "xyz" (string-append/shared "xyz" "")))
  132. (pass-if (string=? "xyz" (string-append/shared "" "xyz")))
  133. (pass-if (string=? "abcxyz" (string-append/shared "abc" "xyz")))
  134. (pass-if (string=? "abc\u0100\u0101"
  135. (string-append/shared "abc" "\u0100\u0101"))))
  136. (with-test-prefix "three args"
  137. (pass-if (string=? "" (string-append/shared "" "" "")))
  138. (pass-if (string=? "xy" (string-append/shared "xy" "" "")))
  139. (pass-if (string=? "xy" (string-append/shared "" "xy" "")))
  140. (pass-if (string=? "abxy" (string-append/shared "ab" "xy" "")))
  141. (pass-if (string=? "ab" (string-append/shared "" "" "ab")))
  142. (pass-if (string=? "xyab" (string-append/shared "xy" "" "ab")))
  143. (pass-if (string=? "xyab" (string-append/shared "" "xy" "ab")))
  144. (pass-if (string=? "ghxyab" (string-append/shared "gh" "xy" "ab"))))
  145. (with-test-prefix "four args"
  146. (pass-if (string=? "" (string-append/shared "" "" "" "")))
  147. (pass-if (string=? "xy" (string-append/shared "xy" "" "" "")))
  148. (pass-if (string=? "xy" (string-append/shared "" "xy" "" "")))
  149. (pass-if (string=? "xy" (string-append/shared "" "" "xy" "")))
  150. (pass-if (string=? "xy" (string-append/shared "" "" "" "xy")))
  151. (pass-if (string=? "abxy" (string-append/shared "ab" "xy" "" "")))
  152. (pass-if (string=? "abxy" (string-append/shared "ab" "" "xy" "")))
  153. (pass-if (string=? "abxy" (string-append/shared "ab" "" "" "xy")))
  154. (pass-if (string=? "abxy" (string-append/shared "" "ab" "" "xy")))
  155. (pass-if (string=? "abxy" (string-append/shared "" "" "ab" "xy")))))
  156. ;;;
  157. ;;; string-concatenate
  158. ;;;
  159. (with-test-prefix "string-concatenate"
  160. (pass-if-exception "inum" exception:wrong-type-arg
  161. (string-concatenate 123))
  162. (pass-if-exception "symbol" exception:wrong-type-arg
  163. (string-concatenate 'x))
  164. (pass-if-exception "improper 1" exception:wrong-type-arg
  165. (string-concatenate '("a" . "b")))
  166. (pass-if (equal? "abc" (string-concatenate '("a" "b" "c"))))
  167. (pass-if "concatenate BMP"
  168. (equal? "a\u0100" (string-concatenate '("a" "\u0100")))))
  169. ;;
  170. ;; string-compare
  171. ;;
  172. (with-test-prefix "string-compare"
  173. (pass-if "same as char<?"
  174. (eq? (char<? (integer->char 0) (integer->char 255))
  175. (string-compare (string-ints 0) (string-ints 255)
  176. (lambda (pos) #t) ;; lt
  177. (lambda (pos) #f) ;; eq
  178. (lambda (pos) #f))))) ;; gt
  179. ;;
  180. ;; string-compare-ci
  181. ;;
  182. (with-test-prefix "string-compare-ci"
  183. (pass-if "same as char-ci<?"
  184. (eq? (char-ci<? (integer->char 0) (integer->char 255))
  185. (string-compare-ci (string-ints 0) (string-ints 255)
  186. (lambda (pos) #t) ;; lt
  187. (lambda (pos) #f) ;; eq
  188. (lambda (pos) #f))))) ;; gt
  189. ;;;
  190. ;;; string-concatenate/shared
  191. ;;;
  192. (with-test-prefix "string-concatenate/shared"
  193. (pass-if-exception "inum" exception:wrong-type-arg
  194. (string-concatenate/shared 123))
  195. (pass-if-exception "symbol" exception:wrong-type-arg
  196. (string-concatenate/shared 'x))
  197. (pass-if-exception "improper 1" exception:wrong-type-arg
  198. (string-concatenate/shared '("a" . "b")))
  199. (pass-if (equal? "abc" (string-concatenate/shared '("a" "b" "c"))))
  200. (pass-if "BMP"
  201. (equal? "a\u0100c" (string-concatenate/shared '("a" "\u0100" "c")))))
  202. ;;;
  203. ;;; string-every
  204. ;;;
  205. (with-test-prefix "string-every"
  206. (pass-if "null string"
  207. (string-every #\a ""))
  208. (pass-if "start index == end index"
  209. (string-every #\a "bbb" 1 1))
  210. (with-test-prefix "bad char_pred"
  211. (pass-if-exception "integer" exception:wrong-type-arg
  212. (string-every 123 "abcde"))
  213. (pass-if-exception "string" exception:wrong-type-arg
  214. (string-every "zzz" "abcde")))
  215. (with-test-prefix "char"
  216. (pass-if "empty string"
  217. (string-every #\X ""))
  218. (pass-if "empty substring"
  219. (string-every #\X "abc" 1 1))
  220. (pass-if "no match at all"
  221. (not (string-every #\X "abcde")))
  222. (pass-if "not all match"
  223. (not (string-every #\X "abXXX")))
  224. (pass-if "all match"
  225. (string-every #\X "XXXXX"))
  226. (pass-if "all match BMP"
  227. (string-every #\200000 "\U010000\U010000"))
  228. (pass-if "no match at all, start index"
  229. (not (string-every #\X "Xbcde" 1)))
  230. (pass-if "not all match, start index"
  231. (not (string-every #\X "XXcde" 1)))
  232. (pass-if "all match, start index"
  233. (string-every #\X "aXXXX" 1))
  234. (pass-if "no match at all, start and end index"
  235. (not (string-every #\X "XbcdX" 1 4)))
  236. (pass-if "not all match, start and end index"
  237. (not (string-every #\X "XXcde" 1 4)))
  238. (pass-if "all match, start and end index"
  239. (string-every #\X "aXXXe" 1 4)))
  240. (with-test-prefix "charset"
  241. (pass-if "empty string"
  242. (string-every char-set:upper-case ""))
  243. (pass-if "empty substring"
  244. (string-every char-set:upper-case "abc" 1 1))
  245. (pass-if "no match at all"
  246. (not (string-every char-set:upper-case "abcde")))
  247. (pass-if "not all match"
  248. (not (string-every char-set:upper-case "abCDE")))
  249. (pass-if "all match"
  250. (string-every char-set:upper-case "ABCDE"))
  251. (pass-if "no match at all, start index"
  252. (not (string-every char-set:upper-case "Abcde" 1)))
  253. (pass-if "not all match, start index"
  254. (not (string-every char-set:upper-case "ABcde" 1)))
  255. (pass-if "all match, start index"
  256. (string-every char-set:upper-case "aBCDE" 1))
  257. (pass-if "no match at all, start and end index"
  258. (not (string-every char-set:upper-case "AbcdE" 1 4)))
  259. (pass-if "not all match, start and end index"
  260. (not (string-every char-set:upper-case "ABcde" 1 4)))
  261. (pass-if "all match, start and end index"
  262. (string-every char-set:upper-case "aBCDe" 1 4)))
  263. (with-test-prefix "pred"
  264. ;; in guile 1.6.4 and earlier string-every incorrectly returned #f on an
  265. ;; empty string
  266. (pass-if "empty string"
  267. (string-every char-upper-case? ""))
  268. (pass-if "empty substring"
  269. (string-every char-upper-case? "abc" 1 1))
  270. (pass-if "no match at all"
  271. (not (string-every char-upper-case? "abcde")))
  272. (pass-if "not all match"
  273. (not (string-every char-upper-case? "abCDE")))
  274. (pass-if "all match"
  275. (string-every char-upper-case? "ABCDE"))
  276. (pass-if "no match at all, start index"
  277. (not (string-every char-upper-case? "Abcde" 1)))
  278. (pass-if "not all match, start index"
  279. (not (string-every char-upper-case? "ABcde" 1)))
  280. (pass-if "all match, start index"
  281. (string-every char-upper-case? "aBCDE" 1))
  282. (pass-if "no match at all, start and end index"
  283. (not (string-every char-upper-case? "AbcdE" 1 4)))
  284. (pass-if "not all match, start and end index"
  285. (not (string-every char-upper-case? "ABcde" 1 4)))
  286. (pass-if "all match, start and end index"
  287. (string-every char-upper-case? "aBCDe" 1 4))))
  288. (with-test-prefix "string-tabulate"
  289. (with-test-prefix "bad proc"
  290. (pass-if-exception "integer" exception:wrong-type-arg
  291. (string-tabulate 123 10))
  292. (pass-if-exception "string" exception:wrong-type-arg
  293. (string-tabulate "zzz" 10)))
  294. (pass-if "static fill-char"
  295. (string=? (string-tabulate (lambda (idx) #\!) 10) "!!!!!!!!!!"))
  296. (pass-if "variable fill-char"
  297. (string=? (string-tabulate
  298. (lambda (idx) (integer->char (+ idx 32))) 10) " !\"#$%&'()")))
  299. (with-test-prefix "string->list"
  300. (pass-if "empty"
  301. (zero? (length (string->list ""))))
  302. (pass-if "nonempty"
  303. (= (length (string->list "foo")) 3))
  304. (pass-if "empty, start index"
  305. (zero? (length (string->list "foo" 3 3))))
  306. (pass-if "nonempty, start index"
  307. (= (length (string->list "foo" 1 3)) 2))
  308. (pass-if "nonempty, start index, BMP"
  309. (= (length (string->list "\xff\u0100\u0300" 1 3)) 2))
  310. )
  311. (with-test-prefix "reverse-list->string"
  312. (pass-if "empty"
  313. (string-null? (reverse-list->string '())))
  314. (pass-if "nonempty"
  315. (string=? "foo" (reverse-list->string '(#\o #\o #\f))))
  316. (pass-if "nonempty, BMP"
  317. (string=? "\u0100\u0101\u0102" (reverse-list->string '(#\402 #\401 #\400)))))
  318. (with-test-prefix "string-join"
  319. (pass-if "empty list, no delimiter, implicit infix, empty 1"
  320. (string=? "" (string-join '())))
  321. (pass-if "empty string, no delimiter, implicit infix, empty 2"
  322. (string=? "" (string-join '(""))))
  323. (pass-if "non-empty, no delimiter, implicit infix"
  324. (string=? "bla" (string-join '("bla"))))
  325. (pass-if "empty list, implicit infix, empty 1"
  326. (string=? "" (string-join '() "|delim|")))
  327. (pass-if "empty string, implicit infix, empty 2"
  328. (string=? "" (string-join '("") "|delim|")))
  329. (pass-if "non-empty, implicit infix"
  330. (string=? "bla" (string-join '("bla") "|delim|")))
  331. (pass-if "non-empty, implicit infix"
  332. (string=? "bla" (string-join '("bla") "|delim|")))
  333. (pass-if "two strings, implicit infix"
  334. (string=? "bla|delim|fasel" (string-join '("bla" "fasel") "|delim|")))
  335. (pass-if "empty, explicit infix"
  336. (string=? "" (string-join '("") "|delim|" 'infix)))
  337. (pass-if "empty list, explicit infix"
  338. (string=? "" (string-join '() "|delim|" 'infix)))
  339. (pass-if "non-empty, explicit infix"
  340. (string=? "bla" (string-join '("bla") "|delim|" 'infix)))
  341. (pass-if "two strings, explicit infix"
  342. (string=? "bla|delim|fasel" (string-join '("bla" "fasel") "|delim|"
  343. 'infix)))
  344. (pass-if "two strings, explicit infix, BMP"
  345. (string=? "\u0100\u0101::\u0102\u0103"
  346. (string-join '("\u0100\u0101" "\u0102\u0103") "::"
  347. 'infix)))
  348. (pass-if-exception "empty list, strict infix"
  349. exception:strict-infix-grammar
  350. (string-join '() "|delim|" 'strict-infix))
  351. (pass-if "empty, strict infix"
  352. (string=? "" (string-join '("") "|delim|" 'strict-infix)))
  353. (pass-if "non-empty, strict infix"
  354. (string=? "foo" (string-join '("foo") "|delim|" 'strict-infix)))
  355. (pass-if "two strings, strict infix"
  356. (string=? "foo|delim|bar" (string-join '("foo" "bar") "|delim|"
  357. 'strict-infix)))
  358. (pass-if "empty list, prefix"
  359. (string=? "" (string-join '() "|delim|" 'prefix)))
  360. (pass-if "empty, prefix"
  361. (string=? "|delim|" (string-join '("") "|delim|" 'prefix)))
  362. (pass-if "non-empty, prefix"
  363. (string=? "|delim|foo" (string-join '("foo") "|delim|" 'prefix)))
  364. (pass-if "two strings, prefix"
  365. (string=? "|delim|foo|delim|bar" (string-join '("foo" "bar") "|delim|"
  366. 'prefix)))
  367. (pass-if "empty list, suffix"
  368. (string=? "" (string-join '() "|delim|" 'suffix)))
  369. (pass-if "empty, suffix"
  370. (string=? "|delim|" (string-join '("") "|delim|" 'suffix)))
  371. (pass-if "non-empty, suffix"
  372. (string=? "foo|delim|" (string-join '("foo") "|delim|" 'suffix)))
  373. (pass-if "two strings, suffix"
  374. (string=? "foo|delim|bar|delim|" (string-join '("foo" "bar") "|delim|"
  375. 'suffix))))
  376. (with-test-prefix "string-copy"
  377. (pass-if "empty string"
  378. (string=? "" (string-copy "")))
  379. (pass-if "full string"
  380. (string=? "foo-bar" (string-copy "foo-bar")))
  381. (pass-if "full string, BMP"
  382. (string=? "foo-\u0100\u0101" (string-copy "foo-\u0100\u0101")))
  383. (pass-if "start index"
  384. (string=? "o-bar" (string-copy "foo-bar" 2)))
  385. (pass-if "start index"
  386. (string=? "o-bar" (string-copy "\u0100\u0101o-bar" 2)))
  387. (pass-if "start and end index"
  388. (string=? "o-ba" (string-copy "foo-bar" 2 6))))
  389. (with-test-prefix "substring/shared"
  390. (pass-if "empty string"
  391. (let ((s ""))
  392. (eq? s (substring/shared s 0))))
  393. (pass-if "non-empty string, not eq?"
  394. (string=? "foo" (substring/shared "foo-bar" 0 3)))
  395. (pass-if "shared copy of non-empty string is eq?"
  396. (let ((s "foo-bar"))
  397. (eq? s (substring/shared s 0 7)))))
  398. (with-test-prefix "string-copy!"
  399. (pass-if "non-empty string"
  400. (string=? "welld, oh yeah!"
  401. (let* ((s "hello")
  402. (t (string-copy "world, oh yeah!")))
  403. (string-copy! t 1 s 1 3)
  404. t)))
  405. (pass-if-equal "overlapping src and dest, moving right"
  406. "aabce"
  407. (let ((str (string-copy "abcde")))
  408. (string-copy! str 1 str 0 3) str))
  409. (pass-if-equal "overlapping src and dest, moving left"
  410. "bcdde"
  411. (let ((str (string-copy "abcde")))
  412. (string-copy! str 0 str 1 4) str)))
  413. (with-test-prefix "string-take"
  414. (pass-if "empty string"
  415. (string=? "" (string-take "foo bar braz" 0)))
  416. (pass-if "non-empty string"
  417. (string=? "foo " (string-take "foo bar braz" 4)))
  418. (pass-if "non-empty string BMP"
  419. (string=? "\u0100oo " (string-take "\u0100oo \u0101ar braz" 4)))
  420. (pass-if "full string"
  421. (string=? "foo bar braz" (string-take "foo bar braz" 12))))
  422. (with-test-prefix "string-take-right"
  423. (pass-if "empty string"
  424. (string=? "" (string-take-right "foo bar braz" 0)))
  425. (pass-if "non-empty string"
  426. (string=? "braz" (string-take-right "foo bar braz" 4)))
  427. (pass-if "non-empty string"
  428. (string=? "braz" (string-take-right "foo ba\u0100 braz" 4)))
  429. (pass-if "full string"
  430. (string=? "foo bar braz" (string-take-right "foo bar braz" 12))))
  431. (with-test-prefix "string-drop"
  432. (pass-if "empty string"
  433. (string=? "" (string-drop "foo bar braz" 12)))
  434. (pass-if "non-empty string"
  435. (string=? "braz" (string-drop "foo bar braz" 8)))
  436. (pass-if "non-empty string BMP"
  437. (string=? "braz" (string-drop "foo \u0100\u0101\u0102 braz" 8)))
  438. (pass-if "full string"
  439. (string=? "foo bar braz" (string-drop "foo bar braz" 0))))
  440. (with-test-prefix "string-drop-right"
  441. (pass-if "empty string"
  442. (string=? "" (string-drop-right "foo bar braz" 12)))
  443. (pass-if "non-empty string"
  444. (string=? "foo " (string-drop-right "foo bar braz" 8)))
  445. (pass-if "non-empty string BMP"
  446. (string=? "foo " (string-drop-right "foo \u0100\u0101\u0102 braz" 8)))
  447. (pass-if "full string"
  448. (string=? "foo bar braz" (string-drop-right "foo bar braz" 0))))
  449. (with-test-prefix "string-pad"
  450. (pass-if "empty string, zero pad"
  451. (string=? "" (string-pad "" 0)))
  452. (pass-if "empty string, zero pad, pad char"
  453. (string=? "" (string-pad "" 0)))
  454. (pass-if "empty pad string, 2 pad "
  455. (string=? " " (string-pad "" 2)))
  456. (pass-if "empty pad string, 2 pad, pad char"
  457. (string=? "!!" (string-pad "" 2 #\!)))
  458. (pass-if "empty pad string, 2 pad, pad char, start index"
  459. (string=? "!c" (string-pad "abc" 2 #\! 2)))
  460. (pass-if "empty pad string, 2 pad, pad char, start and end index"
  461. (string=? "!c" (string-pad "abcd" 2 #\! 2 3)))
  462. (pass-if "freestyle 1"
  463. (string=? "32" (string-pad (number->string 532) 2 #\!)))
  464. (pass-if "freestyle 2"
  465. (string=? "!532" (string-pad (number->string 532) 4 #\!))))
  466. (with-test-prefix "string-pad-right"
  467. (pass-if "empty string, zero pad"
  468. (string=? "" (string-pad-right "" 0)))
  469. (pass-if "empty string, zero pad, pad char"
  470. (string=? "" (string-pad-right "" 0)))
  471. (pass-if "empty pad string, 2 pad "
  472. (string=? " " (string-pad-right "" 2)))
  473. (pass-if "empty pad string, 2 pad, pad char"
  474. (string=? "!!" (string-pad-right "" 2 #\!)))
  475. (pass-if "empty pad string, 2 pad, pad char, start index"
  476. (string=? "c!" (string-pad-right "abc" 2 #\! 2)))
  477. (pass-if "empty pad string, 2 pad, pad char, start and end index"
  478. (string=? "c!" (string-pad-right "abcd" 2 #\! 2 3)))
  479. (pass-if "freestyle 1"
  480. (string=? "53" (string-pad-right (number->string 532) 2 #\!)))
  481. (pass-if "freestyle 2"
  482. (string=? "532!" (string-pad-right (number->string 532) 4 #\!))))
  483. (with-test-prefix "string-trim"
  484. (with-test-prefix "bad char_pred"
  485. (pass-if-exception "integer" exception:wrong-type-arg
  486. (string-trim "abcde" 123))
  487. (pass-if-exception "string" exception:wrong-type-arg
  488. (string-trim "abcde" "zzz")))
  489. (pass-if "empty string"
  490. (string=? "" (string-trim "")))
  491. (pass-if "no char/pred"
  492. (string=? "foo " (string-trim " \tfoo ")))
  493. (pass-if "start index, pred"
  494. (string=? "foo " (string-trim " \tfoo " char-whitespace? 1)))
  495. (pass-if "start and end index, pred"
  496. (string=? "f" (string-trim " \tfoo " char-whitespace? 1 3)))
  497. (pass-if "start index, char"
  498. (string=? "\tfoo " (string-trim " \tfoo " #\space 1)))
  499. (pass-if "start and end index, char"
  500. (string=? "\tf" (string-trim " \tfoo " #\space 1 3)))
  501. (pass-if "start index, charset"
  502. (string=? "foo " (string-trim " \tfoo " char-set:whitespace 1)))
  503. (pass-if "start and end index, charset"
  504. (string=? "f" (string-trim " \tfoo " char-set:whitespace 1 3))))
  505. (with-test-prefix "string-trim-right"
  506. (with-test-prefix "bad char_pred"
  507. (pass-if-exception "integer" exception:wrong-type-arg
  508. (string-trim-right "abcde" 123))
  509. (pass-if-exception "string" exception:wrong-type-arg
  510. (string-trim-right "abcde" "zzz")))
  511. (pass-if "empty string"
  512. (string=? "" (string-trim-right "")))
  513. (pass-if "no char/pred"
  514. (string=? " \tfoo" (string-trim-right " \tfoo ")))
  515. (pass-if "start index, pred"
  516. (string=? "\tfoo" (string-trim-right " \tfoo " char-whitespace? 1)))
  517. (pass-if "start and end index, pred"
  518. (string=? "\tf" (string-trim-right " \tfoo " char-whitespace? 1 3)))
  519. (pass-if "start index, char"
  520. (string=? "\tfoo" (string-trim-right " \tfoo " #\space 1)))
  521. (pass-if "start and end index, char"
  522. (string=? "\tf" (string-trim-right " \tfoo " #\space 1 3)))
  523. (pass-if "start index, charset"
  524. (string=? "\tfoo" (string-trim-right " \tfoo " char-set:whitespace 1)))
  525. (pass-if "start and end index, charset"
  526. (string=? "\tf" (string-trim-right " \tfoo " char-set:whitespace 1 3))))
  527. (with-test-prefix "string-trim-both"
  528. (with-test-prefix "bad char_pred"
  529. (pass-if-exception "integer" exception:wrong-type-arg
  530. (string-trim-both "abcde" 123))
  531. (pass-if-exception "string" exception:wrong-type-arg
  532. (string-trim-both "abcde" "zzz")))
  533. (pass-if "empty string"
  534. (string=? "" (string-trim-both "")))
  535. (pass-if "no char/pred"
  536. (string=? "foo" (string-trim-both " \tfoo ")))
  537. (pass-if "start index, pred"
  538. (string=? "foo" (string-trim-both " \tfoo " char-whitespace? 1)))
  539. (pass-if "start and end index, pred"
  540. (string=? "f" (string-trim-both " \tfoo " char-whitespace? 1 3)))
  541. (pass-if "start index, char"
  542. (string=? "\tfoo" (string-trim-both " \tfoo " #\space 1)))
  543. (pass-if "start and end index, char"
  544. (string=? "\tf" (string-trim-both " \tfoo " #\space 1 3)))
  545. (pass-if "start index, charset"
  546. (string=? "foo" (string-trim-both " \tfoo " char-set:whitespace 1)))
  547. (pass-if "start and end index, charset"
  548. (string=? "f" (string-trim-both " \tfoo " char-set:whitespace 1 3))))
  549. (define s0 (make-string 200 #\!))
  550. (define s1 (make-string 0 #\!))
  551. (with-test-prefix "string-fill!"
  552. (pass-if "empty string, no indices"
  553. (string-fill! s1 #\*)
  554. (= (string-length s1) 0))
  555. (pass-if "empty string, start index"
  556. (string-fill! s1 #\* 0)
  557. (= (string-length s1) 0))
  558. (pass-if "empty string, start and end index"
  559. (string-fill! s1 #\* 0 0)
  560. (= (string-length s1) 0))
  561. (pass-if "no indices"
  562. (string-fill! s0 #\*)
  563. (char=? (string-ref s0 0) #\*))
  564. (pass-if "start index"
  565. (string-fill! s0 #\+ 10)
  566. (char=? (string-ref s0 11) #\+))
  567. (pass-if "start and end index"
  568. (string-fill! s0 #\| 12 20)
  569. (char=? (string-ref s0 13) #\|)))
  570. (with-test-prefix "string-prefix-length"
  571. (pass-if "empty prefix"
  572. (= 0 (string-prefix-length "" "foo bar")))
  573. (pass-if "non-empty prefix - match"
  574. (= 3 (string-prefix-length "foo" "foo bar")))
  575. (pass-if "non-empty prefix - no match"
  576. (= 0 (string-prefix-length "bar" "foo bar"))))
  577. (with-test-prefix "string-prefix-length-ci"
  578. (pass-if "empty prefix"
  579. (= 0 (string-prefix-length-ci "" "foo bar")))
  580. (pass-if "non-empty prefix - match"
  581. (= 3 (string-prefix-length-ci "fOo" "foo bar")))
  582. (pass-if "non-empty prefix - no match"
  583. (= 0 (string-prefix-length-ci "bAr" "foo bar"))))
  584. (with-test-prefix "string-suffix-length"
  585. (pass-if "empty suffix"
  586. (= 0 (string-suffix-length "" "foo bar")))
  587. (pass-if "non-empty suffix - match"
  588. (= 3 (string-suffix-length "bar" "foo bar")))
  589. (pass-if "non-empty suffix - no match"
  590. (= 0 (string-suffix-length "foo" "foo bar"))))
  591. (with-test-prefix "string-suffix-length-ci"
  592. (pass-if "empty suffix"
  593. (= 0 (string-suffix-length-ci "" "foo bar")))
  594. (pass-if "non-empty suffix - match"
  595. (= 3 (string-suffix-length-ci "bAr" "foo bar")))
  596. (pass-if "non-empty suffix - no match"
  597. (= 0 (string-suffix-length-ci "fOo" "foo bar"))))
  598. (with-test-prefix "string-prefix?"
  599. (pass-if "empty prefix"
  600. (string-prefix? "" "foo bar"))
  601. (pass-if "non-empty prefix - match"
  602. (string-prefix? "foo" "foo bar"))
  603. (pass-if "non-empty prefix - no match"
  604. (not (string-prefix? "bar" "foo bar"))))
  605. (with-test-prefix "string-prefix-ci?"
  606. (pass-if "empty prefix"
  607. (string-prefix-ci? "" "foo bar"))
  608. (pass-if "non-empty prefix - match"
  609. (string-prefix-ci? "fOo" "foo bar"))
  610. (pass-if "non-empty prefix - no match"
  611. (not (string-prefix-ci? "bAr" "foo bar"))))
  612. (with-test-prefix "string-suffix?"
  613. (pass-if "empty suffix"
  614. (string-suffix? "" "foo bar"))
  615. (pass-if "non-empty suffix - match"
  616. (string-suffix? "bar" "foo bar"))
  617. (pass-if "non-empty suffix - no match"
  618. (not (string-suffix? "foo" "foo bar"))))
  619. (with-test-prefix "string-suffix-ci?"
  620. (pass-if "empty suffix"
  621. (string-suffix-ci? "" "foo bar"))
  622. (pass-if "non-empty suffix - match"
  623. (string-suffix-ci? "bAr" "foo bar"))
  624. (pass-if "non-empty suffix - no match"
  625. (not (string-suffix-ci? "fOo" "foo bar"))))
  626. (with-test-prefix "string-index"
  627. (with-test-prefix "bad char_pred"
  628. (pass-if-exception "integer" exception:wrong-type-arg
  629. (string-index "abcde" 123))
  630. (pass-if-exception "string" exception:wrong-type-arg
  631. (string-index "abcde" "zzz")))
  632. (pass-if "empty string - char"
  633. (not (string-index "" #\a)))
  634. (pass-if "non-empty - char - match"
  635. (= 5 (string-index "foo bar" #\a)))
  636. (pass-if "non-empty - char - no match"
  637. (not (string-index "frobnicate" #\x)))
  638. (pass-if "empty string - char - start index"
  639. (not (string-index "" #\a 0)))
  640. (pass-if "non-empty - char - match - start index"
  641. (= 5 (string-index "foo bar" #\a 1)))
  642. (pass-if "non-empty - char - no match - start index"
  643. (not (string-index "frobnicate" #\x 2)))
  644. (pass-if "empty string - char - start and end index"
  645. (not (string-index "" #\a 0 0)))
  646. (pass-if "non-empty - char - match - start and end index"
  647. (= 5 (string-index "foo bar" #\a 1 6)))
  648. (pass-if "non-empty - char - no match - start and end index"
  649. (not (string-index "frobnicate" #\a 2 5)))
  650. (pass-if "empty string - charset"
  651. (not (string-index "" char-set:letter)))
  652. (pass-if "non-empty - charset - match"
  653. (= 0 (string-index "foo bar" char-set:letter)))
  654. (pass-if "non-empty - charset - no match"
  655. (not (string-index "frobnicate" char-set:digit)))
  656. (pass-if "empty string - charset - start index"
  657. (not (string-index "" char-set:letter 0)))
  658. (pass-if "non-empty - charset - match - start index"
  659. (= 1 (string-index "foo bar" char-set:letter 1)))
  660. (pass-if "non-empty - charset - no match - start index"
  661. (not (string-index "frobnicate" char-set:digit 2)))
  662. (pass-if "empty string - charset - start and end index"
  663. (not (string-index "" char-set:letter 0 0)))
  664. (pass-if "non-empty - charset - match - start and end index"
  665. (= 1 (string-index "foo bar" char-set:letter 1 6)))
  666. (pass-if "non-empty - charset - no match - start and end index"
  667. (not (string-index "frobnicate" char-set:digit 2 5)))
  668. (pass-if "empty string - pred"
  669. (not (string-index "" char-alphabetic?)))
  670. (pass-if "non-empty - pred - match"
  671. (= 0 (string-index "foo bar" char-alphabetic?)))
  672. (pass-if "non-empty - pred - no match"
  673. (not (string-index "frobnicate" char-numeric?)))
  674. (pass-if "empty string - pred - start index"
  675. (not (string-index "" char-alphabetic? 0)))
  676. (pass-if "non-empty - pred - match - start index"
  677. (= 1 (string-index "foo bar" char-alphabetic? 1)))
  678. (pass-if "non-empty - pred - no match - start index"
  679. (not (string-index "frobnicate" char-numeric? 2)))
  680. (pass-if "empty string - pred - start and end index"
  681. (not (string-index "" char-alphabetic? 0 0)))
  682. (pass-if "non-empty - pred - match - start and end index"
  683. (= 1 (string-index "foo bar" char-alphabetic? 1 6)))
  684. (pass-if "non-empty - pred - no match - start and end index"
  685. (not (string-index "frobnicate" char-numeric? 2 5)))
  686. ;; in guile 1.6.7 and earlier this resulted in a segv, because
  687. ;; SCM_MAKE_CHAR didn't cope with "signed char" arguments containing an
  688. ;; 8-bit value
  689. (pass-if "8-bit char in string"
  690. (begin
  691. (string-index (string (integer->char 200)) char-numeric?)
  692. #t)))
  693. (with-test-prefix "string-index-right"
  694. (with-test-prefix "bad char_pred"
  695. (pass-if-exception "integer" exception:wrong-type-arg
  696. (string-index-right "abcde" 123))
  697. (pass-if-exception "string" exception:wrong-type-arg
  698. (string-index-right "abcde" "zzz")))
  699. (pass-if "empty string - char"
  700. (not (string-index-right "" #\a)))
  701. (pass-if "non-empty - char - match"
  702. (= 5 (string-index-right "foo bar" #\a)))
  703. (pass-if "non-empty - char - no match"
  704. (not (string-index-right "frobnicate" #\x)))
  705. (pass-if "empty string - char - start index-right"
  706. (not (string-index-right "" #\a 0)))
  707. (pass-if "non-empty - char - match - start index"
  708. (= 5 (string-index-right "foo bar" #\a 1)))
  709. (pass-if "non-empty - char - no match - start index"
  710. (not (string-index-right "frobnicate" #\x 2)))
  711. (pass-if "empty string - char - start and end index"
  712. (not (string-index-right "" #\a 0 0)))
  713. (pass-if "non-empty - char - match - start and end index"
  714. (= 5 (string-index-right "foo bar" #\a 1 6)))
  715. (pass-if "non-empty - char - no match - start and end index"
  716. (not (string-index-right "frobnicate" #\a 2 5)))
  717. (pass-if "empty string - charset"
  718. (not (string-index-right "" char-set:letter)))
  719. (pass-if "non-empty - charset - match"
  720. (= 6 (string-index-right "foo bar" char-set:letter)))
  721. (pass-if "non-empty - charset - no match"
  722. (not (string-index-right "frobnicate" char-set:digit)))
  723. (pass-if "empty string - charset - start index"
  724. (not (string-index-right "" char-set:letter 0)))
  725. (pass-if "non-empty - charset - match - start index"
  726. (= 6 (string-index-right "foo bar" char-set:letter 1)))
  727. (pass-if "non-empty - charset - no match - start index"
  728. (not (string-index-right "frobnicate" char-set:digit 2)))
  729. (pass-if "empty string - charset - start and end index"
  730. (not (string-index-right "" char-set:letter 0 0)))
  731. (pass-if "non-empty - charset - match - start and end index"
  732. (= 5 (string-index-right "foo bar" char-set:letter 1 6)))
  733. (pass-if "non-empty - charset - no match - start and end index"
  734. (not (string-index-right "frobnicate" char-set:digit 2 5)))
  735. (pass-if "empty string - pred"
  736. (not (string-index-right "" char-alphabetic?)))
  737. (pass-if "non-empty - pred - match"
  738. (= 6 (string-index-right "foo bar" char-alphabetic?)))
  739. (pass-if "non-empty - pred - no match"
  740. (not (string-index-right "frobnicate" char-numeric?)))
  741. (pass-if "empty string - pred - start index"
  742. (not (string-index-right "" char-alphabetic? 0)))
  743. (pass-if "non-empty - pred - match - start index"
  744. (= 6 (string-index-right "foo bar" char-alphabetic? 1)))
  745. (pass-if "non-empty - pred - no match - start index"
  746. (not (string-index-right "frobnicate" char-numeric? 2)))
  747. (pass-if "empty string - pred - start and end index"
  748. (not (string-index-right "" char-alphabetic? 0 0)))
  749. (pass-if "non-empty - pred - match - start and end index"
  750. (= 5 (string-index-right "foo bar" char-alphabetic? 1 6)))
  751. (pass-if "non-empty - pred - no match - start and end index"
  752. (not (string-index-right "frobnicate" char-numeric? 2 5))))
  753. (with-test-prefix "string-skip"
  754. (with-test-prefix "bad char_pred"
  755. (pass-if-exception "integer" exception:wrong-type-arg
  756. (string-skip "abcde" 123))
  757. (pass-if-exception "string" exception:wrong-type-arg
  758. (string-skip "abcde" "zzz")))
  759. (pass-if "empty string - char"
  760. (not (string-skip "" #\a)))
  761. (pass-if "non-empty - char - match"
  762. (= 0 (string-skip "foo bar" #\a)))
  763. (pass-if "non-empty - char - no match"
  764. (= 0 (string-skip "frobnicate" #\x)))
  765. (pass-if "empty string - char - start index"
  766. (not (string-skip "" #\a 0)))
  767. (pass-if "non-empty - char - match - start index"
  768. (= 1 (string-skip "foo bar" #\a 1)))
  769. (pass-if "non-empty - char - no match - start index"
  770. (= 2 (string-skip "frobnicate" #\x 2)))
  771. (pass-if "empty string - char - start and end index"
  772. (not (string-skip "" #\a 0 0)))
  773. (pass-if "non-empty - char - match - start and end index"
  774. (= 1 (string-skip "foo bar" #\a 1 6)))
  775. (pass-if "non-empty - char - no match - start and end index"
  776. (= 2 (string-skip "frobnicate" #\a 2 5)))
  777. (pass-if "empty string - charset"
  778. (not (string-skip "" char-set:letter)))
  779. (pass-if "non-empty - charset - match"
  780. (= 3 (string-skip "foo bar" char-set:letter)))
  781. (pass-if "non-empty - charset - no match"
  782. (= 0 (string-skip "frobnicate" char-set:digit)))
  783. (pass-if "empty string - charset - start index"
  784. (not (string-skip "" char-set:letter 0)))
  785. (pass-if "non-empty - charset - match - start index"
  786. (= 3 (string-skip "foo bar" char-set:letter 1)))
  787. (pass-if "non-empty - charset - no match - start index"
  788. (= 2 (string-skip "frobnicate" char-set:digit 2)))
  789. (pass-if "empty string - charset - start and end index"
  790. (not (string-skip "" char-set:letter 0 0)))
  791. (pass-if "non-empty - charset - match - start and end index"
  792. (= 3 (string-skip "foo bar" char-set:letter 1 6)))
  793. (pass-if "non-empty - charset - no match - start and end index"
  794. (= 2 (string-skip "frobnicate" char-set:digit 2 5)))
  795. (pass-if "empty string - pred"
  796. (not (string-skip "" char-alphabetic?)))
  797. (pass-if "non-empty - pred - match"
  798. (= 3 (string-skip "foo bar" char-alphabetic?)))
  799. (pass-if "non-empty - pred - no match"
  800. (= 0 (string-skip "frobnicate" char-numeric?)))
  801. (pass-if "empty string - pred - start index"
  802. (not (string-skip "" char-alphabetic? 0)))
  803. (pass-if "non-empty - pred - match - start index"
  804. (= 3 (string-skip "foo bar" char-alphabetic? 1)))
  805. (pass-if "non-empty - pred - no match - start index"
  806. (= 2 (string-skip "frobnicate" char-numeric? 2)))
  807. (pass-if "empty string - pred - start and end index"
  808. (not (string-skip "" char-alphabetic? 0 0)))
  809. (pass-if "non-empty - pred - match - start and end index"
  810. (= 3 (string-skip "foo bar" char-alphabetic? 1 6)))
  811. (pass-if "non-empty - pred - no match - start and end index"
  812. (= 2 (string-skip "frobnicate" char-numeric? 2 5))))
  813. (with-test-prefix "string-skip-right"
  814. (with-test-prefix "bad char_pred"
  815. (pass-if-exception "integer" exception:wrong-type-arg
  816. (string-skip-right "abcde" 123))
  817. (pass-if-exception "string" exception:wrong-type-arg
  818. (string-skip-right "abcde" "zzz")))
  819. (pass-if "empty string - char"
  820. (not (string-skip-right "" #\a)))
  821. (pass-if "non-empty - char - match"
  822. (= 6 (string-skip-right "foo bar" #\a)))
  823. (pass-if "non-empty - char - no match"
  824. (= 9 (string-skip-right "frobnicate" #\x)))
  825. (pass-if "empty string - char - start index-right"
  826. (not (string-skip-right "" #\a 0)))
  827. (pass-if "non-empty - char - match - start index"
  828. (= 6 (string-skip-right "foo bar" #\a 1)))
  829. (pass-if "non-empty - char - no match - start index"
  830. (= 9 (string-skip-right "frobnicate" #\x 2)))
  831. (pass-if "empty string - char - start and end index"
  832. (not (string-skip-right "" #\a 0 0)))
  833. (pass-if "non-empty - char - match - start and end index"
  834. (= 4 (string-skip-right "foo bar" #\a 1 6)))
  835. (pass-if "non-empty - char - no match - start and end index"
  836. (= 4 (string-skip-right "frobnicate" #\a 2 5)))
  837. (pass-if "empty string - charset"
  838. (not (string-skip-right "" char-set:letter)))
  839. (pass-if "non-empty - charset - match"
  840. (= 3 (string-skip-right "foo bar" char-set:letter)))
  841. (pass-if "non-empty - charset - no match"
  842. (= 9 (string-skip-right "frobnicate" char-set:digit)))
  843. (pass-if "empty string - charset - start index"
  844. (not (string-skip-right "" char-set:letter 0)))
  845. (pass-if "non-empty - charset - match - start index"
  846. (= 3 (string-skip-right "foo bar" char-set:letter 1)))
  847. (pass-if "non-empty - charset - no match - start index"
  848. (= 9 (string-skip-right "frobnicate" char-set:digit 2)))
  849. (pass-if "empty string - charset - start and end index"
  850. (not (string-skip-right "" char-set:letter 0 0)))
  851. (pass-if "non-empty - charset - match - start and end index"
  852. (= 3 (string-skip-right "foo bar" char-set:letter 1 6)))
  853. (pass-if "non-empty - charset - no match - start and end index"
  854. (= 4 (string-skip-right "frobnicate" char-set:digit 2 5)))
  855. (pass-if "empty string - pred"
  856. (not (string-skip-right "" char-alphabetic?)))
  857. (pass-if "non-empty - pred - match"
  858. (= 3 (string-skip-right "foo bar" char-alphabetic?)))
  859. (pass-if "non-empty - pred - no match"
  860. (= 9 (string-skip-right "frobnicate" char-numeric?)))
  861. (pass-if "empty string - pred - start index"
  862. (not (string-skip-right "" char-alphabetic? 0)))
  863. (pass-if "non-empty - pred - match - start index"
  864. (= 3 (string-skip-right "foo bar" char-alphabetic? 1)))
  865. (pass-if "non-empty - pred - no match - start index"
  866. (= 9 (string-skip-right "frobnicate" char-numeric? 2)))
  867. (pass-if "empty string - pred - start and end index"
  868. (not (string-skip-right "" char-alphabetic? 0 0)))
  869. (pass-if "non-empty - pred - match - start and end index"
  870. (= 3 (string-skip-right "foo bar" char-alphabetic? 1 6)))
  871. (pass-if "non-empty - pred - no match - start and end index"
  872. (= 4 (string-skip-right "frobnicate" char-numeric? 2 5))))
  873. ;;
  874. ;; string-count
  875. ;;
  876. (with-test-prefix "string-count"
  877. (with-test-prefix "bad char_pred"
  878. (pass-if-exception "integer" exception:wrong-type-arg
  879. (string-count "abcde" 123))
  880. (pass-if-exception "string" exception:wrong-type-arg
  881. (string-count "abcde" "zzz")))
  882. (with-test-prefix "char"
  883. (pass-if (eqv? 0 (string-count "" #\a)))
  884. (pass-if (eqv? 0 (string-count "-" #\a)))
  885. (pass-if (eqv? 1 (string-count "a" #\a)))
  886. (pass-if (eqv? 0 (string-count "--" #\a)))
  887. (pass-if (eqv? 1 (string-count "a-" #\a)))
  888. (pass-if (eqv? 1 (string-count "-a" #\a)))
  889. (pass-if (eqv? 2 (string-count "aa" #\a)))
  890. (pass-if (eqv? 0 (string-count "---" #\a)))
  891. (pass-if (eqv? 1 (string-count "-a-" #\a)))
  892. (pass-if (eqv? 1 (string-count "a--" #\a)))
  893. (pass-if (eqv? 2 (string-count "aa-" #\a)))
  894. (pass-if (eqv? 2 (string-count "a-a" #\a)))
  895. (pass-if (eqv? 3 (string-count "aaa" #\a)))
  896. (pass-if (eqv? 1 (string-count "--a" #\a)))
  897. (pass-if (eqv? 2 (string-count "-aa" #\a))))
  898. (with-test-prefix "charset"
  899. (pass-if (eqv? 0 (string-count "" char-set:letter)))
  900. (pass-if (eqv? 0 (string-count "-" char-set:letter)))
  901. (pass-if (eqv? 1 (string-count "a" char-set:letter)))
  902. (pass-if (eqv? 0 (string-count "--" char-set:letter)))
  903. (pass-if (eqv? 1 (string-count "a-" char-set:letter)))
  904. (pass-if (eqv? 1 (string-count "-a" char-set:letter)))
  905. (pass-if (eqv? 2 (string-count "aa" char-set:letter)))
  906. (pass-if (eqv? 0 (string-count "---" char-set:letter)))
  907. (pass-if (eqv? 1 (string-count "-a-" char-set:letter)))
  908. (pass-if (eqv? 1 (string-count "a--" char-set:letter)))
  909. (pass-if (eqv? 2 (string-count "aa-" char-set:letter)))
  910. (pass-if (eqv? 2 (string-count "a-a" char-set:letter)))
  911. (pass-if (eqv? 3 (string-count "aaa" char-set:letter)))
  912. (pass-if (eqv? 1 (string-count "--a" char-set:letter)))
  913. (pass-if (eqv? 2 (string-count "-aa" char-set:letter))))
  914. (with-test-prefix "proc"
  915. (pass-if (eqv? 0 (string-count "" char-alphabetic?)))
  916. (pass-if (eqv? 0 (string-count "-" char-alphabetic?)))
  917. (pass-if (eqv? 1 (string-count "a" char-alphabetic?)))
  918. (pass-if (eqv? 0 (string-count "--" char-alphabetic?)))
  919. (pass-if (eqv? 1 (string-count "a-" char-alphabetic?)))
  920. (pass-if (eqv? 1 (string-count "-a" char-alphabetic?)))
  921. (pass-if (eqv? 2 (string-count "aa" char-alphabetic?)))
  922. (pass-if (eqv? 0 (string-count "---" char-alphabetic?)))
  923. (pass-if (eqv? 1 (string-count "-a-" char-alphabetic?)))
  924. (pass-if (eqv? 1 (string-count "a--" char-alphabetic?)))
  925. (pass-if (eqv? 2 (string-count "aa-" char-alphabetic?)))
  926. (pass-if (eqv? 2 (string-count "a-a" char-alphabetic?)))
  927. (pass-if (eqv? 3 (string-count "aaa" char-alphabetic?)))
  928. (pass-if (eqv? 1 (string-count "--a" char-alphabetic?)))
  929. (pass-if (eqv? 2 (string-count "-aa" char-alphabetic?)))))
  930. (with-test-prefix "string-replace"
  931. (pass-if "empty string(s), no indices"
  932. (string=? "" (string-replace "" "")))
  933. (pass-if "empty string(s), 1 index"
  934. (string=? "" (string-replace "" "" 0)))
  935. (pass-if "empty string(s), 2 indices"
  936. (string=? "" (string-replace "" "" 0 0)))
  937. (pass-if "empty string(s), 3 indices"
  938. (string=? "" (string-replace "" "" 0 0 0)))
  939. (pass-if "empty string(s), 4 indices"
  940. (string=? "" (string-replace "" "" 0 0 0 0)))
  941. (pass-if "no indices"
  942. (string=? "uu" (string-replace "foo bar" "uu")))
  943. (pass-if "one index"
  944. (string=? "fuu" (string-replace "foo bar" "uu" 1)))
  945. (pass-if "two indices"
  946. (string=? "fuuar" (string-replace "foo bar" "uu" 1 5)))
  947. (pass-if "three indices"
  948. (string=? "fuar" (string-replace "foo bar" "uu" 1 5 1)))
  949. (pass-if "four indices"
  950. (string=? "fuar" (string-replace "foo bar" "uu" 1 5 1 2))))
  951. (with-test-prefix "string-tokenize"
  952. (pass-if "empty string, no char/pred"
  953. (zero? (length (string-tokenize ""))))
  954. (pass-if "empty string, charset"
  955. (zero? (length (string-tokenize "" char-set:punctuation))))
  956. (pass-if "no char/pred"
  957. (equal? '("foo" "bar" "!a") (string-tokenize "foo\tbar !a")))
  958. (pass-if "charset"
  959. (equal? '("foo" "bar" "!a") (string-tokenize "foo\tbar !a"
  960. char-set:graphic)))
  961. (pass-if "charset, start index"
  962. (equal? '("oo" "bar" "!a") (string-tokenize "foo\tbar !a"
  963. char-set:graphic 1)))
  964. (pass-if "charset, start and end index"
  965. (equal? '("oo" "bar" "!") (string-tokenize "foo\tbar !a"
  966. char-set:graphic 1 9))))
  967. ;;;
  968. ;;; string-filter
  969. ;;;
  970. (with-test-prefix "string-filter"
  971. (with-test-prefix "bad char_pred"
  972. (pass-if-exception "integer" exception:wrong-type-arg
  973. (string-filter 123 "abcde"))
  974. ;; Have to comment out this test for now, given that it triggers the
  975. ;; deprecation warning, even as the test passes.
  976. #;
  977. (pass-if-exception "string" exception:wrong-type-arg
  978. (string-filter "zzz" "abcde")))
  979. (pass-if "empty string, char"
  980. (string=? "" (string-filter #\. "")))
  981. (pass-if "empty string, charset"
  982. (string=? "" (string-filter char-set:punctuation "")))
  983. (pass-if "empty string, pred"
  984. (string=? "" (string-filter char-alphabetic? "")))
  985. (pass-if "char"
  986. (string=? "..." (string-filter #\. ".foo.bar.")))
  987. (pass-if "charset"
  988. (string=? "..." (string-filter char-set:punctuation ".foo.bar.")))
  989. (pass-if "pred"
  990. (string=? "foobar" (string-filter char-alphabetic? ".foo.bar.")))
  991. (pass-if "char, start index"
  992. (string=? ".." (string-filter #\. ".foo.bar." 2)))
  993. (pass-if "charset, start index"
  994. (string=? ".." (string-filter char-set:punctuation ".foo.bar." 2)))
  995. (pass-if "pred, start index"
  996. (string=? "oobar" (string-filter char-alphabetic? ".foo.bar." 2)))
  997. (pass-if "char, start and end index"
  998. (string=? "" (string-filter #\. ".foo.bar." 2 4)))
  999. (pass-if "charset, start and end index"
  1000. (string=? "" (string-filter char-set:punctuation ".foo.bar." 2 4)))
  1001. (pass-if "pred, start and end index"
  1002. (string=? "oo" (string-filter char-alphabetic? ".foo.bar." 2 4)))
  1003. (with-test-prefix "char"
  1004. (pass-if (equal? "x" (string-filter #\x "x")))
  1005. (pass-if (equal? "xx" (string-filter #\x "xx")))
  1006. (pass-if (equal? "xx" (string-filter #\x "xyx")))
  1007. (pass-if (equal? "x" (string-filter #\x "xyyy")))
  1008. (pass-if (equal? "x" (string-filter #\x "yyyx")))
  1009. (pass-if (equal? "xx" (string-filter #\x "xxx" 1)))
  1010. (pass-if (equal? "xx" (string-filter #\x "xxx" 0 2)))
  1011. (pass-if (equal? "x" (string-filter #\x "xyx" 1)))
  1012. (pass-if (equal? "x" (string-filter #\x "yxx" 0 2)))
  1013. ;; leading and trailing removals
  1014. (pass-if (string=? "" (string-filter #\x ".")))
  1015. (pass-if (string=? "" (string-filter #\x "..")))
  1016. (pass-if (string=? "" (string-filter #\x "...")))
  1017. (pass-if (string=? "x" (string-filter #\x ".x")))
  1018. (pass-if (string=? "x" (string-filter #\x "..x")))
  1019. (pass-if (string=? "x" (string-filter #\x "...x")))
  1020. (pass-if (string=? "x" (string-filter #\x "x.")))
  1021. (pass-if (string=? "x" (string-filter #\x "x..")))
  1022. (pass-if (string=? "x" (string-filter #\x "x...")))
  1023. (pass-if (string=? "x" (string-filter #\x "...x..."))))
  1024. (with-test-prefix "charset"
  1025. (let ((charset (char-set #\x #\y)))
  1026. (pass-if (equal? "x" (string-filter charset "x")))
  1027. (pass-if (equal? "xx" (string-filter charset "xx")))
  1028. (pass-if (equal? "xy" (string-filter charset "xy")))
  1029. (pass-if (equal? "x" (string-filter charset "xaaa")))
  1030. (pass-if (equal? "y" (string-filter charset "aaay")))
  1031. (pass-if (equal? "yx" (string-filter charset "xyx" 1)))
  1032. (pass-if (equal? "xy" (string-filter charset "xyx" 0 2)))
  1033. (pass-if (equal? "x" (string-filter charset "xax" 1)))
  1034. (pass-if (equal? "x" (string-filter charset "axx" 0 2))))
  1035. ;; leading and trailing removals
  1036. (pass-if (string=? "" (string-filter char-set:letter ".")))
  1037. (pass-if (string=? "" (string-filter char-set:letter "..")))
  1038. (pass-if (string=? "" (string-filter char-set:letter "...")))
  1039. (pass-if (string=? "x" (string-filter char-set:letter ".x")))
  1040. (pass-if (string=? "x" (string-filter char-set:letter "..x")))
  1041. (pass-if (string=? "x" (string-filter char-set:letter "...x")))
  1042. (pass-if (string=? "x" (string-filter char-set:letter "x.")))
  1043. (pass-if (string=? "x" (string-filter char-set:letter "x..")))
  1044. (pass-if (string=? "x" (string-filter char-set:letter "x...")))
  1045. (pass-if (string=? "x" (string-filter char-set:letter "...x...")))))
  1046. ;;;
  1047. ;;; string-delete
  1048. ;;;
  1049. (with-test-prefix "string-delete"
  1050. (with-test-prefix "bad char_pred"
  1051. (pass-if-exception "integer" exception:wrong-type-arg
  1052. (string-delete 123 "abcde"))
  1053. ;; Like string-filter, commenting out this test.
  1054. #;
  1055. (pass-if-exception "string" exception:wrong-type-arg
  1056. (string-delete "zzz" "abcde")))
  1057. (pass-if "empty string, char"
  1058. (string=? "" (string-delete #\. "")))
  1059. (pass-if "empty string, charset"
  1060. (string=? "" (string-delete char-set:punctuation "")))
  1061. (pass-if "empty string, pred"
  1062. (string=? "" (string-delete char-alphabetic? "")))
  1063. (pass-if "char"
  1064. (string=? "foobar" (string-delete #\. ".foo.bar.")))
  1065. (pass-if "charset"
  1066. (string=? "foobar" (string-delete char-set:punctuation ".foo.bar.")))
  1067. (pass-if "pred"
  1068. (string=? "..." (string-delete char-alphabetic? ".foo.bar.")))
  1069. (pass-if "char, start index"
  1070. (string=? "oobar" (string-delete #\. ".foo.bar." 2)))
  1071. (pass-if "charset, start index"
  1072. (string=? "oobar" (string-delete char-set:punctuation ".foo.bar." 2)))
  1073. (pass-if "pred, start index"
  1074. (string=? ".." (string-delete char-alphabetic? ".foo.bar." 2)))
  1075. (pass-if "char, start and end index"
  1076. (string=? "oo" (string-delete #\. ".foo.bar." 2 4)))
  1077. (pass-if "charset, start and end index"
  1078. (string=? "oo" (string-delete char-set:punctuation ".foo.bar." 2 4)))
  1079. (pass-if "pred, start and end index"
  1080. (string=? "" (string-delete char-alphabetic? ".foo.bar." 2 4)))
  1081. ;; leading and trailing removals
  1082. (pass-if (string=? "" (string-delete #\. ".")))
  1083. (pass-if (string=? "" (string-delete #\. "..")))
  1084. (pass-if (string=? "" (string-delete #\. "...")))
  1085. (pass-if (string=? "x" (string-delete #\. ".x")))
  1086. (pass-if (string=? "x" (string-delete #\. "..x")))
  1087. (pass-if (string=? "x" (string-delete #\. "...x")))
  1088. (pass-if (string=? "x" (string-delete #\. "x.")))
  1089. (pass-if (string=? "x" (string-delete #\. "x..")))
  1090. (pass-if (string=? "x" (string-delete #\. "x...")))
  1091. (pass-if (string=? "x" (string-delete #\. "...x...")))
  1092. ;; leading and trailing removals
  1093. (pass-if (string=? "" (string-delete char-set:punctuation ".")))
  1094. (pass-if (string=? "" (string-delete char-set:punctuation "..")))
  1095. (pass-if (string=? "" (string-delete char-set:punctuation "...")))
  1096. (pass-if (string=? "x" (string-delete char-set:punctuation ".x")))
  1097. (pass-if (string=? "x" (string-delete char-set:punctuation "..x")))
  1098. (pass-if (string=? "x" (string-delete char-set:punctuation "...x")))
  1099. (pass-if (string=? "x" (string-delete char-set:punctuation "x.")))
  1100. (pass-if (string=? "x" (string-delete char-set:punctuation "x..")))
  1101. (pass-if (string=? "x" (string-delete char-set:punctuation "x...")))
  1102. (pass-if (string=? "x" (string-delete char-set:punctuation "...x..."))))
  1103. (with-test-prefix "string-map"
  1104. (with-test-prefix "bad proc"
  1105. (pass-if-exception "integer" exception:wrong-type-arg
  1106. (string-map 123 "abcde"))
  1107. (pass-if-exception "string" exception:wrong-type-arg
  1108. (string-map "zzz" "abcde")))
  1109. (pass-if "constant"
  1110. (string=? "xxx" (string-map (lambda (c) #\x) "foo")))
  1111. (pass-if "identity"
  1112. (string=? "foo" (string-map identity "foo")))
  1113. (pass-if "upcase"
  1114. (string=? "FOO" (string-map char-upcase "foo"))))
  1115. (with-test-prefix "string-map!"
  1116. (with-test-prefix "bad proc"
  1117. (pass-if-exception "integer" exception:wrong-type-arg
  1118. (string-map 123 "abcde"))
  1119. (pass-if-exception "string" exception:wrong-type-arg
  1120. (string-map "zzz" "abcde")))
  1121. (pass-if "constant"
  1122. (let ((str (string-copy "foo")))
  1123. (string-map! (lambda (c) #\x) str)
  1124. (string=? str "xxx")))
  1125. (pass-if "identity"
  1126. (let ((str (string-copy "foo")))
  1127. (string-map! identity str)
  1128. (string=? str "foo")))
  1129. (pass-if "upcase"
  1130. (let ((str (string-copy "foo")))
  1131. (string-map! char-upcase str)
  1132. (string=? str "FOO"))))
  1133. (with-test-prefix "string-for-each"
  1134. (with-test-prefix "bad proc"
  1135. (pass-if-exception "integer" exception:wrong-type-arg
  1136. (string-for-each 123 "abcde"))
  1137. (pass-if-exception "string" exception:wrong-type-arg
  1138. (string-for-each "zzz" "abcde")))
  1139. (pass-if "copy"
  1140. (let* ((foo "foo")
  1141. (bar (make-string (string-length foo)))
  1142. (i 0))
  1143. (string-for-each
  1144. (lambda (c) (string-set! bar i c) (set! i (1+ i))) foo)
  1145. (string=? foo bar))))
  1146. (with-test-prefix "string-for-each-index"
  1147. (with-test-prefix "bad proc"
  1148. (pass-if-exception "integer" exception:wrong-type-arg
  1149. (string-for-each-index 123 "abcde"))
  1150. (pass-if-exception "string" exception:wrong-type-arg
  1151. (string-for-each-index "zzz" "abcde")))
  1152. (pass-if "index"
  1153. (let* ((foo "foo")
  1154. (bar (make-string (string-length foo))))
  1155. (string-for-each-index
  1156. (lambda (i) (string-set! bar i (string-ref foo i))) foo)
  1157. (string=? foo bar))))