1: ;;
    2: ;; test for string related functions
    3: ;;
    4: 
    5: (use gauche.test)
    6: 
    7: (test-start "string")
    8: 
    9: ;;-------------------------------------------------------------------
   10: (test-section "builtins")
   11: 
   12: (test* "string" "abcdefg" (string #\a #\b #\c #\d #\e #\f #\g))
   13: (test* "string" "" (string))
   14: (test* "list->string" "abcdefg"
   15:        (list->string '(#\a #\b #\c #\d #\e #\f #\g)))
   16: (test* "list->string" "" (list->string '()))
   17: (test* "make-string" "aaaaa" (make-string 5 #\a))
   18: (test* "make-string" "" (make-string 0 #\a))
   19: 
   20: (test* "immutable" #t (string-immutable? "abcde"))
   21: (test* "immutable" #t (string-immutable? ""))
   22: (test* "immutable" #f (string-immutable? (string-copy "abcde")))
   23: (test* "immutable" #f (string-immutable? (string #\a #\b)))
   24: (test* "immutable" #f (string-immutable? (string)))
   25: 
   26: (test* "string->list" '(#\a #\b #\c #\d #\e #\f #\g)
   27:        (string->list "abcdefg"))
   28: (test* "string->list" '(#\c #\d #\e #\f #\g)
   29:        (string->list "abcdefg" 2)) ;srfi-13 extension
   30: (test* "string->list" '(#\c #\d #\e)
   31:        (string->list "abcdefg" 2 5)) ;srfi-13 extension
   32: (test* "string->list" '(#\a)
   33:        (string->list "abcdefg" 0 1)) ;srfi-13 extension
   34: (test* "string->list" '() (string->list ""))
   35: 
   36: ;; this should be switched by native encoding.
   37: ;(test* "string w/ char >= \\x80" (integer->char #xa1)
   38: ;       (string-ref (string (integer->char #xa1)) 0))
   39: 
   40: (test* "string-copy" '("abcde" #f)
   41:        (let* ((x "abcde") (y (string-copy x)))
   42:          (list y (eq? x y))))
   43: (test* "string-copy" "cde" (string-copy "abcde" 2))
   44: (test* "string-copy" "cd"  (string-copy "abcde" 2 4))
   45: 
   46: (test* "string-ref" #\b (string-ref "abc" 1))
   47: (define x (string-copy "abcde"))
   48: (test* "string-set!" "abZde" (begin (string-set! x 2 #\Z) x))
   49: 
   50: (test* "string-fill!" "ZZZZZZ"
   51:        (string-fill! (string-copy "000000") #\Z))
   52: (test* "string-fill!" "000ZZZ"
   53:        (string-fill! (string-copy "000000") #\Z 3))
   54: (test* "string-fill!" "000ZZ0"
   55:        (string-fill! (string-copy "000000") #\Z 3 5))
   56: 
   57: (test* "string-join" "foo bar baz"
   58:        (string-join '("foo" "bar" "baz")))
   59: (test* "string-join" "foo::bar::baz"
   60:        (string-join '("foo" "bar" "baz") "::"))
   61: (test* "string-join" "foo::bar::baz"
   62:        (string-join '("foo" "bar" "baz") "::" 'infix))
   63: (test* "string-join" ""
   64:        (string-join '() "::"))
   65: (test* "string-join" "foo::bar::baz::"
   66:        (string-join '("foo" "bar" "baz") "::" 'suffix))
   67: (test* "string-join" ""
   68:        (string-join '() "::" 'suffix))
   69: (test* "string-join" "::foo::bar::baz"
   70:        (string-join '("foo" "bar" "baz") "::" 'prefix))
   71: (test* "string-join" ""
   72:        (string-join '() "::" 'prefix))
   73: (test* "string-join" "foo::bar::baz"
   74:        (string-join '("foo" "bar" "baz") "::" 'strict-infix))
   75: 
   76: (test* "string-scan" 3 (string-scan "abcdefghi" "def"))
   77: (test* "string-scan" 3 (string-scan "abcdefghi" "def" 'index))
   78: (test* "string-scan" "abc" (string-scan "abcdefghi" "def" 'before))
   79: (test* "string-scan" "ghi" (string-scan "abcdefghi" "def" 'after))
   80: (test* "string-scan" '("abc" "defghi")
   81:        (receive r (string-scan "abcdefghi" "def" 'before*) r))
   82: (test* "string-scan" '("abcdef" "ghi")
   83:        (receive r (string-scan "abcdefghi" "def" 'after*) r))
   84: (test* "string-scan" '("abc" "ghi")
   85:        (receive r (string-scan "abcdefghi" "def" 'both) r))
   86: 
   87: (test* "string-scan" 4 (string-scan "abcdefghi" #\e))
   88: (test* "string-scan" "abcd" (string-scan "abcdefghi" #\e 'before))
   89: (test* "string-scan" "fghi" (string-scan "abcdefghi" #\e 'after))
   90: (test* "string-scan" '("abcd" "efghi")
   91:        (receive r (string-scan "abcdefghi" #\e 'before*) r))
   92: (test* "string-scan" '("abcde" "fghi")
   93:        (receive r (string-scan "abcdefghi" #\e 'after*) r))
   94: (test* "string-scan" '("abcd" "fghi")
   95:        (receive r (string-scan "abcdefghi" #\e 'both) r))
   96: 
   97: (test* "string-scan (boyer-moore)" 216
   98:        (string-scan "abracadababrabrabrabracadababrabrabrabracadababrabrabrabracadababrabrabrabracadababrabrabrabracadababrabrabrabracadababrabrabrabracadababrabrabrabracadababrabrabrabracadababrabrabrabracadababrabrabrabracadababrabrabrabracadabrabracadababrabrabrabracadababrabrabrabracadababrabrabrabracadababrabrabrabracadababrabrabrabracadababrabrabrabracadababrabrabrabracadababrabrabr"
   99:                     "abracadabra"))
  100: 
  101: (test* "string-scan (special case)" 0
  102:        (string-scan "abakjrgaker" ""))
  103: 
  104: ;;-------------------------------------------------------------------
  105: (test-section "string-split")
  106: 
  107: (test* "string-split (char)" '("aa" "bbb" "c")
  108:        (string-split "aa*bbb*c" #\*))
  109: (test* "string-split (char)" '("aa" "bbb" "c" "")
  110:        (string-split "aa*bbb*c*" #\*))
  111: (test* "string-split (char)" '("aa" "bbb" "c" "" "")
  112:        (string-split "aa*bbb*c**" #\*))
  113: (test* "string-split (char)" '("aa")
  114:        (string-split "aa" #\*))
  115: (test* "string-split (char)" '("")
  116:        (string-split "" #\*))
  117: (test* "string-split (char)" '("" "")
  118:        (string-split "*" #\*))
  119: 
  120: (test* "string-split (1-char string)" '("aa" "bbb" "c")
  121:        (string-split "aa*bbb*c" "*"))
  122: 
  123: (test* "string-split (string)" '("aa" "bbb" "c*c")
  124:        (string-split "aa**bbb**c*c" "**"))
  125: (test* "string-split (string)" '("aa**bbb**c*c")
  126:        (string-split "aa**bbb**c*c" "--"))
  127: (test* "string-split (string)" '("aa" "bbb" "c*c" "")
  128:        (string-split "aa**bbb**c*c**" "**"))
  129: (test* "string-split (string)" '("")
  130:        (string-split "" "**"))
  131: (test* "string-split (string)" '("" "")
  132:        (string-split "**" "**"))
  133: 
  134: (test* "string-split (regexp)" '("aa" "bbb" "c" "c")
  135:        (string-split "aa--bbb--c-c" #/-+/))
  136: (test* "string-split (regexp)" '("aa" "bbb" "-c-c")
  137:        (string-split "aa--bbb---c-c" #/--/))
  138: (test* "string-split (regexp)" '("" "aa" "bbb" "c" "c" "")
  139:        (string-split "--aa--bbb---c-c-" #/-+/))
  140: (test* "string-split (regexp)" '("--" "--" "---" "-" "-")
  141:        (string-split "--aa--bbb---c-c-" #/\w+/))
  142: (test* "string-split (regexp)" '("--aa--bbb---c-c-")
  143:        (string-split "--aa--bbb---c-c-" #/z+/))
  144: (test* "string-split (regexp)" *test-error* ;; test detection of infinite loop
  145:        (string-split "--aa--bbb---c-c-" #/-*/))
  146: 
  147: (test* "string-split (charset)" '("aa" "bbb" "c" "d")
  148:        (string-split "aa---bbb***c&d" #[\W]))
  149: (test* "string-split (charset)" '("" "---" "***" "&" "")
  150:        (string-split "aa---bbb***c&d" #[\w]))
  151: (test* "string-split (charset)" '("")
  152:        (string-split "" #[\w]))
  153: (test* "string-split (charset)" '("" "")
  154:        (string-split "a" #[\w]))
  155: 
  156: (test* "string-split (predicate)" '("" "---" "***" "&" "")
  157:        (string-split "aa---bbb***c&d" char-alphabetic?))
  158: 
  159: ;;-------------------------------------------------------------------
  160: (test-section "incomplete strings")
  161: 
  162: ;; Real test for incomplete string requires multibyte strings.
  163: ;; Here I only check consistency of combination between complete
  164: ;; and incomplete strings.
  165: 
  166: (test* "string-incomplete?" #f (string-incomplete? "abc"))
  167: (test* "string-incomplete?" #t (string-incomplete? #*"abc"))
  168: (test* "string-incomplete?" #f (string-incomplete? ""))
  169: (test* "string-incomplete?" #t (string-incomplete? #*""))
  170: 
  171: (test* "string-complete->incomplete" #*"xyz"
  172:        (string-complete->incomplete "xyz"))
  173: (test* "string-complete->incomplete" #*"xyz"
  174:        (string-complete->incomplete #*"xyz"))
  175: (test* "string-incomplete->complete" "xyz"
  176:        (string-incomplete->complete #*"xyz"))
  177: (test* "string-incomplete->complete" "xyz"
  178:        (string-incomplete->complete "xyz"))
  179: 
  180: (test* "string=?" #t (string=? #*"abc" #*"abc"))
  181: 
  182: (test* "string-byte-ref" (char->integer #\b)
  183:        (string-byte-ref #*"abc" 1))
  184: (test* "string-byte-ref" 0
  185:        (string-byte-ref #*"\0\0\0" 1))
  186: 
  187: (test* "string-append" #*"abcdef"
  188:        (string-append "abc" #*"def"))
  189: (test* "string-append" #*"abcdef"
  190:        (string-append #*"abc" "def"))
  191: (test* "string-append" #*"abcdef"
  192:        (string-append #*"abc" #*"def"))
  193: (test* "string-append" #*"abcdef"
  194:        (string-append "a" #*"b" "c" "d" "e" #*"f"))
  195: 
  196: (test* "string-join" #*"a:b:c"
  197:        (string-join '("a" #*"b" "c") ":"))
  198: (test* "string-join" #*"a:b:c"
  199:        (string-join '("a" "b" "c") #*":"))
  200: 
  201: (test* "string-scan" 3
  202:        (string-scan #*"abcdefghi" "def"))
  203: (test* "string-scan" 3
  204:        (string-scan "abcdefghi" #*"def"))
  205: (test* "string-scan" '(#*"abc" #*"ghi")
  206:        (receive r (string-scan #*"abcdefghi" "def" 'both) r))
  207: (test* "string-scan" '(#*"abc" #*"ghi")
  208:        (receive r (string-scan "abcdefghi" #*"def" 'both) r))
  209: (test* "string-scan" '(#*"abcd" #*"fghi")
  210:        (receive r (string-scan #*"abcdefghi" #\e 'both) r))
  211: 
  212: 
  213: ;; NB: should we allow this?
  214: (test* "string-set!" #*"abQde"
  215:        (let ((s (string-copy #*"abcde")))
  216:          (string-set! s 2 #\Q)
  217:          s))
  218: (test* "string-byte-set!" #*"abQde"
  219:        (let ((s (string-copy "abcde")))
  220:          (string-byte-set! s 2 (char->integer #\Q))
  221:          s))
  222: (test* "string-byte-set!" #*"abQde"
  223:        (let ((s (string-copy #*"abcde")))
  224:          (string-byte-set! s 2 (char->integer #\Q))
  225:          s))
  226: 
  227: (test* "substring" #*"ab"
  228:        (substring #*"abcde" 0 2))
  229: 
  230: ;;-------------------------------------------------------------------
  231: (test-section "string-pointer")
  232: 
  233: (define sp #f)
  234: (test* "make-string-pointer" #t
  235:        (begin
  236:          (set! sp (make-string-pointer "abcdefg"))
  237:          (string-pointer? sp)))
  238: (test* "string-pointer-next!" #\a
  239:        (string-pointer-next! sp))
  240: (test* "string-pointer-next!" #\b
  241:        (string-pointer-next! sp))
  242: (test* "string-pointer-prev!" #\b
  243:        (string-pointer-prev! sp))
  244: (test* "string-pointer-prev!" #\a
  245:        (string-pointer-prev! sp))
  246: (test* "string-pointer-prev!" #t
  247:        (eof-object? (string-pointer-prev! sp)))
  248: (test* "string-pointer-index" 0
  249:        (string-pointer-index sp))
  250: (test* "string-pointer-index" 7
  251:        (do ((x (string-pointer-next! sp) (string-pointer-next! sp)))
  252:            ((eof-object? x) (string-pointer-index sp))))
  253: (test* "string-pointer-substring" '("abcdefg" "")
  254:        (list (string-pointer-substring sp)
  255:              (string-pointer-substring sp :after #t)))
  256: (test* "string-pointer-substring" '("abcd" "efg")
  257:        (begin
  258:          (string-pointer-set! sp 4)
  259:          (list (string-pointer-substring sp)
  260:                (string-pointer-substring sp :after #t))))
  261: (test* "string-pointer-substring" '("" "abcdefg")
  262:        (begin
  263:          (string-pointer-set! sp 0)
  264:          (list (string-pointer-substring sp)
  265:                (string-pointer-substring sp :after #t))))
  266: (test* "string-pointer-substring" '("" "")
  267:        (let ((sp (make-string-pointer "")))
  268:          (list (string-pointer-substring sp)
  269:                (string-pointer-substring sp :after #t))))
  270: 
  271: (test* "make-string-pointer (bound)" #t
  272:        (begin
  273:          (set! sp (make-string-pointer "abcdefg" 1 2 5))
  274:          (string-pointer? sp)))
  275: (test* "string-pointer-next! (bound)" #\d
  276:        (string-pointer-next! sp))
  277: (test* "string-pointer-next! (bound)" #\e
  278:        (string-pointer-next! sp))
  279: (test* "string-pointer-next! (bound)" #t
  280:        (eof-object? (string-pointer-next! sp)))
  281: (test* "string-pointer-prev! (bound)" #\e
  282:        (string-pointer-prev! sp))
  283: (test* "string-pointer-prev! (bound)" #\d
  284:        (string-pointer-prev! sp))
  285: (test* "string-pointer-prev! (bound)" #\c
  286:        (string-pointer-prev! sp))
  287: (test* "string-pointer-prev! (bound)" #t
  288:        (eof-object? (string-pointer-prev! sp)))
  289: (test* "string-pointer-next! (bound)" #\c
  290:        (string-pointer-next! sp))
  291: (test* "string-pointer-substring (bound)" '("c" "de")
  292:        (list (string-pointer-substring sp)
  293:              (string-pointer-substring sp :after #t)))
  294: 
  295: ;;-------------------------------------------------------------------
  296: (test-section "input string port")
  297: 
  298: ;; These also tests port's ungetc buffer and scratch buffer.
  299: 
  300: (define istr (open-input-string "abcdefg"))
  301: 
  302: (test* "read-char" #\a (read-char istr))
  303: (test* "peek-char" #\b (peek-char istr))
  304: (test* "read-byte" 98  (read-byte istr))
  305: (test* "read-byte from ungotten buffer" 99
  306:        (begin (peek-char istr) (read-byte istr)))
  307: (test* "read-block using ungotten buffer" #*"d"
  308:        (begin (peek-char istr) (read-block 1 istr)))
  309: (test* "read-block using ungotten buffer" #*"efg"
  310:        (begin (peek-char istr) (read-block 10 istr)))
  311: (test* "termination" #t
  312:        (eof-object? (read-char istr)))
  313: (test* "termination" #t
  314:        (eof-object? (read-byte istr)))
  315: (test* "termination" #t
  316:        (eof-object? (read-block 3 istr)))
  317: 
  318: (test* "get-remaining-input-string" "defg"
  319:        (let ((istr (open-input-string "abcdefg")))
  320:          (read-char istr)
  321:          (read-char istr)
  322:          (read-char istr)
  323:          (get-remaining-input-string istr)))
  324: (test* "get-remaining-input-string" ""
  325:        (let ((istr (open-input-string "abcdefg")))
  326:          (read-line istr)
  327:          (get-remaining-input-string istr)))
  328: (test* "get-remaining-input-string" "cdefg"
  329:        (let ((istr (open-input-string "abcdefg")))
  330:          (read-char istr)
  331:          (read-char istr)
  332:          (peek-char istr)
  333:          (get-remaining-input-string istr)))
  334: (test* "get-remaining-input-string" "cdefg"
  335:        (let ((istr (open-input-string "abcdefg")))
  336:          (read-char istr)
  337:          (read-char istr)
  338:          (peek-byte istr)
  339:          (get-remaining-input-string istr)))
  340: 
  341: (define (read-line-tester str)
  342:   (let1 s (open-input-string str)
  343:     (let loop ((l (read-line s))
  344:                (r '()))
  345:       (if (eof-object? l) (reverse r) (loop (read-line s) (cons l r))))))
  346: 
  347: (test* "read-line (nullstr)" '()
  348:        (read-line-tester ""))
  349: (test* "read-line (NL)" '("")
  350:        (read-line-tester "\n"))
  351: (test* "read-line (CR)" '("")
  352:        (read-line-tester "\r"))
  353: (test* "read-line (CRNL)" '("")
  354:        (read-line-tester "\r\n"))
  355: (test* "read-line (mix)" '("ab" "cd" "" "ef" "g")
  356:        (read-line-tester "ab\rcd\r\r\nef\ng"))
  357: (test* "read-line (ungotten)" '("ab" "cd")
  358:        (let1 s (open-input-string "ab\ncd")
  359:          (let loop ((l (begin (peek-char s) (read-line s)))
  360:                     (r '()))
  361:            (if (eof-object? l) (reverse r) (loop (read-line s) (cons l r))))))
  362: 
  363: ;;-------------------------------------------------------------------
  364: (test-section "output string port")
  365: 
  366: ;; This effectively tests the dynamic string implemenatation.
  367: ;; The parameter dstr-init-size and dstr-incr-factor have to
  368: ;; match to test boundary conditions.
  369: 
  370: (define *dstr-init-size* 32)
  371: (define *dstr-incr-factor* 3)
  372: 
  373: (define (string-port-tester . args)
  374:   (let ((out (open-output-string)))
  375:     (for-each (lambda (s) (display s out)) args)
  376:     (get-output-string out)))
  377: 
  378: (define (test-string-port signature total seg)
  379:   (let* ((repeat (inexact->exact (ceiling (/ total seg))))
  380:          (actual (* seg repeat))
  381:          (result (make-string actual #\?)))
  382:     (test (string-append "string-port " signature)
  383:           #t
  384:           (lambda ()
  385:             (string=? result
  386:                       (apply string-port-tester (make-list repeat (make-string seg #\?))))))))
  387: 
  388: (define (test-string-ports signature total . segs)
  389:   (test-string-port signature total total)
  390:   (for-each (lambda (seg) (test-string-port signature total seg)) segs))
  391: 
  392: (test* "string-port (0)" ""
  393:        (string-port-tester))
  394: (test* "string-port (0)" ""
  395:        (string-port-tester "" "" ""))
  396: 
  397: (test-string-ports "(small-1)" (- *dstr-init-size* 1) 3 2 1)
  398: (test-string-ports "(small)" *dstr-init-size* 3 2 1)
  399: (test-string-ports "(small+1)" (+ *dstr-init-size* 1) 3 2 1)
  400: (test-string-ports "(mid-1)"
  401:                    (- (* *dstr-init-size* (+ *dstr-incr-factor* 1)) 1)
  402:                    (- *dstr-init-size* 1) *dstr-init-size* 3)
  403: (test-string-ports "(mid)"
  404:                    (* *dstr-init-size* (+ *dstr-incr-factor* 1))
  405:                    (- *dstr-init-size* 1) *dstr-init-size* 3)
  406: (test-string-ports "(mid+1)" 
  407:                    (+ (* *dstr-init-size* (+ *dstr-incr-factor* 1)) 1)
  408:                    (- *dstr-init-size* 1) *dstr-init-size* 3)
  409: (test-string-ports "(large)" 10000
  410:                    (- *dstr-init-size* 1) *dstr-init-size*
  411:                    (+ *dstr-init-size* 1)
  412:                    (- (* *dstr-init-size* (+ *dstr-incr-factor* 1)) 1)
  413:                    (* *dstr-init-size* (+ *dstr-incr-factor* 1))
  414:                    )
  415: 
  416: ;;-------------------------------------------------------------------
  417: (test-section "string interpolation")
  418: 
  419: (test* "string interpolation" "string interpolation"
  420:        (let ((x "inter") (y "polation"))
  421:          #`"string ,|x|,|y|"))
  422: (test "string interpolation" "string interpolation"
  423:       (lambda ()
  424:         (define (x) "inter")
  425:         (define (y) "polation")
  426:         #`"string ,(x),(y)"))
  427: (test "string interpolation" "string interpolation"
  428:       (lambda ()
  429:         (define (x a)
  430:           (if a "inter" "polation"))
  431:         #`"string ,(x #t),(x #f)"))
  432: 
  433: (test-end)