672910f27b
I started from tabs that are not on the beginning of lines, and in several places I did further cleanings. If you're worried about knowing who wrote some code, for example, if you get to this commit in "git blame", then note that you can use the "-w" flag in many git commands to ignore whitespaces. For example, to see per-line authors, use "git blame -w <file>". Another example: to see the (*much* smaller) non-whitespace changes in this (or any other) commit, use "git log -p -w -1 <sha1>".
306 lines
14 KiB
Racket
306 lines
14 KiB
Racket
;;;
|
|
;;; <string-test.rkt> ---- SRFI-13 (string) tests
|
|
;;; Time-stamp: <06/06/09 16:05:08 nhw>
|
|
;;;
|
|
;;; Copyright (C) 2002 by Francisco Solsona.
|
|
;;;
|
|
;;; This file is part of PLT SRFI.
|
|
|
|
;;; PLT SRFI is free software; you can redistribute it and/or
|
|
;;; modify it under the terms of the GNU Lesser General Public
|
|
;;; License as published by the Free Software Foundation; either
|
|
;;; version 2.1 of the License, or (at your option) any later version.
|
|
|
|
;;; PLT SRFI is distributed in the hope that it will be useful,
|
|
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
;;; Lesser General Public License for more details.
|
|
|
|
;;; You should have received a copy of the GNU Lesser General Public
|
|
;;; License along with PLT SRFI; if not, write to the Free Software
|
|
;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|
|
|
;;; Author: Francisco Solsona <solsona@acm.org>
|
|
;;
|
|
;;
|
|
;; Commentary:
|
|
|
|
(module string-test mzscheme
|
|
;; Noel's Test Framework: (get your copy @ schematics.sourceforge.net)
|
|
(require rackunit)
|
|
(require srfi/13/string
|
|
srfi/14/char-set
|
|
)
|
|
(provide string-tests)
|
|
|
|
(define-syntax-rule (expect a e) (check-equal? a e))
|
|
|
|
(define string-tests
|
|
(let ((abc null)
|
|
(cba null)
|
|
(test-string "This is a simple test string to generate a very simple char set!")
|
|
)
|
|
|
|
(test-suite
|
|
"String tests"
|
|
(test-case "string? test 1"
|
|
(check-true (string? test-string)))
|
|
|
|
(test-case "string? test 2"
|
|
(check-true (not (string? 'hello))))
|
|
|
|
(test-case "string-null? test 1"
|
|
(check-true (string-null? "")))
|
|
|
|
(test-case "string-null? test 2"
|
|
(check-true (not (string-null? "not empty"))))
|
|
|
|
(test-case "string-every test 1 (all #\a)"
|
|
(check-true (string-every #\a "aaaaaaaa")))
|
|
|
|
(test-case "string-every test 2 (charset a b c)"
|
|
(check-true (string-every
|
|
(char-set #\a #\b #\c)
|
|
"baacaaaabbaa")))
|
|
|
|
(test-case "string-every test 3 (pred vowel?)"
|
|
(check-true (string-every vowel? "aeiou")))
|
|
|
|
|
|
;; string-every char/char-set/pred s [start end] -> value
|
|
;; string-any char/char-set/pred s [start end] -> value
|
|
|
|
;; Following tests adapted from SSAX/SXML vsrfi-13.scm
|
|
|
|
(test-case "Verifying string-xcopy!"
|
|
(let ((sample (string-append "0123456789+")) ; A mutable string
|
|
(txcopy
|
|
(lambda (target to src from end)
|
|
(string-xcopy! target to src from end)
|
|
target)))
|
|
(expect (txcopy "" 0 "" 0 0) "")
|
|
(expect (txcopy "" 0 sample 0 0) "")
|
|
(expect (txcopy sample 5 "" 0 0) sample)
|
|
(expect (txcopy sample 0 sample 0 0) sample)
|
|
(expect (txcopy sample 0 sample 0 1) sample)
|
|
(expect (txcopy sample 0 sample 0 (string-length sample)) sample)
|
|
(expect (txcopy sample 1 sample 1 (string-length sample)) sample)
|
|
(expect (txcopy sample 10 sample 10 (string-length sample)) sample)
|
|
(expect (txcopy (string-append sample) 1 sample 4 7) "0456456789+")
|
|
))
|
|
|
|
(test-case "Verifying string-concatenate-reverse"
|
|
(let ((sample "0123456789+"))
|
|
(expect (string-concatenate-reverse '() "" 0) "")
|
|
(expect (string-concatenate-reverse '() sample 0) "")
|
|
(expect (string-concatenate-reverse '() sample (string-length sample))
|
|
sample)
|
|
(check-not-eq? sample ; the result must be a fresh string
|
|
(string-concatenate-reverse '() sample (string-length sample)))
|
|
(expect (string-concatenate-reverse (list sample) "" 0) sample)
|
|
(check-not-eq? sample
|
|
(string-concatenate-reverse (list sample) "" 0))
|
|
(expect (string-concatenate-reverse (list sample) sample 5)
|
|
(string-append sample (substring sample 0 5)))
|
|
(expect (string-concatenate-reverse (list sample "xyz") sample 5)
|
|
(string-append "xyz" sample (substring sample 0 5)))
|
|
(expect (string-concatenate-reverse (list sample "xyz") "abcd" 4)
|
|
(string-append "xyz" sample "abcd"))
|
|
))
|
|
|
|
(test-case "Verifying string-concatenate-reverse/shared"
|
|
(let ((sample "0123456789+"))
|
|
(expect (string-concatenate-reverse/shared '()) "")
|
|
(expect (string-concatenate-reverse/shared (list sample)) sample)
|
|
(check-eq? sample ; Return the original string
|
|
(string-concatenate-reverse/shared (list sample)))
|
|
(expect (string-concatenate-reverse/shared (list sample "")) sample)
|
|
(expect (string-concatenate-reverse/shared (list "" sample)) sample)
|
|
(expect (string-concatenate-reverse/shared (list "abcd" sample "xyz"))
|
|
(string-append "xyz" sample "abcd"))
|
|
))
|
|
|
|
(test-case "Verifying string-concatenate/shared"
|
|
(let ((sample "0123456789+"))
|
|
(expect (string-concatenate/shared '()) "")
|
|
(expect (string-concatenate/shared (list sample)) sample)
|
|
(check-eq? sample
|
|
(string-concatenate/shared (list sample)))
|
|
(expect (string-concatenate/shared (list sample "")) sample)
|
|
(expect (string-concatenate/shared (list "" sample)) sample)
|
|
(expect (string-concatenate/shared (list "abcd" sample "xyz"))
|
|
(string-append "abcd" sample "xyz"))
|
|
))
|
|
|
|
(test-case "Verifying string-index, string-index-right and substring?"
|
|
(let ()
|
|
(define (substring? pattern str) (string-contains str pattern))
|
|
(expect (string-index "" #\a) #f)
|
|
(expect (string-index "cbda" #\a) 3)
|
|
(expect (string-index "cbdal" #\a) 3)
|
|
(expect (string-index "acbdal" #\a) 0)
|
|
(expect (string-index "acbdal" #\space) #f)
|
|
(expect (string-index "acbd al" #\space) 4)
|
|
|
|
(expect (string-index-right "" #\a) #f)
|
|
(expect (string-index-right "adbc" #\a) 0)
|
|
(expect (string-index-right "ladbc" #\a) 1)
|
|
(expect (string-index-right "ladbca" #\a) 5)
|
|
(expect (string-index-right "ladbca" #\space) #f)
|
|
(expect (string-index-right "la dbca" #\space) 2)
|
|
|
|
(expect (substring? "rat" "pirate") 2)
|
|
(expect (substring? "e" "pirate") 5)
|
|
(expect (substring? "k" "pirate") #f)
|
|
(expect (substring? "pi" "pirate") 0)
|
|
(expect (substring? "te" "pirate") 4)
|
|
(expect (substring? "rat" "outrage") #f)
|
|
(expect (substring? "pit" "pirate") #f)
|
|
(expect (substring? "rate" "pirate") 2)
|
|
(expect (substring? "aa" "aaaaaaa") 0)
|
|
(expect (substring? "pirate" "pirate") 0)
|
|
(expect (substring? "pirates" "pirate") #f)
|
|
(expect (substring? "pirate" "pirates") 0)
|
|
(expect (substring? "ages" "outrage") #f)
|
|
(expect (substring? "" "outrage") 0)
|
|
))
|
|
|
|
(test-case "Verifying string-prefix? and string-suffix?"
|
|
(let ()
|
|
(expect (string-prefix? "pir" "pirate") #t)
|
|
(expect (string-prefix? "rat" "outrage") #f)
|
|
(expect (string-prefix? "pir" (s "pirate " 'lf) ) #t)
|
|
(expect (string-prefix? " pir" (s "pirate " 'lf)) #f)
|
|
(expect (string-prefix? " pir" (s " pirate " 'lf)) #t)
|
|
(expect (string-prefix? "pirate" "pirate") #t)
|
|
(expect (string-prefix? "" "pirate") #t)
|
|
(expect (string-prefix? "" "") #t)
|
|
(expect (string-prefix? "pirate" "") #f)
|
|
(expect (string-prefix? "pirat" "pirate") #t)
|
|
(expect (string-prefix? "pirate" "pirat") #f)
|
|
(expect (string-prefix? (s 'cr "Z!@~#$Ll*()") (s 'cr "Z!@~#$Ll*()def")) #t)
|
|
|
|
(expect (string-prefix-ci? "pir" "pirate") #t)
|
|
(expect (string-prefix-ci? "pIr" "pirate") #t)
|
|
(expect (string-prefix? "pIr" "pirate") #f)
|
|
(expect (string-prefix-ci? "rat" "outrage") #f)
|
|
(expect (string-prefix-ci? "pir" (s "piratE " 'lf)) #t)
|
|
(expect (string-prefix-ci? " pir" (s "pirate " 'lf)) #f)
|
|
(expect (string-prefix-ci? " pir" (s " PIRate " 'lf)) #t)
|
|
(expect (string-prefix-ci? "pirate" "pirate") #t)
|
|
(expect (string-prefix-ci? "" "pirate") #t)
|
|
(expect (string-prefix-ci? "" "") #t)
|
|
(expect (string-prefix-ci? "pirate" "") #f)
|
|
(expect (string-prefix-ci? "PiRaT" "pIrAte") #t)
|
|
(expect (string-prefix-ci? "pIrAte" "PiRaT") #f)
|
|
(expect (string-prefix-ci? (s 'cr "z!@~#$lL*()")
|
|
(s 'cr "Z!@~#$Ll*()def")) #t)
|
|
(expect (string-prefix? (s 'cr "z!@~#$lL*()") (s 'cr "Z!@~#$Ll*()def")) #f)
|
|
|
|
(expect (string-suffix? "ate" "pirate") #t)
|
|
(expect (string-suffix? "rag" "outrage") #f)
|
|
(expect (string-suffix? "rage" "outrage") #t)
|
|
(expect (string-suffix? "rage" (s 'lf " outrage")) #t)
|
|
(expect (string-suffix? "rage" (s 'lf " out\\rage" 'lf)) #f)
|
|
(expect (string-suffix? (s "rage" 'lf) (s 'lf " out\\rage" 'lf)) #t)
|
|
(expect (string-suffix? "pirate" "pirate") #t)
|
|
(expect (string-suffix? "" "pirate") #t)
|
|
(expect (string-suffix? "" "") #t)
|
|
(expect (string-suffix? "pirate" "") #f)
|
|
(expect (string-suffix? "pirat" "pirate") #f)
|
|
(expect (string-suffix? "irate" "pirate") #t)
|
|
(expect (string-suffix? "pirate" "irate") #f)
|
|
(expect (string-suffix? (s 'cr "Z!@~#$Ll*()")
|
|
(s "def" 'cr "Z!@~#$Ll*()")) #t)
|
|
|
|
(expect (string-suffix-ci? "ate" "pirate") #t)
|
|
(expect (string-suffix-ci? "ATE" "pirate") #t)
|
|
(expect (string-suffix? "ATE" "pirate") #f)
|
|
(expect (string-suffix-ci? "rag" "outrage") #f)
|
|
(expect (string-suffix-ci? "rage" "outraGE") #t)
|
|
(expect (string-suffix-ci? "RAGE" (s 'lf " outrage")) #t)
|
|
(expect (string-suffix-ci? "rage" (s 'lf " out\\rage" 'lf)) #f)
|
|
(expect (string-suffix-ci? (s "rAge" 'lf) (s 'lf " out\\raGe" 'lf)) #t)
|
|
(expect (string-suffix-ci? "pirate" "pirate") #t)
|
|
(expect (string-suffix-ci? "" "pirate") #t)
|
|
(expect (string-suffix-ci? "" "") #t)
|
|
(expect (string-suffix-ci? "pirate" "") #f)
|
|
(expect (string-suffix-ci? "Pirat" "pirate") #f)
|
|
(expect (string-suffix-ci? "iRATe" "piRATE") #t)
|
|
(expect (string-suffix-ci? "piRATE" "iRATe") #f)
|
|
(expect (string-suffix-ci? (s 'cr "z!@~#$lL*()")
|
|
(s "def" 'cr "Z!@~#$Ll*()")) #t)
|
|
(expect (string-suffix? (s 'cr "z!@~#$lL*()")
|
|
(s "def" 'cr "Z!@~#$Ll*()")) #f)
|
|
))
|
|
|
|
(test-case "Verifying string case-changing functions"
|
|
(let ((add-nl (lambda (str) (string-append str (string #\newline)))))
|
|
(expect (string-downcase "") "")
|
|
(expect (string-downcase (add-nl "1234abcde!")) (add-nl "1234abcde!"))
|
|
(expect (string-downcase "XYZ\\,%^") "xyz\\,%^")
|
|
(expect (string-downcase (string-append (string #\return) "Z!@~#$Ll*()def"))
|
|
(string-append (string #\return) "z!@~#$ll*()def"))
|
|
|
|
(expect (string-upcase "") "")
|
|
(expect (string-upcase (add-nl "1234abcde!")) (add-nl "1234ABCDE!"))
|
|
(expect (string-upcase "XYZ\\,%^") "XYZ\\,%^")
|
|
(expect (string-upcase (string-append (string #\return) "Z!@~#$Ll*()def"))
|
|
(string-append (string #\return) "Z!@~#$LL*()DEF"))
|
|
|
|
(let* ((test-str (string-copy "a123456789.,Z"))
|
|
(test-str-clone (string-copy test-str)))
|
|
(check-not-eq? test-str test-str-clone)
|
|
(check-equal? test-str test-str-clone)
|
|
(check-not-eq? (string-downcase test-str) (string-downcase test-str))
|
|
(check-equal? (string-downcase test-str) (string-downcase test-str))
|
|
(check-not-eq? (string-upcase test-str) (string-upcase test-str))
|
|
(check-equal? (string-upcase test-str) (string-upcase test-str))
|
|
(string-downcase! test-str)
|
|
(check-not-equal? test-str test-str-clone)
|
|
(check-equal? test-str (string-downcase test-str-clone))
|
|
(check-equal? test-str (string-downcase test-str))
|
|
(string-upcase! test-str)
|
|
(check-not-equal? test-str test-str-clone)
|
|
(check-equal? test-str (string-upcase test-str-clone))
|
|
(check-equal? test-str (string-upcase test-str))
|
|
)
|
|
))
|
|
|
|
(test-case "Verifying string-null?"
|
|
(let ()
|
|
(check-pred string-null? "")
|
|
(check-false (string-null? " "))
|
|
(check-false (string-null? "1 "))
|
|
(check-false (string-null? (string (integer->char 0))))
|
|
))
|
|
|
|
)))
|
|
|
|
(define vowel?
|
|
(lambda (v)
|
|
(and (char? v)
|
|
(or (char=? v #\a) (char=? v #\e) (char=? v #\i) (char=? v #\o) (char=? v #\u)))))
|
|
|
|
|
|
;; Build a string out of components
|
|
;; A component can be a string, a character, a number
|
|
;; (converted into a character), symbols cr and lf
|
|
;; We could've used a notation like "abc\n\t"
|
|
;; Unfortunately, not all Scheme systems support C-like notation
|
|
;; of Scheme strings
|
|
(define (s . components)
|
|
(apply string-append
|
|
(map (lambda (component)
|
|
(cond
|
|
((string? component) component)
|
|
((char? component) (string component))
|
|
((number? component) (string (integer->char component)))
|
|
((eq? 'lf component) (string #\newline))
|
|
((eq? 'cr component) (string (integer->char 13)))
|
|
(else (error "bad component: " component))))
|
|
components)))
|
|
)
|
|
|
|
;;; string-test.rkt ends here
|