1: ;; -*- coding: euc-jp -*-
    2: 
    3: ;; $Id: euc-jp.scm,v 1.23 2007/03/02 07:20:42 shirok Exp $
    4: 
    5: (use gauche.test)
    6: 
    7: (test-start "EUC-JP")
    8: (use srfi-1)
    9: 
   10: ;;-------------------------------------------------------------------
   11: (test-section "string builtins")
   12: 
   13: (test* "string" "????ˤۤ?"
   14:        (string #\?? #\??\h #\??#\??#\??#\t))
   15: (test* "list->string" "????ˤۤ?"
   16:        (list->string '(#\?? #\??\h #\??#\??#\??#\t)))
   17: (test* "make-string" "?ؤؤؤؤ? (make-string 5 #\??)
   18: (test* "make-string" "" (make-string 0 #\??)
   19: 
   20: (test* "string->list" '(#\?? #\??\h #\??#\??#\??#\t)
   21:        (string->list "????ˤۤ?"))
   22: (test* "string->list" '(#\??\h #\??#\??#\??#\t)
   23:        (string->list "????ˤۤ?" 1))
   24: (test* "string->list" '(#\??\h #\??
   25:        (string->list "????ˤۤ?" 1 4))
   26: 
   27: (test* "string-copy" '("??????" #f)
   28:        (let* ((x "??????") (y (string-copy x)))
   29:          (list y (eq? x y))))
   30: (test* "string-copy" "????" (string-copy "??????" 1))
   31: (test* "string-copy" "??"  (string-copy "??????" 1 3))
   32: 
   33: (test* "string-ref" #\??string-ref "????" 1))
   34: (define x (string-copy "?????ˤ?))
   35: (test* "string-set!" "????ˤ? (begin (string-set! x 2 #\Z) x))
   36: 
   37: (test* "string-fill!" "?ΤΤΤΤΤ?
   38:        (string-fill! (string-copy "000000") #\??)
   39: (test* "string-fill!" "000?ΤΤ?
   40:        (string-fill! (string-copy "000000") #\??3))
   41: (test* "string-fill!" "000?Τ?"
   42:        (string-fill! (string-copy "000000") #\??3 5))
   43: 
   44: (test* "string-join" "?դ? ?Ф? ?Ф?"
   45:        (string-join '("?դ?" "?Ф?" "?Ф?")))
   46: (test* "string-join" "?դ????Ф????Ф?"
   47:        (string-join '("?դ?" "?Ф?" "?Ф?") "??"))
   48: (test* "string-join" "?դ??????Ф??????Ф?"
   49:        (string-join '("?դ?" "?Ф?" "?Ф?") "????" 'infix))
   50: (test* "string-join" ""
   51:        (string-join '() "????"))
   52: (test* "string-join" "?դ????Ф????Ф???"
   53:        (string-join '("?դ?" "?Ф?" "?Ф?") "??" 'suffix))
   54: (test* "string-join" "???դ????Ф????Ф?"
   55:        (string-join '("?դ?" "?Ф?" "?Ф?") "??" 'prefix))
   56: (test* "string-join" "?դ????Ф????Ф?"
   57:        (string-join '("?դ?" "?Ф?" "?Ф?") "??" 'strict-infix))
   58: 
   59: (test* "string-scan" 7
   60:        (string-scan "??????????????????????????" "??????"))
   61: (test* "string-scan" "??????????????"
   62:        (string-scan "??????????????????????????" "??????" 'before))
   63: (test* "string-scan" "??????"
   64:        (string-scan "??????????????????????????" "??????" 'after))
   65: (test* "string-scan" '("??????????????" "????????????")
   66:        (receive r (string-scan "??????????????????????????" "??????" 'before*) r))
   67: (test* "string-scan" '("????????????????????" "??????")
   68:        (receive r (string-scan "??????????????????????????" "??????" 'after*) r))
   69: (test* "string-scan" '("??????????????" "??????")
   70:        (receive r (string-scan "??????????????????????????" "??????" 'both) r))
   71: (test* "string-scan" #f
   72:        (string-scan "??????????????????????????" "????"))
   73: 
   74: ;;-------------------------------------------------------------------
   75: (test-section "string-pointer")
   76: (define sp #f)
   77: (test* "make-string-pointer" #t
   78:        (begin (set! sp (make-string-pointer "??????o?ؤ?))
   79:               (string-pointer? sp)))
   80: (test* "string-pointer-next!" #\?? (string-pointer-next! sp))
   81: (test* "string-pointer-next!" #\??string-pointer-next! sp))
   82: (test* "string-pointer-prev!" #\??string-pointer-prev! sp))
   83: (test* "string-pointer-prev!" #\?? (string-pointer-prev! sp))
   84: (test* "string-pointer-prev!" #t (eof-object? (string-pointer-prev! sp)))
   85: (test* "string-pointer-index" 0 (string-pointer-index sp))
   86: (test* "string-pointer-index" 8
   87:        (do ((x (string-pointer-next! sp) (string-pointer-next! sp)))
   88:            ((eof-object? x) (string-pointer-index sp))))
   89: (test* "string-pointer-substring" '("??????o?ؤ? "")
   90:        (list (string-pointer-substring sp)
   91:              (string-pointer-substring sp :after #t)))
   92: (test* "string-pointer-substring" '("??????" "o?ؤ?)
   93:        (begin
   94:          (string-pointer-set! sp 5)
   95:          (list (string-pointer-substring sp)
   96:                (string-pointer-substring sp :after #t))))
   97: (test* "string-pointer-substring" '("" "??????o?ؤ?)
   98:        (begin
   99:          (string-pointer-set! sp 0)
  100:          (list (string-pointer-substring sp)
  101:                (string-pointer-substring sp :after #t))))
  102: 
  103: ;; torturing backward pointer movement
  104: (define sp (make-string-pointer "?? -1))
  105: (test* "string-pointer-prev!" #\a (string-pointer-prev! sp))
  106: (test* "string-pointer-prev!" #\??string-pointer-prev! sp))
  107: (test* "string-pointer-prev!" #t (eof-object? (string-pointer-prev! sp)))
  108: 
  109: (define sp (make-string-pointer "????ޤ?a" -1)) ;;dreaded jisx0201 kana
  110: (test* "string-pointer-prev!" #\a (string-pointer-prev! sp))
  111: (test* "string-pointer-prev!" #\??(string-pointer-prev! sp))
  112: (test* "string-pointer-prev!" #\??string-pointer-prev! sp))
  113: (test* "string-pointer-prev!" #\??(string-pointer-prev! sp))
  114: 
  115: ;;-------------------------------------------------------------------
  116: (test-section "incomplete strings")
  117: 
  118: (test* "string-length" 6 (string-length #*"??????"))
  119: (test* "string-complete->incomplete" #*"??????" 
  120:        (string-complete->incomplete "??????"))
  121: (test* "string-complete->incomplete" #*"??????"
  122:        (string-complete->incomplete #*"??????"))
  123: (test* "string-incomplete->complete" "??????"
  124:        (string-incomplete->complete #*"??????"))
  125: (test* "string-incomplete->complete" "??????"
  126:        (string-incomplete->complete "??????"))
  127: 
  128: (test* "string=?" #t (string=? #*"??????" #*"??????"))
  129: 
  130: (test* "string-byte-ref" #xa2 (string-byte-ref #*"??????" 1))
  131: 
  132: (test* "string-append" #*"??????????"
  133:        (string-append "??????" #*"????"))
  134: (test* "string-append" #*"??????????"
  135:        (string-append #*"??????" "????"))
  136: (test* "string-append" #*"??????????"
  137:        (string-append #*"??????" #*"????"))
  138: (test* "string-append" 10
  139:        (string-length (string-append "??????" "????" #*"")))
  140: 
  141: (test* "string-incompltet->incomplete" "??"
  142:        (string-incomplete->complete
  143:         (string-append #*"\xa4" #*"\xa2")))
  144: 
  145: ;;-------------------------------------------------------------------
  146: (test-section "format")
  147: 
  148: (test* "format" "???֤?       (format #f "~,,,,3a" "???֤餫??֤?)
  149: (test* "format" "ab??       (format #f "~,,,,3a" "ab?餫??֤?)
  150: (test* "format" "???֤餫??֤?       (format #f "~,,,,7:a" "???֤餫??֤?)
  151: (test* "format" "???֤餫"
  152:        (format #f "~,,,,7:a" "???֤餫"))
  153: (test* "format" "???֤?.."
  154:        (format #f "~,,,,7:a" "???֤餫??֤?????)
  155: 
  156: ;;-------------------------------------------------------------------
  157: (test-section "string-library")
  158: (use srfi-13)
  159: 
  160: (test* "string-every" #t (string-every #\?? ""))
  161: (test* "string-every" #t (string-every #\?? "????????"))
  162: (test* "string-every" #f (string-every #\?? "??????a"))
  163: (test* "string-every" #t (string-every #[??-??????????"))
  164: (test* "string-every" #f (string-every #[??-??????a??"))
  165: (test* "string-every" #t (string-every #[??-??"))
  166: (test* "string-every" #t (string-every (lambda (x) (char-ci=? x #\??)) "????????"))
  167: (test* "string-every" #f (string-every (lambda (x) (char-ci=? x #\??)) "????????"))
  168: 
  169: (test* "string-any" #t (string-any #\?? "????????"))
  170: (test* "string-any" #f (string-any #\?? "????????"))
  171: (test* "string-any" #f (string-any #\?? ""))
  172: (test* "string-any" #t (string-any #[??-??????????)
  173: (test* "string-any" #f (string-any #[??-??????????)
  174: (test* "string-any" #f (string-any #[??-??"))
  175: (test* "string-any" #t (string-any (lambda (x) (char-ci=? x #\??)) "???餢"))
  176: (test* "string-any" #f (string-any (lambda (x) (char-ci=? x #\??)) "???饢"))
  177: (test* "string-tabulate" "??????????"
  178:        (string-tabulate (lambda (code)
  179:                           (integer->char (+ code
  180:                                             (char->integer #\??))))
  181:                         5))
  182: (test* "reverse-list->string" "???       (reverse-list->string '(#\??\????
  183: (test* "string-copy!" "ab??????fg"
  184:        (let ((x (string-copy "abcdefg")))
  185:          (string-copy! x 2 "????????????" 2 5)
  186:          x))
  187: (test* "string-take" "????????"  (string-take "????????????" 4))
  188: (test* "string-drop" "????"  (string-drop "????????????" 4))
  189: (test* "string-take-right" "????????"  (string-take-right "????????????" 4))
  190: (test* "string-drop-right" "????"  (string-drop-right "????????????" 4))
  191: (test* "string-pad" "?????ѥå? (string-pad "?ѥå? 5 #\??))
  192: (test* "string-pad" "?ѥǥ??? (string-pad "?ѥǥ??? 5 #\??))
  193: (test* "string-pad" "?ǥ??󥰥?" (string-pad "?ѥǥ??󥰥?" 5 #\??))
  194: (test* "string-pad-right" "?ѥåɢ???" (string-pad-right "?ѥå? 5 #\??))
  195: (test* "string-pad" "?ѥǥ??? (string-pad-right "?ѥǥ??󥰥?" 5 #\??))
  196: 
  197: ;;-------------------------------------------------------------------
  198: (test-section "char set")
  199: 
  200: (use srfi-14)
  201: 
  202: (test* "char-set=" #t
  203:        (char-set= (char-set #\?? #\?? #\?? #\?? #\??)
  204:                   (string->char-set "??????????")))
  205: (test* "char-set=" #t
  206:        (char-set= (list->char-set '(#\?? #\?? #\?? #\??                  (string->char-set "?????????????")))
  207: (test* "char-set=" #t
  208:        (char-set= (->char-set "??????????????????")
  209:                   (integer-range->char-set (char->integer #\??)
  210:                                            (char->integer #\??))))
  211: (test* "char-set<=" #t
  212:        (char-set<= (list->char-set '(#\??#\??))
  213:                    char-set:full))
  214: (test* "char-set<=" #t (char-set<= #[????] #[????]))
  215: (test* "char-set<=" #t (char-set<= #[????] #[??-??]))
  216: (test* "char-set<=" #f (char-set<= #[??-??] #[????]))
  217: (test* "char-set<=" #t (char-set<= #[??-????-??] #[??-??]))
  218: (test* "char-set<=" #f (char-set<= #[??-??] #[??-????-??]))
  219: (test* "char-set<=" #f (char-set<= #[??-????-??] #[??-??]))
  220: (test* "char-set<=" #f (char-set<= #[??-????-??] #[??-??]))
  221: (test* "char-set<=" #t (char-set<= #[??-????-??] #[??-????-??]))
  222: (test* "char-set<=" #t (char-set<= #[??-????-??] #[??-????-??]))
  223: (test* "char-set<=" #t (char-set<= #[??-????-??] #[??-????-??]))
  224: (test* "char-set<=" #t (char-set<= #[??-??] #[??-????-??]))
  225: (test* "char-set<=" #t (char-set<= #[??-????-??] #[??-????-??]))
  226: (test* "char-set<=" #f (char-set<= #[??-??] #[??-????-??]))
  227: 
  228: ;;-------------------------------------------------------------------
  229: (test-section "ports")
  230: 
  231: (define istr (open-input-string "?????˥ۥإ?))
  232: (test* "read-char" #\?? (read-char istr))
  233: (test* "read-byte" #xa5 (read-byte istr))
  234: (test* "read-byte (using scratch)" #xed
  235:        (begin (peek-char istr) (read-byte istr)))
  236: (test* "read-char (using scratch)" #\??       (read-char istr))
  237: (test* "read-block (using scratch)" #*"??
  238:        (begin (peek-char istr) (read-block 2 istr)))
  239: (test* "read-block (using scratch)" #*"\xa5"
  240:        (begin (peek-char istr) (read-block 1 istr)))
  241: (test* "read-block (using scratch)" #*"\xdb?إ?
  242:        (begin (peek-char istr) (read-block 10 istr)))
  243: 
  244: ;; start over
  245: (set! istr (open-input-string "?????˥ۥإ?))
  246: (test* "peek-byte" #xa5 (peek-byte istr))
  247: (test* "peek-char" #\?? (peek-char istr))
  248: (test* "read-byte" #xa5 (read-byte istr))
  249: (test* "peek-byte" #xa4 (peek-byte istr))
  250: (test* "peek-char" #\??begin (read-byte istr) (peek-char istr)))
  251: (test* "read-byte" #\??begin (peek-byte istr) (read-char istr)))
  252: (test* "peek-byte" #xcf
  253:        (begin (peek-char istr) (read-byte istr) (peek-byte istr)))
  254: (test* "read-block" #*"\xcf?˥ۥ?xa5" (read-block 8 istr))
  255: (test* "peek-byte" #xc8 (peek-byte istr))
  256: (test* "peek-byte" #t (begin (read-byte istr) (eof-object? (peek-byte istr))))
  257: 
  258: (test* "read-line (LF)" "?ʤ?       (read-line (open-input-string "?ʤ?")))
  259: (test* "read-line (CR)" "?ʤ?       (read-line (open-input-string "?ʤ?")))
  260: (test* "read-line (CRLF)" "?ʤ?       (read-line (open-input-string "?ʤ?\n")))
  261: (test* "read-line (using ungotten)" "?ʤ?       (let1 s (open-input-string "?ʤ?")
  262:          (peek-char s) (read-line s)))
  263: (test* "read-line (using ungotten)" "?ʤ?       (let1 s (open-input-string "?ʤ?")
  264:          (peek-byte s) (read-line s)))
  265: 
  266: ;(test "read-line (using scratch)" "?ʤ?;      (lambda ()
  267: ;        (let ((i (open-input-string "?ʤ?"))
  268: ;              (o (open-output-string)))
  269: ;          (peek-char i)
  270: ;          (write-byte (read-byte i) o)
  271: ;          (display (read-line i) o)
  272: ;          (get-output-string o))))
  273: 
  274: ;;-------------------------------------------------------------------
  275: (test-section "buffered ports")
  276: 
  277: (define (make-filler)
  278:   (let* ((str #*"????????????????????")  ;incomplete string
  279:          (len (string-size str))
  280:          (ind 0))
  281:     (lambda (siz)
  282:       (cond ((>= ind len) #f)
  283:             ((>= (+ ind siz) len)
  284:              (let ((r (substring str ind len)))
  285:                (set! ind len)
  286:                r))
  287:             (else
  288:              (let ((r (substring str ind (+ ind siz))))
  289:                (set! ind (+ ind siz))
  290:                r))))))
  291: 
  292: (define (port->char-list p)
  293:   (let loop ((c (read-char p)) (r '()))
  294:     (if (eof-object? c) (reverse r) (loop (read-char p) (cons c r)))))
  295: 
  296: (define (port->byte-list p)
  297:   (let loop ((b (read-byte p)) (r '()))
  298:     (if (eof-object? b) (reverse r) (loop (read-byte p) (cons b r)))))
  299: 
  300: (define (port->chunk-list p siz)
  301:   (let loop ((b (read-block siz p)) (r '()))
  302:     (if (eof-object? b) (reverse r) (loop (read-block siz p) (cons b r)))))
  303: 
  304: (test* "buffered port (getc, bufsiz=256)"
  305:        '(#\?? #\?? #\?? #\?? #\?? #\?? #\?? #\?? #\?? #\??)
  306:        (port->char-list (open-input-buffered-port (make-filler) 256)))
  307: 
  308: (test* "buffered port (getc, bufsiz=7)"
  309:        '(#\?? #\?? #\?? #\?? #\?? #\?? #\?? #\?? #\?? #\??)
  310:        (port->char-list (open-input-buffered-port (make-filler) 7)))
  311: 
  312: (test* "buffered port (getc, bufsiz=3)"
  313:        '(#\?? #\?? #\?? #\?? #\?? #\?? #\?? #\?? #\?? #\??)
  314:        (port->char-list (open-input-buffered-port (make-filler) 3)))
  315: 
  316: (test* "buffered port (getc, bufsiz=2)"
  317:        '(#\?? #\?? #\?? #\?? #\?? #\?? #\?? #\?? #\?? #\??)
  318:        (port->char-list (open-input-buffered-port (make-filler) 2)))
  319: 
  320: (test* "buffered port (getc, bufsiz=1)"
  321:        '(#\?? #\?? #\?? #\?? #\?? #\?? #\?? #\?? #\?? #\??)
  322:        (port->char-list (open-input-buffered-port (make-filler) 1)))
  323: 
  324: (test* "buffered port (getb, bufsiz=256)"
  325:        '(#xa4 #xa2 #xa4 #xa4 #xa4 #xa6 #xa4 #xa8 #xa4 #xaa
  326:               #xa4 #xab #xa4 #xad #xa4 #xaf #xa4 #xb1 #xa4 #xb3)
  327:        (port->byte-list (open-input-buffered-port (make-filler) 256)))
  328: 
  329: (test* "buffered port (getb, bufsiz=20)"
  330:        '(#xa4 #xa2 #xa4 #xa4 #xa4 #xa6 #xa4 #xa8 #xa4 #xaa
  331:               #xa4 #xab #xa4 #xad #xa4 #xaf #xa4 #xb1 #xa4 #xb3)
  332:        (port->byte-list (open-input-buffered-port (make-filler) 20)))
  333: 
  334: (test* "buffered port (getb, bufsiz=19)"
  335:        '(#xa4 #xa2 #xa4 #xa4 #xa4 #xa6 #xa4 #xa8 #xa4 #xaa
  336:               #xa4 #xab #xa4 #xad #xa4 #xaf #xa4 #xb1 #xa4 #xb3)
  337:        (port->byte-list (open-input-buffered-port (make-filler) 19)))
  338: 
  339: (test* "buffered port (getb, bufsiz=2)"
  340:        '(#xa4 #xa2 #xa4 #xa4 #xa4 #xa6 #xa4 #xa8 #xa4 #xaa
  341:               #xa4 #xab #xa4 #xad #xa4 #xaf #xa4 #xb1 #xa4 #xb3)
  342:        (port->byte-list (open-input-buffered-port (make-filler) 2)))
  343: 
  344: (test* "buffered port (getb, bufsiz=1)"
  345:        '(#xa4 #xa2 #xa4 #xa4 #xa4 #xa6 #xa4 #xa8 #xa4 #xaa
  346:               #xa4 #xab #xa4 #xad #xa4 #xaf #xa4 #xb1 #xa4 #xb3)
  347:        (port->byte-list (open-input-buffered-port (make-filler) 1)))
  348: 
  349: (test* "buffered port (getz, siz=20,5)"
  350:        '(#*"\xa4\xa2\xa4\xa4\xa4" #*"\xa6\xa4\xa8\xa4\xaa"
  351:            #*"\xa4\xab\xa4\xad\xa4" #*"\xaf\xa4\xb1\xa4\xb3")
  352:        (port->chunk-list (open-input-buffered-port (make-filler) 20) 5))
  353: 
  354: (test* "buffered port (getz, siz=20,20)"
  355:        '(#*"\xa4\xa2\xa4\xa4\xa4\xa6\xa4\xa8\xa4\xaa\xa4\xab\xa4\xad\xa4\xaf\xa4\xb1\xa4\xb3")
  356:        (port->chunk-list (open-input-buffered-port (make-filler) 20) 20))
  357: 
  358: (test* "buffered port (getz, siz=9,20)"
  359:        '(#*"\xa4\xa2\xa4\xa4\xa4\xa6\xa4\xa8\xa4\xaa\xa4\xab\xa4\xad\xa4\xaf\xa4\xb1\xa4\xb3")
  360:        (port->chunk-list (open-input-buffered-port (make-filler) 9) 20))
  361: 
  362: (test* "buffered port (getz, siz=9,7)"
  363:        '(#*"\xa4\xa2\xa4\xa4\xa4\xa6\xa4" #*"\xa8\xa4\xaa\xa4\xab\xa4\xad"
  364:            #*"\xa4\xaf\xa4\xb1\xa4\xb3")
  365:        (port->chunk-list (open-input-buffered-port (make-filler) 9) 7))
  366: 
  367: (test* "buffered port (getz, siz=3,50)"
  368:        '(#*"\xa4\xa2\xa4\xa4\xa4\xa6\xa4\xa8\xa4\xaa\xa4\xab\xa4\xad\xa4\xaf\xa4\xb1\xa4\xb3")
  369:        (port->chunk-list (open-input-buffered-port (make-filler) 3) 50))
  370: 
  371: (test* "buffered port (getz, siz=2,7)"
  372:        '(#*"\xa4\xa2\xa4\xa4\xa4\xa6\xa4" #*"\xa8\xa4\xaa\xa4\xab\xa4\xad"
  373:            #*"\xa4\xaf\xa4\xb1\xa4\xb3")
  374:        (port->chunk-list (open-input-buffered-port (make-filler) 2) 7))
  375: 
  376: (test* "buffered port (getz, siz=1,7)"
  377:        '(#*"\xa4\xa2\xa4\xa4\xa4\xa6\xa4" #*"\xa8\xa4\xaa\xa4\xab\xa4\xad"
  378:            #*"\xa4\xaf\xa4\xb1\xa4\xb3")
  379:        (port->chunk-list (open-input-buffered-port (make-filler) 1) 7))
  380: 
  381: (define *flusher-out* '())
  382: 
  383: (define (flusher str)
  384:   (if str
  385:       (set! *flusher-out* (cons str *flusher-out*))
  386:       (set! *flusher-out* (string-concatenate-reverse *flusher-out*))))
  387: 
  388: (define (byte-list->port p bytes)
  389:   (set! *flusher-out* '())
  390:   (for-each (lambda (b) (write-byte b p)) bytes)
  391:   (close-output-port p)
  392:   *flusher-out*)
  393: 
  394: (define (char-list->port p chars)
  395:   (set! *flusher-out* '())
  396:   (for-each (lambda (c) (write-char c p)) chars)
  397:   (close-output-port p)
  398:   *flusher-out*)
  399: 
  400: (define (string-list->port p strs)
  401:   (set! *flusher-out* '())
  402:   (for-each (lambda (s) (display s p)) strs)
  403:   (close-output-port p)
  404:   *flusher-out*)
  405: 
  406: (test* "buffered port (putb, bufsiz=7)"
  407:        #*"@ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  408:        (byte-list->port (open-output-buffered-port flusher 7)
  409:                         (iota 27 #x40)))
  410: 
  411: (test* "buffered port (putb, bufsiz=30)"
  412:        #*"@ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  413:        (byte-list->port (open-output-buffered-port flusher 30)
  414:                         (iota 27 #x40)))
  415: 
  416: (test* "buffered port (putc, bufsiz=7)"
  417:        #*"??????????????????????????????"
  418:        (char-list->port (open-output-buffered-port flusher 7)
  419:                         '(#\?? #\?? #\?? #\?? #\?? #\?? #\?? #\?? #\?? #\??
  420:                           #\?? #\?? #\?? #\?? #\??)))
  421: 
  422: (test* "buffered port (putc, bufsiz=30)"
  423:        #*"??????????????????????????????"
  424:        (char-list->port (open-output-buffered-port flusher 30)
  425:                         '(#\?? #\?? #\?? #\?? #\?? #\?? #\?? #\?? #\?? #\??
  426:                           #\?? #\?? #\?? #\?? #\??)))
  427: 
  428: (test* "buffered port (puts, bufsiz=6)"
  429:        #*"??????????????????????????????"
  430:        (string-list->port (open-output-buffered-port flusher 6)
  431:                           '("??????" "??????" "??????" "??????" "??????")))
  432: 
  433: (test* "buffered port (puts, bufsiz=7)"
  434:        #*"??????????????????????????????"
  435:        (string-list->port (open-output-buffered-port flusher 7)
  436:                           '("??????" "??????" "??????" "??????" "??????")))
  437: 
  438: (test* "buffered port (puts, bufsiz=7)"
  439:        #*"??????????????????????????????"
  440:        (string-list->port (open-output-buffered-port flusher 7)
  441:                           '("??????????" "??????????" "????????" "??")))
  442: 
  443: (test* "buffered port (puts, bufsiz=3)"
  444:        #*"??????????????????????????????"
  445:        (string-list->port (open-output-buffered-port flusher 3)
  446:                           '("??????????" "??????????" "????????" "??")))
  447: 
  448: ;;-------------------------------------------------------------------
  449: (test-section "regexp")
  450: 
  451: (test* "regexp" "??a???"
  452:        (cond ((rxmatch #/([??-??-z])+/ "xy??a???d??)
  453:               => rxmatch-substring)
  454:              (else #f)))
  455: (test* "regexp" "??a???"
  456:        (cond ((rxmatch #/([??-??-z])+/i "XY??a???d??)
  457:               => rxmatch-substring)
  458:              (else #f)))
  459: 
  460: (test* "regexp" #f
  461:        (cond ((rxmatch #/(.*)a/ "??????")