srfi-13.test 48 KB

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