1: ;; -*- coding: utf-8 -*-
    2: 
    3: ;; $Id: utf-8.scm,v 1.11 2007/03/02 07:20:42 shirok Exp $
    4: 
    5: (use gauche.test)
    6: 
    7: (test-start "UTF8")
    8: (use srfi-1)
    9: 
   10: ;;-------------------------------------------------------------------
   11: (test-section "string builtins")
   12: 
   13: (test "string" "いろhにほへt"
   14:       (lambda () (string #\い #\ろ #\h #\に #\ほ #\へ #\t)))
   15: (test "list->string" "いろhにほへt"
   16:       (lambda () (list->string '(#\い #\ろ #\h #\に #\ほ #\へ #\t))))
   17: (test "make-string" "へへへへへ" (lambda () (make-string 5 #\へ)))
   18: (test "make-string" "" (lambda () (make-string 0 #\へ)))
   19: 
   20: (test "string->list" '(#\い #\ろ #\h #\に #\ほ #\へ #\t)
   21:       (lambda () (string->list "いろhにほへt")))
   22: (test "string->list" '(#\ろ #\h #\に #\ほ #\へ #\t)
   23:       (lambda () (string->list "いろhにほへt" 1)))
   24: (test "string->list" '(#\ろ #\h #\に)
   25:       (lambda () (string->list "いろhにほへt" 1 4)))
   26: 
   27: (test "string-copy" '("ぁゃνぃ" #f)
   28:       (lambda () (let* ((x "ぁゃνぃ") (y (string-copy x)))
   29:                    (list y (eq? x y)))))
   30: (test "string-copy" "ゃνぃ" (lambda () (string-copy "ぁゃνぃ" 1)))
   31: (test "string-copy" "ゃν"  (lambda () (string-copy "ぁゃνぃ" 1 3)))
   32: 
   33: (test "string-ref" #\ろ (lambda () (string-ref "いろは" 1)))
   34: (define x (string-copy "いろはにほ"))
   35: (test "string-set!" "いろZにほ" (lambda () (string-set! x 2 #\Z) x))
   36: 
   37: (test "string-fill!" "のののののの"
   38:       (lambda () (string-fill! (string-copy "000000") #\の)))
   39: (test "string-fill!" "000ののの"
   40:       (lambda () (string-fill! (string-copy "000000") #\の 3)))
   41: (test "string-fill!" "000のの0"
   42:       (lambda () (string-fill! (string-copy "000000") #\の 3 5)))
   43: 
   44: (test "string-join" "ふぅ ばぁ ばず"
   45:       (lambda () (string-join '("ふぅ" "ばぁ" "ばず"))))
   46: (test "string-join" "ふぅ！ばぁ！ばず"
   47:       (lambda () (string-join '("ふぅ" "ばぁ" "ばず") "！")))
   48: (test "string-join" "ふぅ→←ばぁ→←ばず"
   49:       (lambda () (string-join '("ふぅ" "ばぁ" "ばず") "→←" 'infix)))
   50: (test "string-join" ""
   51:       (lambda () (string-join '() "→←")))
   52: (test "string-join" "ふぅ！ばぁ！ばず！"
   53:       (lambda () (string-join '("ふぅ" "ばぁ" "ばず") "！" 'suffix)))
   54: (test "string-join" "！ふぅ！ばぁ！ばず"
   55:       (lambda () (string-join '("ふぅ" "ばぁ" "ばず") "！" 'prefix)))
   56: (test "string-join" "ふぅ！ばぁ！ばず"
   57:       (lambda () (string-join '("ふぅ" "ばぁ" "ばず") "！" 'strict-infix)))
   58: 
   59: (test "string-scan" 7
   60:       (lambda () (string-scan "あえいうえおあおあいうえお" "おあい")))
   61: (test "string-scan" "あえいうえおあ"
   62:       (lambda () (string-scan "あえいうえおあおあいうえお" "おあい" 'before)))
   63: (test "string-scan" "うえお"
   64:       (lambda () (string-scan "あえいうえおあおあいうえお" "おあい" 'after)))
   65: (test "string-scan" '("あえいうえおあ" "おあいうえお")
   66:       (lambda ()
   67:         (receive r (string-scan "あえいうえおあおあいうえお" "おあい" 'before*) r)))
   68: (test "string-scan" '("あえいうえおあおあい" "うえお")
   69:       (lambda ()
   70:         (receive r (string-scan "あえいうえおあおあいうえお" "おあい" 'after*) r)))
   71: (test "string-scan" '("あえいうえおあ" "うえお")
   72:       (lambda ()
   73:         (receive r (string-scan "あえいうえおあおあいうえお" "おあい" 'both) r)))
   74: (test "string-scan" #f
   75:       (lambda () (string-scan "あえいうえおあおあいうえお" "おい")))
   76: 
   77: ;;-------------------------------------------------------------------
   78: (test-section "string-pointer")
   79: (define sp #f)
   80: (test "make-string-pointer" #t
   81:       (lambda ()
   82:         (set! sp (make-string-pointer "いろはにhoへと"))
   83:         (string-pointer? sp)))
   84: (test "string-pointer-next!" #\い
   85:       (lambda () (string-pointer-next! sp)))
   86: (test "string-pointer-next!" #\ろ
   87:       (lambda () (string-pointer-next! sp)))
   88: (test "string-pointer-prev!" #\ろ
   89:       (lambda () (string-pointer-prev! sp)))
   90: (test "string-pointer-prev!" #\い
   91:       (lambda () (string-pointer-prev! sp)))
   92: (test "string-pointer-prev!" #t
   93:       (lambda () (eof-object? (string-pointer-prev! sp))))
   94: (test "string-pointer-index" 0
   95:       (lambda () (string-pointer-index sp)))
   96: (test "string-pointer-index" 8
   97:       (lambda () (do ((x (string-pointer-next! sp) (string-pointer-next! sp)))
   98:                      ((eof-object? x) (string-pointer-index sp)))))
   99: (test "string-pointer-substring" '("いろはにhoへと" "")
  100:       (lambda () (list (string-pointer-substring sp)
  101:                        (string-pointer-substring sp :after #t))))
  102: (test "string-pointer-substring" '("いろはにh" "oへと")
  103:       (lambda ()
  104:         (string-pointer-set! sp 5)
  105:         (list (string-pointer-substring sp)
  106:               (string-pointer-substring sp :after #t))))
  107: (test "string-pointer-substring" '("" "いろはにhoへと")
  108:       (lambda ()
  109:         (string-pointer-set! sp 0)
  110:         (list (string-pointer-substring sp)
  111:               (string-pointer-substring sp :after #t))))
  112: 
  113: ;;-------------------------------------------------------------------
  114: (test-section "incomplete strings")
  115: 
  116: (test "string-length" 9 (lambda () (string-length #*"あいう")))
  117: (test "string-complete->incomplete" #*"あいう" 
  118:       (lambda () (string-complete->incomplete "あいう")))
  119: (test "string-complete->incomplete" #*"あいう"
  120:       (lambda () (string-complete->incomplete #*"あいう")))
  121: (test "string-incomplete->complete" "あいう"
  122:       (lambda () (string-incomplete->complete #*"あいう")))
  123: (test "string-incomplete->complete" "あいう"
  124:       (lambda () (string-incomplete->complete "あいう")))
  125: 
  126: (test "string-incomplete->complete (reject)" #f
  127:       (lambda () (string-incomplete->complete #*"あい\x80う" #f)))
  128: (test "string-incomplete->complete (omit)" "あいう"
  129:       (lambda () (string-incomplete->complete #*"あい\x80う" :omit)))
  130: (test "string-incomplete->complete (omit)" "あいう"
  131:       (lambda () (string-incomplete->complete #*"\x80あいう" :omit)))
  132: (test "string-incomplete->complete (omit)" "あいう"
  133:       (lambda () (string-incomplete->complete #*"\x80\xe3あいう" :omit)))
  134: (test "string-incomplete->complete (omit)" "あいう"
  135:       (lambda () (string-incomplete->complete #*"あいう\xe3" :omit)))
  136: (test "string-incomplete->complete (omit)" "あいう"
  137:       (lambda () (string-incomplete->complete #*"あいう\xe3\xe3" :omit)))
  138: (test "string-incomplete->complete (omit)" "あいう"
  139:       (lambda () (string-incomplete->complete #*"あいう\xe3\x80" :omit)))
  140: (test "string-incomplete->complete (replace)" "あいふう"
  141:       (lambda () (string-incomplete->complete #*"あい\x80う" #\ふ)))
  142: (test "string-incomplete->complete (replace)" "ふあいう"
  143:       (lambda () (string-incomplete->complete #*"\x80あいう" #\ふ)))
  144: (test "string-incomplete->complete (replace)" "ふふあいう"
  145:       (lambda () (string-incomplete->complete #*"\x80\xe3あいう" #\ふ)))
  146: (test "string-incomplete->complete (replace)" "あいうふ"
  147:       (lambda () (string-incomplete->complete #*"あいう\xe3" #\ふ)))
  148: (test "string-incomplete->complete (replace)" "あいうふふ"
  149:       (lambda () (string-incomplete->complete #*"あいう\xe3\xe3" #\ふ)))
  150: (test "string-incomplete->complete (replace)" "あいうふふ"
  151:       (lambda () (string-incomplete->complete #*"あいう\xe3\x80" #\ふ)))
  152: 
  153: (test "string=?" #t (lambda () (string=? #*"あいう" #*"あいう")))
  154: 
  155: (test "string-byte-ref" #x81 (lambda () (string-byte-ref #*"あいう" 1)))
  156: 
  157: (test "string-append" #*"あいうえお"
  158:       (lambda () (string-append "あいう" #*"えお")))
  159: (test "string-append" #*"あいうえお"
  160:       (lambda () (string-append #*"あいう" "えお")))
  161: (test "string-append" #*"あいうえお"
  162:       (lambda () (string-append #*"あいう" #*"えお")))
  163: (test "string-append" 15
  164:       (lambda () (string-length (string-append "あいう" "えお" #*""))))
  165: 
  166: (test "string-incomplete->complete" "あ"
  167:       (lambda () (string-incomplete->complete
  168:                   (string-append #*"\xe3" #*"\x81" #*"\x82"))))
  169: 
  170: ;;-------------------------------------------------------------------
  171: (test-section "format")
  172: 
  173: (test "format" "あぶら"
  174:       (lambda () (format #f "~,,,,3a" "あぶらかだぶら")))
  175: (test "format" "abら"
  176:       (lambda () (format #f "~,,,,3a" "abらかだぶら")))
  177: (test "format" "あぶらかだぶら"
  178:       (lambda () (format #f "~,,,,7:a" "あぶらかだぶら")))
  179: (test "format" "あぶらか"
  180:       (lambda () (format #f "~,,,,7:a" "あぶらか")))
  181: (test "format" "あぶら ..."
  182:       (lambda () (format #f "~,,,,7:a" "あぶらかだぶらぶらぶら")))
  183: 
  184: ;;-------------------------------------------------------------------
  185: (test-section "string-library")
  186: (use srfi-13)
  187: 
  188: (test "string-every" #t (lambda () (string-every #\あ "")))
  189: (test "string-every" #t (lambda () (string-every #\あ "ああああ")))
  190: (test "string-every" #f (lambda () (string-every #\あ "あああa")))
  191: (test "string-every" #t (lambda () (string-every #[あ-ん] "ああいあ")))
  192: (test "string-every" #f (lambda () (string-every #[あ-ん] "ああaあ")))
  193: (test "string-every" #t (lambda () (string-every #[あ-ん] "")))
  194: (test "string-every" #t (lambda () (string-every (lambda (x) (char-ci=? x #\あ)) "ああああ")))
  195: (test "string-every" #f (lambda () (string-every (lambda (x) (char-ci=? x #\あ)) "あいあい")))
  196: 
  197: (test "string-any" #t (lambda () (string-any #\あ "ああああ")))
  198: (test "string-any" #f (lambda () (string-any #\あ "いうえお")))
  199: (test "string-any" #f (lambda () (string-any #\あ "")))
  200: (test "string-any" #t (lambda () (string-any #[あ-ん] "すきーむ")))
  201: (test "string-any" #f (lambda () (string-any #[あ-ん] "スキーム")))
  202: (test "string-any" #f (lambda () (string-any #[あ-ん] "")))
  203: (test "string-any" #t (lambda () (string-any (lambda (x) (char-ci=? x #\あ)) "らららあ")))
  204: (test "string-any" #f (lambda () (string-any (lambda (x) (char-ci=? x #\あ)) "ラララア")))
  205: (test "string-tabulate" "アィイゥウ"
  206:       (lambda ()
  207:         (string-tabulate (lambda (code)
  208:                            (integer->char (+ code
  209:                                              (char->integer #\ア))))
  210:                          5)))
  211: (test "reverse-list->string" "んをわ"
  212:       (lambda () (reverse-list->string '(#\わ #\を #\ん))))
  213: (test "string-copy!" "abうえおfg"
  214:       (lambda () (let ((x (string-copy "abcdefg")))
  215:                    (string-copy! x 2 "あいうえおか" 2 5)
  216:                    x)))
  217: (test "string-take" "あいうえ"  (lambda () (string-take "あいうえおか" 4)))
  218: (test "string-drop" "おか"  (lambda () (string-drop "あいうえおか" 4)))
  219: (test "string-take-right" "うえおか"  (lambda () (string-take-right "あいうえおか" 4)))
  220: (test "string-drop-right" "あい"  (lambda () (string-drop-right "あいうえおか" 4)))
  221: (test "string-pad" "■■パッド" (lambda () (string-pad "パッド" 5 #\■)))
  222: (test "string-pad" "パディング" (lambda () (string-pad "パディング" 5 #\■)))
  223: (test "string-pad" "ディングス" (lambda () (string-pad "パディングス" 5 #\■)))
  224: (test "string-pad-right" "パッド■■" (lambda () (string-pad-right "パッド" 5 #\■)))
  225: (test "string-pad" "パディング" (lambda () (string-pad-right "パディングス" 5 #\■)))
  226: 
  227: ;;-------------------------------------------------------------------
  228: (test-section "char set")
  229: 
  230: (use srfi-14)
  231: 
  232: (test "char-set" #t
  233:       (lambda () (char-set= (char-set #\あ #\い #\う #\え #\お)
  234:                             (string->char-set "おうえいあ"))))
  235: (test "char-set" #t
  236:       (lambda () (char-set= (list->char-set '(#\あ #\い #\う #\ん))
  237:                             (string->char-set "んんいいいああう"))))
  238: (test "char-set" #t
  239:       (lambda () (char-set<= (list->char-set '(#\ほ #\げ))
  240:                              char-set:full)))
  241: (test "char-set" #t
  242:       (lambda ()
  243:         (char-set= (->char-set "ぁぃぅぇぉあいうえ")
  244:                    (integer-range->char-set (char->integer #\ぁ)
  245:                                             (char->integer #\お)))))
  246: 
  247: ;;-------------------------------------------------------------------
  248: (test-section "ports")
  249: 
  250: ;; イ     ロ     ハ     ニ      ホ     ヘ     ト
  251: ;; e382a4.e383ad.e3838f.e3838b.e3839b.e38398.e38388
  252: (define istr (open-input-string "イロハニホヘト"))
  253: (test* "read-char" #\イ (read-char istr))
  254: (test* "read-byte" #xe3 (read-byte istr))
  255: (test* "read-byte (using scratch)" #xad
  256:        (begin (read-byte istr) (read-byte istr)))
  257: (test* "read-char (using scratch)" #\ハ
  258:        (begin (peek-byte istr) (read-char istr)))
  259: (test* "read-block (using scratch)" #*"ニ"
  260:        (begin (peek-char istr) (read-block 3 istr)))
  261: (test* "read-block (using scratch)" #*"\xe3"
  262:        (begin (peek-char istr) (read-block 1 istr)))
  263: (test* "read-block (using scratch)" #*"\x83\x9bヘト"
  264:        (begin (read-block 10 istr)))
  265: 
  266: ;; start over
  267: (set! istr (open-input-string "イロハニホヘト"))
  268: (test* "peek-byte" #xe3 (peek-byte istr))
  269: (test* "peek-char" #\イ (peek-char istr))
  270: (test* "read-byte" #xe3 (read-byte istr))
  271: (test* "peek-byte" #x82 (peek-byte istr))
  272: (test* "peek-char" #\ロ
  273:        (begin (read-byte istr) (read-byte istr) (peek-char istr)))
  274: (test* "read-byte" #\ロ (begin (peek-byte istr) (read-char istr)))
  275: (test* "peek-byte" #x83
  276:        (begin (peek-char istr) (read-byte istr) (peek-byte istr)))
  277: (test* "read-block" #*"\x83\x8fニホヘ\xe3\x83" (read-block 13 istr))
  278: (test* "peek-byte" #x88 (peek-byte istr))
  279: (test* "peek-byte" #t (begin (read-byte istr) (eof-object? (peek-byte istr))))
  280: 
  281: (test* "read-line (LF)" "なむ"
  282:        (read-line (open-input-string "なむ\n")))
  283: (test* "read-line (CR)" "なむ"
  284:        (read-line (open-input-string "なむ\r")))
  285: (test* "read-line (CRLF)" "なむ"
  286:        (read-line (open-input-string "なむ\r\n")))
  287: (test* "read-line (using ungotten)" "なむ"
  288:        (let1 s (open-input-string "なむ\n")
  289:          (peek-char s) (read-line s)))
  290: (test* "read-line (using ungotten)" "なむ"
  291:        (let1 s (open-input-string "なむ\n")
  292:          (peek-byte s) (read-line s)))
  293: 
  294: ;;-------------------------------------------------------------------
  295: (test-section "buffered ports")
  296: 
  297: (define (make-filler)
  298:   (let* ((str #*"あいうえおかきくけこ")  ;incomplete string
  299:          (len (string-size str))
  300:          (ind 0))
  301:     (lambda (siz)
  302:       (cond ((>= ind len) #f)
  303:             ((>= (+ ind siz) len)
  304:              (let ((r (substring str ind len)))
  305:                (set! ind len)
  306:                r))
  307:             (else
  308:              (let ((r (substring str ind (+ ind siz))))
  309:                (set! ind (+ ind siz))
  310:                r))))))
  311: 
  312: (define (port->char-list p)
  313:   (let loop ((c (read-char p)) (r '()))
  314:     (if (eof-object? c) (reverse r) (loop (read-char p) (cons c r)))))
  315: 
  316: (define (port->byte-list p)
  317:   (let loop ((b (read-byte p)) (r '()))
  318:     (if (eof-object? b) (reverse r) (loop (read-byte p) (cons b r)))))
  319: 
  320: (define (port->chunk-list p siz)
  321:   (let loop ((b (read-block siz p)) (r '()))
  322:     (if (eof-object? b) (reverse r) (loop (read-block siz p) (cons b r)))))
  323: 
  324: (test "buffered port (getc, bufsiz=256)"
  325:       '(#\あ #\い #\う #\え #\お #\か #\き #\く #\け #\こ)
  326:       (lambda ()
  327:         (port->char-list (open-input-buffered-port (make-filler) 256))))
  328: 
  329: (test "buffered port (getc, bufsiz=7)"
  330:       '(#\あ #\い #\う #\え #\お #\か #\き #\く #\け #\こ)
  331:       (lambda ()
  332:         (port->char-list (open-input-buffered-port (make-filler) 7))))
  333: 
  334: (test "buffered port (getc, bufsiz=3)"
  335:       '(#\あ #\い #\う #\え #\お #\か #\き #\く #\け #\こ)
  336:       (lambda ()
  337:         (port->char-list (open-input-buffered-port (make-filler) 3))))
  338: 
  339: (test "buffered port (getc, bufsiz=2)"
  340:       '(#\あ #\い #\う #\え #\お #\か #\き #\く #\け #\こ)
  341:       (lambda ()
  342:         (port->char-list (open-input-buffered-port (make-filler) 2))))
  343: 
  344: (test "buffered port (getc, bufsiz=1)"
  345:       '(#\あ #\い #\う #\え #\お #\か #\き #\く #\け #\こ)
  346:       (lambda ()
  347:         (port->char-list (open-input-buffered-port (make-filler) 1))))
  348: 
  349: (test "buffered port (getb, bufsiz=256)"
  350:       '(#xe3 #x81 #x82 #xe3 #x81 #x84 #xe3 #x81 #x86 #xe3 #x81 #x88
  351:         #xe3 #x81 #x8a #xe3 #x81 #x8b #xe3 #x81 #x8d #xe3 #x81 #x8f
  352:         #xe3 #x81 #x91 #xe3 #x81 #x93)
  353:       (lambda ()
  354:         (port->byte-list (open-input-buffered-port (make-filler) 256))))
  355: 
  356: (test "buffered port (getb, bufsiz=20)"
  357:       '(#xe3 #x81 #x82 #xe3 #x81 #x84 #xe3 #x81 #x86 #xe3 #x81 #x88
  358:         #xe3 #x81 #x8a #xe3 #x81 #x8b #xe3 #x81 #x8d #xe3 #x81 #x8f
  359:         #xe3 #x81 #x91 #xe3 #x81 #x93)
  360:       (lambda ()
  361:         (port->byte-list (open-input-buffered-port (make-filler) 20))))
  362: 
  363: (test "buffered port (getb, bufsiz=19)"
  364:       '(#xe3 #x81 #x82 #xe3 #x81 #x84 #xe3 #x81 #x86 #xe3 #x81 #x88
  365:         #xe3 #x81 #x8a #xe3 #x81 #x8b #xe3 #x81 #x8d #xe3 #x81 #x8f
  366:         #xe3 #x81 #x91 #xe3 #x81 #x93)
  367:       (lambda ()
  368:         (port->byte-list (open-input-buffered-port (make-filler) 19))))
  369: 
  370: (test "buffered port (getb, bufsiz=2)"
  371:       '(#xe3 #x81 #x82 #xe3 #x81 #x84 #xe3 #x81 #x86 #xe3 #x81 #x88
  372:         #xe3 #x81 #x8a #xe3 #x81 #x8b #xe3 #x81 #x8d #xe3 #x81 #x8f
  373:         #xe3 #x81 #x91 #xe3 #x81 #x93)
  374:       (lambda ()
  375:         (port->byte-list (open-input-buffered-port (make-filler) 2))))
  376: 
  377: (test "buffered port (getb, bufsiz=1)"
  378:       '(#xe3 #x81 #x82 #xe3 #x81 #x84 #xe3 #x81 #x86 #xe3 #x81 #x88
  379:         #xe3 #x81 #x8a #xe3 #x81 #x8b #xe3 #x81 #x8d #xe3 #x81 #x8f
  380:         #xe3 #x81 #x91 #xe3 #x81 #x93)
  381:       (lambda ()
  382:         (port->byte-list (open-input-buffered-port (make-filler) 1))))
  383: 
  384: (test "buffered port (getz, siz=20,5)"
  385:       '(#*"\xe3\x81\x82\xe3\x81" #*"\x84\xe3\x81\x86\xe3"
  386:         #*"\x81\x88\xe3\x81\x8a" #*"\xe3\x81\x8b\xe3\x81"
  387:         #*"\x8d\xe3\x81\x8f\xe3" #*"\x81\x91\xe3\x81\x93")
  388:       (lambda ()
  389:         (port->chunk-list (open-input-buffered-port (make-filler) 20) 5)))
  390: 
  391: (test "buffered port (getz, siz=20,20)"
  392:       '(#*"\xe3\x81\x82\xe3\x81\x84\xe3\x81\x86\xe3\x81\x88\xe3\x81\x8a\xe3\x81\x8b\xe3\x81"
  393:         #*"\x8d\xe3\x81\x8f\xe3\x81\x91\xe3\x81\x93")
  394:       (lambda ()
  395:         (port->chunk-list (open-input-buffered-port (make-filler) 20) 20)))
  396: 
  397: (test "buffered port (getz, siz=9,20)"
  398:       '(#*"\xe3\x81\x82\xe3\x81\x84\xe3\x81\x86\xe3\x81\x88\xe3\x81\x8a\xe3\x81\x8b\xe3\x81"
  399:         #*"\x8d\xe3\x81\x8f\xe3\x81\x91\xe3\x81\x93")
  400:       (lambda ()
  401:         (port->chunk-list (open-input-buffered-port (make-filler) 9) 20)))
  402: 
  403: (test "buffered port (getz, siz=9,7)"
  404:       '(#*"\xe3\x81\x82\xe3\x81\x84\xe3"
  405:         #*"\x81\x86\xe3\x81\x88\xe3\x81"
  406:         #*"\x8a\xe3\x81\x8b\xe3\x81\x8d"
  407:         #*"\xe3\x81\x8f\xe3\x81\x91\xe3"
  408:         #*"\x81\x93")
  409:       (lambda ()
  410:         (port->chunk-list (open-input-buffered-port (make-filler) 9) 7)))
  411: 
  412: (test "buffered port (getz, siz=3,50)"
  413:       '(#*"\xe3\x81\x82\xe3\x81\x84\xe3\x81\x86\xe3\x81\x88\xe3\x81\x8a\xe3\x81\x8b\xe3\x81\x8d\xe3\x81\x8f\xe3\x81\x91\xe3\x81\x93")
  414:       (lambda ()
  415:         (port->chunk-list (open-input-buffered-port (make-filler) 3) 50)))
  416: 
  417: (test "buffered port (getz, siz=2,7)"
  418:       '(#*"\xe3\x81\x82\xe3\x81\x84\xe3"
  419:         #*"\x81\x86\xe3\x81\x88\xe3\x81"
  420:         #*"\x8a\xe3\x81\x8b\xe3\x81\x8d"
  421:         #*"\xe3\x81\x8f\xe3\x81\x91\xe3"
  422:         #*"\x81\x93")
  423:       (lambda ()
  424:         (port->chunk-list (open-input-buffered-port (make-filler) 2) 7)))
  425: 
  426: (test "buffered port (getz, siz=1,7)"
  427:       '(#*"\xe3\x81\x82\xe3\x81\x84\xe3"
  428:         #*"\x81\x86\xe3\x81\x88\xe3\x81"
  429:         #*"\x8a\xe3\x81\x8b\xe3\x81\x8d"
  430:         #*"\xe3\x81\x8f\xe3\x81\x91\xe3"
  431:         #*"\x81\x93")
  432:       (lambda ()
  433:         (port->chunk-list (open-input-buffered-port (make-filler) 1) 7)))
  434: 
  435: (define *flusher-out* '())
  436: 
  437: (define (flusher str)
  438:   (if str
  439:       (set! *flusher-out* (cons str *flusher-out*))
  440:       (set! *flusher-out* (string-concatenate-reverse *flusher-out*))))
  441: 
  442: (define (byte-list->port p bytes)
  443:   (set! *flusher-out* '())
  444:   (for-each (lambda (b) (write-byte b p)) bytes)
  445:   (close-output-port p)
  446:   *flusher-out*)
  447: 
  448: (define (char-list->port p chars)
  449:   (set! *flusher-out* '())
  450:   (for-each (lambda (c) (write-char c p)) chars)
  451:   (close-output-port p)
  452:   *flusher-out*)
  453: 
  454: (define (string-list->port p strs)
  455:   (set! *flusher-out* '())
  456:   (for-each (lambda (s) (display s p)) strs)
  457:   (close-output-port p)
  458:   *flusher-out*)
  459: 
  460: (test "buffered port (putb, bufsiz=7)"
  461:       #*"@ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  462:       (lambda ()
  463:         (byte-list->port (open-output-buffered-port flusher 7)
  464:                          (iota 27 #x40))))
  465: 
  466: (test "buffered port (putb, bufsiz=30)"
  467:       #*"@ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  468:       (lambda ()
  469:         (byte-list->port (open-output-buffered-port flusher 30)
  470:                          (iota 27 #x40))))
  471: 
  472: (test "buffered port (putc, bufsiz=7)"
  473:       #*"あいうえおかきくけこさしすせそ"
  474:       (lambda ()
  475:         (char-list->port (open-output-buffered-port flusher 7)