;; -*- coding: euc-jp -*-

(use gauche.test)

(test-start "multibyte (euc-jp)")
(use srfi-1)

;;-------------------------------------------------------------------
(test-section "string builtins")

(test* "string" "いろhにほへt"
       (string #\い #\ろ #\h #\に #\ほ #\へ #\t))
(test* "list->string" "いろhにほへt"
       (list->string '(#\い #\ろ #\h #\に #\ほ #\へ #\t)))
(test* "make-string" "へへへへへ" (make-string 5 #\へ))
(test* "make-string" "" (make-string 0 #\へ))

(test* "string->list" '(#\い #\ろ #\h #\に #\ほ #\へ #\t)
       (string->list "いろhにほへt"))
(test* "string->list" '(#\ろ #\h #\に #\ほ #\へ #\t)
       (string->list "いろhにほへt" 1))
(test* "string->list" '(#\ろ #\h #\に)
       (string->list "いろhにほへt" 1 4))

(test* "string-copy" '("ぁゃνぃ" #f)
       (let* ((x "ぁゃνぃ") (y (string-copy x)))
         (list y (eq? x y))))
(test* "string-copy" "ゃνぃ" (string-copy "ぁゃνぃ" 1))
(test* "string-copy" "ゃν"  (string-copy "ぁゃνぃ" 1 3))

(test* "string-ref" #\ろ (string-ref "いろは" 1))
(define x (string-copy "いろはにほ"))
(test* "string-set!" "いろZにほ" (begin (string-set! x 2 #\Z) x))

(test* "string-fill!" "のののののの"
       (string-fill! (string-copy "000000") #\の))
(test* "string-fill!" "000ののの"
       (string-fill! (string-copy "000000") #\の 3))
(test* "string-fill!" "000のの0"
       (string-fill! (string-copy "000000") #\の 3 5))

(test* "string-join" "ふぅ ばぁ ばず"
       (string-join '("ふぅ" "ばぁ" "ばず")))
(test* "string-join" "ふぅ！ばぁ！ばず"
       (string-join '("ふぅ" "ばぁ" "ばず") "！"))
(test* "string-join" "ふぅ→←ばぁ→←ばず"
       (string-join '("ふぅ" "ばぁ" "ばず") "→←" 'infix))
(test* "string-join" ""
       (string-join '() "→←"))
(test* "string-join" "ふぅ！ばぁ！ばず！"
       (string-join '("ふぅ" "ばぁ" "ばず") "！" 'suffix))
(test* "string-join" "！ふぅ！ばぁ！ばず"
       (string-join '("ふぅ" "ばぁ" "ばず") "！" 'prefix))
(test* "string-join" "ふぅ！ばぁ！ばず"
       (string-join '("ふぅ" "ばぁ" "ばず") "！" 'strict-infix))

(let ()
  (define (test-string-scan out s1 s2 . opt)
    (if (pair? out)
      (begin
        (test* "string-scan" (car out) (apply string-scan s1 s2 opt))
        (test* "string-scan-right" (cadr out)
               (apply string-scan-right s1 s2 opt)))
      (apply test-string-scan (list out out) s1 s2 opt)))
  (define (test-string-scan2 out1 out2 s1 s2 . opt)
    (if (pair? out1)
      (begin
        (test* "string-scan" (list (car out1) (car out2))
               (receive r (apply string-scan s1 s2 opt) r))
        (test* "string-scan-right" (list (cadr out1) (cadr out2))
               (receive r (apply string-scan-right s1 s2 opt) r)))
      (apply test-string-scan2 (list out1 out1) (list out2 out2) s1 s2 opt)))

  (test-string-scan '(7 20)
                    "あえいうえおあおあいうえおあえいうえおあおあいうえお" "おあい")
  (test-string-scan '("あえいうえおあ" "あえいうえおあおあいうえおあえいうえおあ")
                      "あえいうえおあおあいうえおあえいうえおあおあいうえお" "おあい" 'before)
  (test-string-scan '("うえおあえいうえおあおあいうえお" "うえお")
                    "あえいうえおあおあいうえおあえいうえおあおあいうえお" "おあい" 'after)
  (test-string-scan2 '("あえいうえおあ" "あえいうえおあおあいうえおあえいうえおあ")
                     '("おあいうえおあえいうえおあおあいうえお" "おあいうえお")
                     "あえいうえおあおあいうえおあえいうえおあおあいうえお" "おあい" 'before*)
  (test-string-scan2 '("あえいうえおあおあい" "あえいうえおあおあいうえおあえいうえおあおあい")
                     '("うえおあえいうえおあおあいうえお" "うえお")
                     "あえいうえおあおあいうえおあえいうえおあおあいうえお" "おあい" 'after*)
  (test-string-scan2 '("あえいうえおあ" "あえいうえおあおあいうえおあえいうえおあ")
                     '("うえおあえいうえおあおあいうえお" "うえお")
                     "あえいうえおあおあいうえおあえいうえおあおあいうえお" "おあい" 'both)
  (test-string-scan #f "あえいうえおあおあいうえお" "おい")
  )

;;-------------------------------------------------------------------
(test-section "string-cursor")

(define str "いろはにhoへと")
(define ss #f)
(define se #f)
(test* "string-cursor-start" #t
       (begin
         (set! ss (string-cursor-start str))
         (string-cursor? ss)))
(test* "string-cursor-start" #t
       (begin
         (set! se (string-cursor-end str))
         (string-cursor? se)))
(test* "string-cursor-next" #\ろ
       (string-ref str (string-cursor-next str ss)))
(test* "string-cursor-forward" #\に
       (string-ref str (string-cursor-forward str ss 3)))
(test* "string-cursor-prev" #\と
       (string-ref str (string-cursor-prev str se)))
(test* "string-cursor-back" #\に
       (string-ref str (string-cursor-back str se 5)))
(test* "string-index->cursor" #\へ
       (string-ref str (string-index->cursor str 6)))
(test* "string-cursor->index" 0
       (string-cursor->index str ss))
(test* "string-cursor->index" 8
       (string-cursor->index str se))
(test* "substring with cursors" "はにho"
       (substring str
                  (string-cursor-forward str ss 2)
                  (string-cursor-back str se 2)))
(test* "substring with cursors" "はにho"
       (substring str
                  2
                  (string-cursor-back str se 2)))
(test* "substring with cursors" "はにh"
       (substring str
                  (string-cursor-forward str ss 2)
                  5))
(test* "string->list" '(#\ろ #\は #\に #\h #\o #\へ)
       (string->list str
                     (string-cursor-next str ss)
                     (string-cursor-prev str se)))
(test* "string->list" '(#\ろ #\は #\に #\h #\o #\へ)
       (string->list str
                     1
                     (string-cursor-prev str se)))
(test* "string->list" '(#\ろ #\は #\に #\h #\o #\へ)
       (string->list str
                     (string-cursor-next str ss)
                     7))
(test* "string-cursor=?" #t
       (string-cursor=? ss (string-cursor-back str se 8)))
(test* "string-cursor=?" #t
       (string-cursor=? 0 0))
(test* "string-cursor<?" #t
       (string-cursor<? ss se))
(test* "string-cursor<=?" #t
       (string-cursor<=? ss se))
(test* "string-cursor<=?" #t
       (string-cursor<=? ss ss))
(test* "string-cursor>?" #t
       (string-cursor>? se ss))
(test* "string-cursor>=?" #t
       (string-cursor>=? se se))
(test* "string-cursor-diff" 8
       (string-cursor-diff str ss se))
(test* "string-cursor-diff" -8
       (string-cursor-diff str se ss))

;;-------------------------------------------------------------------
(test-section "incomplete strings")

(test* "string-length" 6 (string-length #*"あいう"))
(test* "string-complete->incomplete" #*"あいう" 
       (string-complete->incomplete "あいう"))
(test* "string-complete->incomplete" #*"あいう"
       (string-complete->incomplete #*"あいう"))
(test* "string-incomplete->complete" "あいう"
       (string-incomplete->complete #*"あいう"))
(test* "string-incomplete->complete" "あいう"
       (string-incomplete->complete "あいう"))

(test* "string=?" #t (string=? #*"あいう" #*"あいう"))

(test* "string-byte-ref" #xa2 (string-byte-ref #*"あいう" 1))

(test* "string-append" #*"あいうえお"
       (string-append "あいう" #*"えお"))
(test* "string-append" #*"あいうえお"
       (string-append #*"あいう" "えお"))
(test* "string-append" #*"あいうえお"
       (string-append #*"あいう" #*"えお"))
(test* "string-append" 10
       (string-length (string-append "あいう" "えお" #*"")))

(test* "string-incompltet->incomplete" "あ"
       (string-incomplete->complete
        (string-append #*"\xa4" #*"\xa2")))

;;-------------------------------------------------------------------
(test-section "format")

(test* "format" "あぶら"
       (format #f "~,,,,3a" "あぶらかだぶら"))
(test* "format" "abら"
       (format #f "~,,,,3a" "abらかだぶら"))
(test* "format" "あぶらかだぶら"
       (format #f "~,,,,7:a" "あぶらかだぶら"))
(test* "format" "あぶらか"
       (format #f "~,,,,7:a" "あぶらか"))
(test* "format" "あぶら ..."
       (format #f "~,,,,7:a" "あぶらかだぶらぶらぶら"))

;;-------------------------------------------------------------------
(test-section "string-library")
(use srfi-13)

(test* "string-every" #t (string-every #\あ ""))
(test* "string-every" #t (string-every #\あ "ああああ"))
(test* "string-every" #f (string-every #\あ "あああa"))
(test* "string-every" #t (string-every #[あ-ん] "ああいあ"))
(test* "string-every" #f (string-every #[あ-ん] "ああaあ"))
(test* "string-every" #t (string-every #[あ-ん] ""))
(test* "string-every" #t (string-every (^x (char-ci=? x #\あ)) "ああああ"))
(test* "string-every" #f (string-every (^x (char-ci=? x #\あ)) "あいあい"))

(test* "string-any" #t (string-any #\あ "ああああ"))
(test* "string-any" #f (string-any #\あ "いうえお"))
(test* "string-any" #f (string-any #\あ ""))
(test* "string-any" #t (string-any #[あ-ん] "すきーむ"))
(test* "string-any" #f (string-any #[あ-ん] "スキーム"))
(test* "string-any" #f (string-any #[あ-ん] ""))
(test* "string-any" #t (string-any (^x (char-ci=? x #\あ)) "らららあ"))
(test* "string-any" #f (string-any (^x (char-ci=? x #\あ)) "ラララア"))
(test* "string-tabulate" "アィイゥウ"
       (string-tabulate (lambda (code)
                          (integer->char (+ code
                                            (char->integer #\ア))))
                        5))
(test* "reverse-list->string" "んをわ"
       (reverse-list->string '(#\わ #\を #\ん)))
(test* "string-copy!" "abうえおfg"
       (let ((x (string-copy "abcdefg")))
         (string-copy! x 2 "あいうえおか" 2 5)
         x))
(test* "string-take" "あいうえ"  (string-take "あいうえおか" 4))
(test* "string-drop" "おか"  (string-drop "あいうえおか" 4))
(test* "string-take-right" "うえおか"  (string-take-right "あいうえおか" 4))
(test* "string-drop-right" "あい"  (string-drop-right "あいうえおか" 4))
(test* "string-pad" "■■パッド" (string-pad "パッド" 5 #\■))
(test* "string-pad" "パディング" (string-pad "パディング" 5 #\■))
(test* "string-pad" "ディングス" (string-pad "パディングス" 5 #\■))
(test* "string-pad-right" "パッド■■" (string-pad-right "パッド" 5 #\■))
(test* "string-pad" "パディング" (string-pad-right "パディングス" 5 #\■))

;;-------------------------------------------------------------------
(test-section "char set")

(use srfi-14)

(let ((data '(#[ぁ-ん他-唖ァ-ン]
              #[aあ唖ア])))
  (define (t x)
    (test* "mutable/immutable roundtrip" #t
           (char-set= (char-set-copy x)
                      (char-set-copy (char-set-freeze! (char-set-copy x))))))
  (for-each t data))

(test-char-set-1 "char-set-contains?" #t (cut char-set-contains? <> #\あ)
                 (char-set #\あ #\い #\う #\え #\お))
(test-char-set-1 "char-set-contains?" #f (cut char-set-contains? <> #\ぁ)
                 (char-set #\あ #\い #\う #\え #\お))
(test-char-set-1 "char-set-contains?" #t (cut char-set-contains? <> #\ほ)
                 (char-set-union
                  (integer-range->char-set (char->integer #\ぁ)
                                           (char->integer #\ん))
                  (integer-range->char-set (char->integer #\ァ)
                                           (char->integer #\ン))))
(test-char-set-1 "char-set-contains?" #t (cut char-set-contains? <> #\ケ)
                 (char-set-union
                  (integer-range->char-set (char->integer #\ぁ)
                                           (char->integer #\ん))
                  (integer-range->char-set (char->integer #\ァ)
                                           (char->integer #\ン))))
(test-char-set-1 "char-set-contains?" #f (cut char-set-contains? <> #\ん)
                 (char-set-union
                  (integer-range->char-set (char->integer #\ぁ)
                                           (char->integer #\ん))
                  (integer-range->char-set (char->integer #\ァ)
                                           (char->integer #\ン))))
(test-char-set-1 "char-set-contains?" #f (cut char-set-contains? <> #\ヴ)
                 (char-set-union
                  (integer-range->char-set (char->integer #\ぁ)
                                           (char->integer #\ん))
                  (integer-range->char-set (char->integer #\ァ)
                                           (char->integer #\ン))))

(test-char-set-2 "char-set=" #t char-set=
                 (char-set #\あ #\い #\う #\え #\お)
                 (string->char-set "おうえいあ"))
(test-char-set-2 "char-set=" #t char-set=
                 (list->char-set '(#\あ #\い #\う #\ん))
                 (string->char-set "んんいいいああう"))
(test-char-set-2 "char-set=" #t char-set=
                 (->char-set "ぁぃぅぇぉあいうえ")
                 (integer-range->char-set (char->integer #\ぁ)
                                          (char->integer #\お)))
(test-char-set-2 "char-set<=" #t char-set<=
                 (list->char-set '(#\ほ #\げ))
                 char-set:full)
(test-char-set-2 "char-set<=" #t char-set<= #[あい] #[あい])
(test-char-set-2 "char-set<=" #t char-set<= #[あい] #[あ-い])
(test-char-set-2 "char-set<=" #f char-set<= #[あ-い] #[あい])
(test-char-set-2 "char-set<=" #t char-set<= #[あ-いう-え] #[あ-え])
(test-char-set-2 "char-set<=" #f char-set<= #[あ-え] #[あ-いう-え])
(test-char-set-2 "char-set<=" #f char-set<= #[あ-いう-ぉ] #[あ-え])
(test-char-set-2 "char-set<=" #f char-set<= #[ぁ-いう-え] #[あ-え])
(test-char-set-2 "char-set<=" #t char-set<= #[あ-いか-き] #[あ-うお-け])
(test-char-set-2 "char-set<=" #t char-set<= #[あ-いか-き] #[あ-うお-き])
(test-char-set-2 "char-set<=" #t char-set<= #[あ-いか-き] #[あ-うか-こ])
(test-char-set-2 "char-set<=" #t char-set<= #[か-き] #[あ-うか-こ])
(test-char-set-2 "char-set<=" #t char-set<= #[か-きく-け] #[あ-うか-こ])
(test-char-set-2 "char-set<=" #f char-set<= #[う-く] #[あ-えか-こ])

;;-------------------------------------------------------------------
(test-section "ports")

(define istr (open-input-string "イロハニホヘト"))
(test* "read-char" #\イ (read-char istr))
(test* "read-byte" #xa5 (read-byte istr))
(test* "read-byte (using scratch)" #xed
       (begin (peek-char istr) (read-byte istr)))
(test* "read-char (using scratch)" #\ハ
       (read-char istr))
(test* "read-block (using scratch)" #*"ニ"
       (begin (peek-char istr) (read-block 2 istr)))
(test* "read-block (using scratch)" #*"\xa5"
       (begin (peek-char istr) (read-block 1 istr)))
(test* "read-block (using scratch)" #*"\xdbヘト"
       (begin (peek-char istr) (read-block 10 istr)))

;; start over
(set! istr (open-input-string "イロハニホヘト"))
(test* "peek-byte" #xa5 (peek-byte istr))
(test* "peek-char" #\イ (peek-char istr))
(test* "read-byte" #xa5 (read-byte istr))
(test* "peek-byte" #xa4 (peek-byte istr))
(test* "peek-char" #\ロ (begin (read-byte istr) (peek-char istr)))
(test* "read-byte" #\ロ (begin (peek-byte istr) (read-char istr)))
(test* "peek-byte" #xcf
       (begin (peek-char istr) (read-byte istr) (peek-byte istr)))
(test* "read-block" #*"\xcfニホヘ\xa5" (read-block 8 istr))
(test* "peek-byte" #xc8 (peek-byte istr))
(test* "peek-byte" #t (begin (read-byte istr) (eof-object? (peek-byte istr))))

(test* "read-line (LF)" "なむ"
       (read-line (open-input-string "なむ\n")))
(test* "read-line (CR)" "なむ"
       (read-line (open-input-string "なむ\r")))
(test* "read-line (CRLF)" "なむ"
       (read-line (open-input-string "なむ\r\n")))
(test* "read-line (using ungotten)" "なむ"
       (let1 s (open-input-string "なむ\n")
         (peek-char s) (read-line s)))
(test* "read-line (using ungotten)" "なむ"
       (let1 s (open-input-string "なむ\n")
         (peek-byte s) (read-line s)))

;(test "read-line (using scratch)" "なむ"
;      (lambda ()
;        (let ((i (open-input-string "なむ\n"))
;              (o (open-output-string)))
;          (peek-char i)
;          (write-byte (read-byte i) o)
;          (display (read-line i) o)
;          (get-output-string o))))

;;-------------------------------------------------------------------
(test-section "buffered ports")

(define (make-filler)
  (let* ((str #*"あいうえおかきくけこ")  ;incomplete string
         (len (string-size str))
         (ind 0))
    (lambda (siz)
      (cond ((>= ind len) #f)
            ((>= (+ ind siz) len)
             (let ((r (substring str ind len)))
               (set! ind len)
               r))
            (else
             (let ((r (substring str ind (+ ind siz))))
               (set! ind (+ ind siz))
               r))))))

(define (port->char-list p)
  (let loop ((c (read-char p)) (r '()))
    (if (eof-object? c) (reverse r) (loop (read-char p) (cons c r)))))

(define (port->byte-list p)
  (let loop ((b (read-byte p)) (r '()))
    (if (eof-object? b) (reverse r) (loop (read-byte p) (cons b r)))))

(define (port->chunk-list p siz)
  (let loop ((b (read-block siz p)) (r '()))
    (if (eof-object? b) (reverse r) (loop (read-block siz p) (cons b r)))))

(test* "buffered port (getc, bufsiz=256)"
       '(#\あ #\い #\う #\え #\お #\か #\き #\く #\け #\こ)
       (port->char-list (open-input-buffered-port (make-filler) 256)))

(test* "buffered port (getc, bufsiz=7)"
       '(#\あ #\い #\う #\え #\お #\か #\き #\く #\け #\こ)
       (port->char-list (open-input-buffered-port (make-filler) 7)))

(test* "buffered port (getc, bufsiz=3)"
       '(#\あ #\い #\う #\え #\お #\か #\き #\く #\け #\こ)
       (port->char-list (open-input-buffered-port (make-filler) 3)))

(test* "buffered port (getc, bufsiz=2)"
       '(#\あ #\い #\う #\え #\お #\か #\き #\く #\け #\こ)
       (port->char-list (open-input-buffered-port (make-filler) 2)))

(test* "buffered port (getc, bufsiz=1)"
       '(#\あ #\い #\う #\え #\お #\か #\き #\く #\け #\こ)
       (port->char-list (open-input-buffered-port (make-filler) 1)))

(test* "buffered port (getb, bufsiz=256)"
       '(#xa4 #xa2 #xa4 #xa4 #xa4 #xa6 #xa4 #xa8 #xa4 #xaa
              #xa4 #xab #xa4 #xad #xa4 #xaf #xa4 #xb1 #xa4 #xb3)
       (port->byte-list (open-input-buffered-port (make-filler) 256)))

(test* "buffered port (getb, bufsiz=20)"
       '(#xa4 #xa2 #xa4 #xa4 #xa4 #xa6 #xa4 #xa8 #xa4 #xaa
              #xa4 #xab #xa4 #xad #xa4 #xaf #xa4 #xb1 #xa4 #xb3)
       (port->byte-list (open-input-buffered-port (make-filler) 20)))

(test* "buffered port (getb, bufsiz=19)"
       '(#xa4 #xa2 #xa4 #xa4 #xa4 #xa6 #xa4 #xa8 #xa4 #xaa
              #xa4 #xab #xa4 #xad #xa4 #xaf #xa4 #xb1 #xa4 #xb3)
       (port->byte-list (open-input-buffered-port (make-filler) 19)))

(test* "buffered port (getb, bufsiz=2)"
       '(#xa4 #xa2 #xa4 #xa4 #xa4 #xa6 #xa4 #xa8 #xa4 #xaa
              #xa4 #xab #xa4 #xad #xa4 #xaf #xa4 #xb1 #xa4 #xb3)
       (port->byte-list (open-input-buffered-port (make-filler) 2)))

(test* "buffered port (getb, bufsiz=1)"
       '(#xa4 #xa2 #xa4 #xa4 #xa4 #xa6 #xa4 #xa8 #xa4 #xaa
              #xa4 #xab #xa4 #xad #xa4 #xaf #xa4 #xb1 #xa4 #xb3)
       (port->byte-list (open-input-buffered-port (make-filler) 1)))

(test* "buffered port (getz, siz=20,5)"
       '(#*"\xa4\xa2\xa4\xa4\xa4" #*"\xa6\xa4\xa8\xa4\xaa"
           #*"\xa4\xab\xa4\xad\xa4" #*"\xaf\xa4\xb1\xa4\xb3")
       (port->chunk-list (open-input-buffered-port (make-filler) 20) 5))

(test* "buffered port (getz, siz=20,20)"
       '(#*"\xa4\xa2\xa4\xa4\xa4\xa6\xa4\xa8\xa4\xaa\xa4\xab\xa4\xad\xa4\xaf\xa4\xb1\xa4\xb3")
       (port->chunk-list (open-input-buffered-port (make-filler) 20) 20))

(test* "buffered port (getz, siz=9,20)"
       '(#*"\xa4\xa2\xa4\xa4\xa4\xa6\xa4\xa8\xa4\xaa\xa4\xab\xa4\xad\xa4\xaf\xa4\xb1\xa4\xb3")
       (port->chunk-list (open-input-buffered-port (make-filler) 9) 20))

(test* "buffered port (getz, siz=9,7)"
       '(#*"\xa4\xa2\xa4\xa4\xa4\xa6\xa4" #*"\xa8\xa4\xaa\xa4\xab\xa4\xad"
           #*"\xa4\xaf\xa4\xb1\xa4\xb3")
       (port->chunk-list (open-input-buffered-port (make-filler) 9) 7))

(test* "buffered port (getz, siz=3,50)"
       '(#*"\xa4\xa2\xa4\xa4\xa4\xa6\xa4\xa8\xa4\xaa\xa4\xab\xa4\xad\xa4\xaf\xa4\xb1\xa4\xb3")
       (port->chunk-list (open-input-buffered-port (make-filler) 3) 50))

(test* "buffered port (getz, siz=2,7)"
       '(#*"\xa4\xa2\xa4\xa4\xa4\xa6\xa4" #*"\xa8\xa4\xaa\xa4\xab\xa4\xad"
           #*"\xa4\xaf\xa4\xb1\xa4\xb3")
       (port->chunk-list (open-input-buffered-port (make-filler) 2) 7))

(test* "buffered port (getz, siz=1,7)"
       '(#*"\xa4\xa2\xa4\xa4\xa4\xa6\xa4" #*"\xa8\xa4\xaa\xa4\xab\xa4\xad"
           #*"\xa4\xaf\xa4\xb1\xa4\xb3")
       (port->chunk-list (open-input-buffered-port (make-filler) 1) 7))

(define *flusher-out* '())

(define (flusher str)
  (if str
      (set! *flusher-out* (cons str *flusher-out*))
      (set! *flusher-out* (string-concatenate-reverse *flusher-out*))))

(define (byte-list->port p bytes)
  (set! *flusher-out* '())
  (for-each (^b (write-byte b p)) bytes)
  (close-output-port p)
  *flusher-out*)

(define (char-list->port p chars)
  (set! *flusher-out* '())
  (for-each (^c (write-char c p)) chars)
  (close-output-port p)
  *flusher-out*)

(define (string-list->port p strs)
  (set! *flusher-out* '())
  (for-each (^s (display s p)) strs)
  (close-output-port p)
  *flusher-out*)

(test* "buffered port (putb, bufsiz=7)"
       #*"@ABCDEFGHIJKLMNOPQRSTUVWXYZ"
       (byte-list->port (open-output-buffered-port flusher 7)
                        (iota 27 #x40)))

(test* "buffered port (putb, bufsiz=30)"
       #*"@ABCDEFGHIJKLMNOPQRSTUVWXYZ"
       (byte-list->port (open-output-buffered-port flusher 30)
                        (iota 27 #x40)))

(test* "buffered port (putc, bufsiz=7)"
       #*"あいうえおかきくけこさしすせそ"
       (char-list->port (open-output-buffered-port flusher 7)
                        '(#\あ #\い #\う #\え #\お #\か #\き #\く #\け #\こ
                          #\さ #\し #\す #\せ #\そ)))

(test* "buffered port (putc, bufsiz=30)"
       #*"あいうえおかきくけこさしすせそ"
       (char-list->port (open-output-buffered-port flusher 30)
                        '(#\あ #\い #\う #\え #\お #\か #\き #\く #\け #\こ
                          #\さ #\し #\す #\せ #\そ)))

(test* "buffered port (puts, bufsiz=6)"
       #*"あいうえおかきくけこさしすせそ"
       (string-list->port (open-output-buffered-port flusher 6)
                          '("あいう" "えおか" "きくけ" "こさし" "すせそ")))

(test* "buffered port (puts, bufsiz=7)"
       #*"あいうえおかきくけこさしすせそ"
       (string-list->port (open-output-buffered-port flusher 7)
                          '("あいう" "えおか" "きくけ" "こさし" "すせそ")))

(test* "buffered port (puts, bufsiz=7)"
       #*"あいうえおかきくけこさしすせそ"
       (string-list->port (open-output-buffered-port flusher 7)
                          '("あいうえお" "かきくけこ" "さしすせ" "そ")))

(test* "buffered port (puts, bufsiz=3)"
       #*"あいうえおかきくけこさしすせそ"
       (string-list->port (open-output-buffered-port flusher 3)
                          '("あいうえお" "かきくけこ" "さしすせ" "そ")))

;;-------------------------------------------------------------------
(test-section "regexp")

(test* "regexp" "いaろbはc"
       (cond ((rxmatch #/([ぁ-ん][a-z])+/ "xyいaろbはcdに")
              => rxmatch-substring)
             (else #f)))
(test* "regexp" "いaろBはC"
       (cond ((rxmatch #/([ぁ-ん][a-z])+/i "XYいaろBはCdに")
              => rxmatch-substring)
             (else #f)))

(test* "regexp" #f
       (cond ((rxmatch #/(.*)a/ "あいう")
              => rxmatch-substring)
             (else #f)))

(test* "regexp" "あいa"
       (cond ((rxmatch #/(.*)a/ "あいaう")
              => rxmatch-substring)
             (else #f)))

(test* "regexp" #f
       (cond ((rxmatch #/([^a]*)a/ "あいう")
              => rxmatch-substring)
             (else #f)))

(test* "regexp" "あいう"
       (cond ((rxmatch #/([^a]*)う/ "あいう")
              => rxmatch-substring)
             (else #f)))

(test* "regexp" "あいa"
       (cond ((rxmatch #/([^a]+)a/ "aあいaう")
              => rxmatch-substring)
             (else #f)))

(test* "regexp" #f
       (cond ((rxmatch #/([^a]+)う/ "aあいaう")
              => rxmatch-substring)
             (else #f)))

(test* "regexp" "あい"
       (cond ((rxmatch #/([^a]+)い/ "aあいaう")
              => rxmatch-substring)
             (else #f)))

(test-end)
