1: ;; -*- coding: shift-jis -*-
    2: 
    3: ;; $Id: sjis.scm,v 1.10 2007/03/02 07:20:42 shirok Exp $
    4: 
    5: (use gauche.test)
    6: 
    7: (test-start "SJIS")
    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" "?ӂ??I?΂??I?΂?"
   47:        (string-join '("?ӂ?" "?΂?" "?΂?") "?I"))
   48: (test* "string-join" "?ӂ??????΂??????΂?"
   49:        (string-join '("?ӂ?" "?΂?" "?΂?") "????" 'infix))
   50: (test* "string-join" ""
   51:        (string-join '() "????"))
   52: (test* "string-join" "?ӂ??I?΂??I?΂??I"
   53:        (string-join '("?ӂ?" "?΂?" "?΂?") "?I" 'suffix))
   54: (test* "string-join" "?I?ӂ??I?΂??I?΂?"
   55:        (string-join '("?ӂ?" "?΂?" "?΂?") "?I" 'prefix))
   56: (test* "string-join" "?ӂ??I?΂??I?΂?"
   57:        (string-join '("?ӂ?" "?΂?" "?΂?") "?I" '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
   79:          (set! sp (make-string-pointer "??????o?ւ?))
   80:          (string-pointer? sp)))
   81: (test* "string-pointer-next!" #\??
   82:        (string-pointer-next! sp))
   83: (test* "string-pointer-next!" #\??      (string-pointer-next! sp))
   84: (test* "string-pointer-next!" #\??       (string-pointer-next! sp))
   85: (test* "string-pointer-next!" #\??       (string-pointer-next! sp))
   86: (test* "string-pointer-next!" #\h
   87:        (string-pointer-next! sp))
   88: (test* "string-pointer-next!" #\o
   89:        (string-pointer-next! sp))
   90: (test* "string-pointer-next!" #\??       (string-pointer-next! sp))
   91: (test* "string-pointer-prev!" #\??       (string-pointer-prev! sp))
   92: (test* "string-pointer-prev!" #\o
   93:        (string-pointer-prev! sp))
   94: (test* "string-pointer-prev!" #\h
   95:        (string-pointer-prev! sp))
   96: (test* "string-pointer-prev!" #\??       (string-pointer-prev! sp))
   97: (test* "string-pointer-prev!" #\??       (string-pointer-prev! sp))
   98: (test* "string-pointer-prev!" #\??      (string-pointer-prev! sp))
   99: (test* "string-pointer-prev!" #\??
  100:        (string-pointer-prev! sp))
  101: (test* "string-pointer-prev!" #t
  102:        (eof-object? (string-pointer-prev! sp)))
  103: (test* "string-pointer-index" 0
  104:        (string-pointer-index sp))
  105: (test* "string-pointer-index" 8
  106:        (do ((x (string-pointer-next! sp) (string-pointer-next! sp)))
  107:            ((eof-object? x) (string-pointer-index sp))))
  108: (test* "string-pointer-substring" '("??????o?ւ? "")
  109:        (list (string-pointer-substring sp)
  110:              (string-pointer-substring sp :after #t)))
  111: (test* "string-pointer-substring" '("??????" "o?ւ?)
  112:        (begin
  113:          (string-pointer-set! sp 5)
  114:          (list (string-pointer-substring sp)
  115:                (string-pointer-substring sp :after #t))))
  116: (test* "string-pointer-substring" '("" "??????o?ւ?)
  117:        (begin
  118:          (string-pointer-set! sp 0)
  119:          (list (string-pointer-substring sp)
  120:                (string-pointer-substring sp :after #t))))
  121: 
  122: ;;-------------------------------------------------------------------
  123: (test-section "incomplete strings")
  124: 
  125: (test* "string-length" 6 (string-length #*"??????"))
  126: (test* "string-complete->incomplete" #*"??????" 
  127:        (string-complete->incomplete "??????"))
  128: (test* "string-complete->incomplete" #*"??????"
  129:        (string-complete->incomplete #*"??????"))
  130: (test* "string-incomplete->complete" "??????"
  131:        (string-incomplete->complete #*"??????"))
  132: (test* "string-incomplete->complete" "??????"
  133:        (string-incomplete->complete "??????"))
  134: 
  135: (test* "string=?" #t (string=? #*"??????" #*"??????"))
  136: 
  137: (test* "string-byte-ref" #xa0 (string-byte-ref #*"??????" 1))
  138: 
  139: (test* "string-append" #*"??????????"
  140:        (string-append "??????" #*"????"))
  141: (test* "string-append" #*"??????????"
  142:        (string-append #*"??????" "????"))
  143: (test* "string-append" #*"??????????"
  144:        (string-append #*"??????" #*"????"))
  145: (test* "string-append" 10
  146:        (string-length (string-append "??????" "????" #*"")))
  147: 
  148: (test* "string-incomplete->complete" "??"
  149:        (string-incomplete->complete (string-append #*"\x82" #*"\xa0")))
  150: 
  151: ;;-------------------------------------------------------------------
  152: (test-section "format")
  153: 
  154: (test* "format" "???Ԃ?       (format #f "~,,,,3a" "???Ԃ炩???Ԃ?)
  155: (test* "format" "ab??       (format #f "~,,,,3a" "ab?炩???Ԃ?)
  156: (test* "format" "???Ԃ炩???Ԃ?       (format #f "~,,,,7:a" "???Ԃ炩???Ԃ?)
  157: (test* "format" "???Ԃ炩"
  158:        (format #f "~,,,,7:a" "???Ԃ炩"))
  159: (test* "format" "???Ԃ?.."
  160:        (format #f "~,,,,7:a" "???Ԃ炩???Ԃ?????)
  161: 
  162: ;;-------------------------------------------------------------------
  163: (test-section "string-library")
  164: (use srfi-13)
  165: 
  166: (test* "string-every" #t (string-every #\?? ""))
  167: (test* "string-every" #t (string-every #\?? "????????"))
  168: (test* "string-every" #f (string-every #\?? "??????a"))
  169: (test* "string-every" #t (string-every #[??-??????????"))
  170: (test* "string-every" #f (string-every #[??-??????a??"))
  171: (test* "string-every" #t (string-every #[??-??"))
  172: (test* "string-every" #t (string-every (lambda (x) (char-ci=? x #\??)) "????????"))
  173: (test* "string-every" #f (string-every (lambda (x) (char-ci=? x #\??)) "????????"))
  174: 
  175: (test* "string-any" #t (string-any #\?? "????????"))
  176: (test* "string-any" #f (string-any #\?? "????????"))
  177: (test* "string-any" #f (string-any #\?? ""))
  178: (test* "string-any" #t (string-any #[??-???????[??))
  179: (test* "string-any" #f (string-any #[??-???X?L?[??"))
  180: (test* "string-any" #f (string-any #[??-??"))
  181: (test* "string-any" #t (string-any (lambda (x) (char-ci=? x #\??)) "???炠"))
  182: (test* "string-any" #f (string-any (lambda (x) (char-ci=? x #\??)) "???????A"))
  183: (test* "string-tabulate" "?A?B?C?D?E"
  184:        (string-tabulate (lambda (code)
  185:                           (integer->char (+ code
  186:                                             (char->integer #\?A))))
  187:                         5))
  188: (test* "reverse-list->string" "???       (reverse-list->string '(#\??\????
  189: (test* "string-copy!" "ab??????fg"
  190:        (let ((x (string-copy "abcdefg")))
  191:          (string-copy! x 2 "????????????" 2 5)
  192:          x))
  193: (test* "string-take" "????????"  (string-take "????????????" 4))
  194: (test* "string-drop" "????"  (string-drop "????????????" 4))
  195: (test* "string-take-right" "????????"  (string-take-right "????????????" 4))
  196: (test* "string-drop-right" "????"  (string-drop-right "????????????" 4))
  197: (test* "string-pad" "?????p?b?h" (string-pad "?p?b?h" 5 #\??))
  198: (test* "string-pad" "?p?f?B???O" (string-pad "?p?f?B???O" 5 #\??))
  199: (test* "string-pad" "?f?B???O?X" (string-pad "?p?f?B???O?X" 5 #\??))
  200: (test* "string-pad-right" "?p?b?h????" (string-pad-right "?p?b?h" 5 #\??))
  201: (test* "string-pad" "?p?f?B???O" (string-pad-right "?p?f?B???O?X" 5 #\??))
  202: 
  203: ;;-------------------------------------------------------------------
  204: (test-section "char set")
  205: 
  206: (use srfi-14)
  207: 
  208: (test* "char-set=" #t
  209:        (char-set= (char-set #\?? #\?? #\?? #\?? #\??)
  210:                   (string->char-set "??????????")))
  211: (test* "char-set=" #t
  212:        (char-set= (list->char-set '(#\?? #\?? #\?? #\??                  (string->char-set "?????????????")))
  213: (test* "char-set=" #t
  214:        (char-set= (->char-set "??????????????????")
  215:                   (integer-range->char-set (char->integer #\??)
  216:                                            (char->integer #\??))))
  217: 
  218: (test* "char-set" #t
  219:        (char-set<= (list->char-set '(#\??#\??))
  220:                    char-set:full))
  221: (test* "char-set<=" #t (char-set<= #[????] #[????]))
  222: (test* "char-set<=" #t (char-set<= #[????] #[??-??]))
  223: (test* "char-set<=" #f (char-set<= #[??-??] #[????]))
  224: (test* "char-set<=" #t (char-set<= #[??-????-??] #[??-??]))
  225: (test* "char-set<=" #f (char-set<= #[??-??] #[??-????-??]))
  226: (test* "char-set<=" #f (char-set<= #[??-????-??] #[??-??]))
  227: (test* "char-set<=" #f (char-set<= #[??-????-??] #[??-??]))
  228: (test* "char-set<=" #t (char-set<= #[??-????-??] #[??-????-??]))
  229: (test* "char-set<=" #t (char-set<= #[??-????-??] #[??-????-??]))
  230: (test* "char-set<=" #t (char-set<= #[??-????-??] #[??-????-??]))
  231: (test* "char-set<=" #t (char-set<= #[??-??] #[??-????-??]))
  232: (test* "char-set<=" #t (char-set<= #[??-????-??] #[??-????-??]))
  233: (test* "char-set<=" #f (char-set<= #[??-??] #[??-????-??]))
  234: 
  235: ;;-------------------------------------------------------------------
  236: (test-section "ports")
  237: 
  238: ;; ?C???n?j?z?w?g : 8343.838d.836e.836a.837a.8377.8367
  239: (define istr (open-input-string "?C???n?j?z?w?g"))
  240: (test* "read-char" #\?C (read-char istr))
  241: (test* "read-byte" #x83 (read-byte istr))
  242: (test* "read-byte (using scratch)" #x8d
  243:        (begin (peek-char istr) (read-byte istr)))
  244: (test* "read-char (using scratch)" #\?n
  245:        (read-char istr))
  246: (test* "read-block (using scratch)" #*"?j"
  247:        (begin (peek-char istr) (read-block 2 istr)))
  248: (test* "read-block (using scratch)" #*"\x83"
  249:        (begin (peek-char istr) (read-block 1 istr)))
  250: (test* "read-block (using scratch)" #*"\x7a?w?g"
  251:        (begin (peek-char istr) (read-block 10 istr)))
  252: 
  253: ;; start over
  254: (set! istr (open-input-string "?C???n?j?z?w?g"))
  255: (test* "peek-byte" #x83 (peek-byte istr))
  256: (test* "peek-char" #\?C (peek-char istr))
  257: (test* "read-byte" #x83 (read-byte istr))
  258: (test* "peek-byte" #x43 (peek-byte istr))
  259: (test* "peek-char" #\?? (begin (read-byte istr) (peek-char istr)))
  260: (test* "read-char" #\?? (begin (peek-byte istr) (read-char istr)))
  261: (test* "peek-byte" #x6e
  262:        (begin (peek-char istr) (read-byte istr) (peek-byte istr)))
  263: (test* "read-block" #*"\x6e?j?z?w\x83" (read-block 8 istr))
  264: (test* "peek-byte" #x67 (peek-byte istr))
  265: (test* "peek-byte" #t (begin (read-byte istr) (eof-object? (peek-byte istr))))
  266: 
  267: (test* "read-line (LF)" "?Ȃ?
  268:        (read-line (open-input-string "?Ȃ?n")))
  269: (test* "read-line (CR)" "?Ȃ?
  270:        (read-line (open-input-string "?Ȃ?r")))
  271: (test* "read-line (CRLF)" "?Ȃ?
  272:        (read-line (open-input-string "?Ȃ?r\n")))
  273: (test* "read-line (using ungotten)" "?Ȃ?
  274:        (let1 s (open-input-string "?Ȃ?n")
  275:          (peek-char s) (read-line s)))
  276: 
  277: ;;-------------------------------------------------------------------
  278: (test-section "buffered ports")
  279: 
  280: (define (make-filler)
  281:   (let* ((str #*"????????????????????")  ;incomplete string
  282:          (len (string-size str))
  283:          (ind 0))
  284:     (lambda (siz)
  285:       (cond ((>= ind len) #f)
  286:             ((>= (+ ind siz) len)
  287:              (let ((r (substring str ind len)))
  288:                (set! ind len)
  289:                r))
  290:             (else
  291:              (let ((r (substring str ind (+ ind siz))))
  292:                (set! ind (+ ind siz))
  293:                r))))))
  294: 
  295: (define (port->char-list p)
  296:   (let loop ((c (read-char p)) (r '()))
  297:     (if (eof-object? c) (reverse r) (loop (read-char p) (cons c r)))))
  298: 
  299: (define (port->byte-list p)
  300:   (let loop ((b (read-byte p)) (r '()))
  301:     (if (eof-object? b) (reverse r) (loop (read-byte p) (cons b r)))))
  302: 
  303: (define (port->chunk-list p siz)
  304:   (let loop ((b (read-block siz p)) (r '()))
  305:     (if (eof-object? b) (reverse r) (loop (read-block siz p) (cons b r)))))
  306: 
  307: (test* "buffered port (getc, bufsiz=256)"
  308:        '(#\?? #\?? #\?? #\?? #\?? #\?? #\?? #\?? #\?? #\??)
  309:        (port->char-list (open-input-buffered-port (make-filler) 256)))
  310: 
  311: (test* "buffered port (getc, bufsiz=7)"
  312:        '(#\?? #\?? #\?? #\?? #\?? #\?? #\?? #\?? #\?? #\??)
  313:        (port->char-list (open-input-buffered-port (make-filler) 7)))
  314: 
  315: (test* "buffered port (getc, bufsiz=3)"
  316:        '(#\?? #\?? #\?? #\?? #\?? #\?? #\?? #\?? #\?? #\??)
  317:        (port->char-list (open-input-buffered-port (make-filler) 3)))
  318: 
  319: (test* "buffered port (getc, bufsiz=2)"
  320:        '(#\?? #\?? #\?? #\?? #\?? #\?? #\?? #\?? #\?? #\??)
  321:        (port->char-list (open-input-buffered-port (make-filler) 2)))
  322: 
  323: (test* "buffered port (getc, bufsiz=1)"
  324:        '(#\?? #\?? #\?? #\?? #\?? #\?? #\?? #\?? #\?? #\??)
  325:        (port->char-list (open-input-buffered-port (make-filler) 1)))
  326: 
  327: (test* "buffered port (getb, bufsiz=256)"
  328:        '(#x82 #xa0 #x82 #xa2 #x82 #xa4 #x82 #xa6 #x82 #xa8
  329:               #x82 #xa9 #x82 #xab #x82 #xad #x82 #xaf #x82 #xb1)
  330:        (port->byte-list (open-input-buffered-port (make-filler) 256)))
  331: 
  332: (test* "buffered port (getb, bufsiz=20)"
  333:        '(#x82 #xa0 #x82 #xa2 #x82 #xa4 #x82 #xa6 #x82 #xa8
  334:               #x82 #xa9 #x82 #xab #x82 #xad #x82 #xaf #x82 #xb1)
  335:        (port->byte-list (open-input-buffered-port (make-filler) 20)))
  336: 
  337: (test* "buffered port (getb, bufsiz=19)"
  338:        '(#x82 #xa0 #x82 #xa2 #x82 #xa4 #x82 #xa6 #x82 #xa8
  339:               #x82 #xa9 #x82 #xab #x82 #xad #x82 #xaf #x82 #xb1)
  340:        (port->byte-list (open-input-buffered-port (make-filler) 19)))
  341: 
  342: (test* "buffered port (getb, bufsiz=2)"
  343:        '(#x82 #xa0 #x82 #xa2 #x82 #xa4 #x82 #xa6 #x82 #xa8
  344:               #x82 #xa9 #x82 #xab #x82 #xad #x82 #xaf #x82 #xb1)
  345:        (port->byte-list (open-input-buffered-port (make-filler) 2)))
  346: 
  347: (test* "buffered port (getb, bufsiz=1)"
  348:        '(#x82 #xa0 #x82 #xa2 #x82 #xa4 #x82 #xa6 #x82 #xa8
  349:               #x82 #xa9 #x82 #xab #x82 #xad #x82 #xaf #x82 #xb1)
  350:        (port->byte-list (open-input-buffered-port (make-filler) 1)))
  351: 
  352: (test* "buffered port (getz, siz=20,5)"
  353:        '(#*"\x82\xa0\x82\xa2\x82" #*"\xa4\x82\xa6\x82\xa8"
  354:            #*"\x82\xa9\x82\xab\x82" #*"\xad\x82\xaf\x82\xb1")
  355:        (port->chunk-list (open-input-buffered-port (make-filler) 20) 5))
  356: 
  357: (test* "buffered port (getz, siz=20,20)"
  358:        '(#*"\x82\xa0\x82\xa2\x82\xa4\x82\xa6\x82\xa8\x82\xa9\x82\xab\x82\xad\x82\xaf\x82\xb1")
  359:        (port->chunk-list (open-input-buffered-port (make-filler) 20) 20))
  360: 
  361: (test* "buffered port (getz, siz=9,20)"
  362:        '(#*"\x82\xa0\x82\xa2\x82\xa4\x82\xa6\x82\xa8\x82\xa9\x82\xab\x82\xad\x82\xaf\x82\xb1")
  363:        (port->chunk-list (open-input-buffered-port (make-filler) 9) 20))
  364: 
  365: (test* "buffered port (getz, siz=9,7)"
  366:        '(#*"\x82\xa0\x82\xa2\x82\xa4\x82" #*"\xa6\x82\xa8\x82\xa9\x82\xab"
  367:            #*"\x82\xad\x82\xaf\x82\xb1")
  368:        (port->chunk-list (open-input-buffered-port (make-filler) 9) 7))
  369: 
  370: (test* "buffered port (getz, siz=3,50)"
  371:        '(#*"\x82\xa0\x82\xa2\x82\xa4\x82\xa6\x82\xa8\x82\xa9\x82\xab\x82\xad\x82\xaf\x82\xb1")
  372:        (port->chunk-list (open-input-buffered-port (make-filler) 3) 50))
  373: 
  374: (test* "buffered port (getz, siz=2,7)"
  375:        '(#*"\x82\xa0\x82\xa2\x82\xa4\x82" #*"\xa6\x82\xa8\x82\xa9\x82\xab"
  376:            #*"\x82\xad\x82\xaf\x82\xb1")
  377:        (port->chunk-list (open-input-buffered-port (make-filler) 2) 7))
  378: 
  379: (test* "buffered port (getz, siz=1,7)"
  380:        '(#*"\x82\xa0\x82\xa2\x82\xa4\x82" #*"\xa6\x82\xa8\x82\xa9\x82\xab"
  381:            #*"\x82\xad\x82\xaf\x82\xb1")
  382:        (port->chunk-list (open-input-buffered-port (make-filler) 1) 7))
  383: 
  384: (define *flusher-out* '())
  385: 
  386: (define (flusher str)
  387:   (if str
  388:       (set! *flusher-out* (cons str *flusher-out*))
  389:       (set! *flusher-out* (string-concatenate-reverse *flusher-out*))))
  390: 
  391: (define (byte-list->port p bytes)
  392:   (set! *flusher-out* '())
  393:   (for-each (lambda (b) (write-byte b p)) bytes)
  394:   (close-output-port p)
  395:   *flusher-out*)
  396: 
  397: (define (char-list->port p chars)
  398:   (set! *flusher-out* '())
  399:   (for-each (lambda (c) (write-char c p)) chars)
  400:   (close-output-port p)
  401:   *flusher-out*)
  402: 
  403: (define (string-list->port p strs)
  404:   (set! *flusher-out* '())
  405:   (for-each (lambda (s) (display s p)) strs)
  406:   (close-output-port p)
  407:   *flusher-out*)
  408: 
  409: (test* "buffered port (putb, bufsiz=7)"
  410:        #*"@ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  411:        (byte-list->port (open-output-buffered-port flusher 7)
  412:                         (iota 27 #x40)))
  413: 
  414: (test* "buffered port (putb, bufsiz=30)"
  415:        #*"@ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  416:        (byte-list->port (open-output-buffered-port flusher 30)
  417:                         (iota 27 #x40)))
  418: 
  419: (test* "buffered port (putc, bufsiz=7)"
  420:        #*"??????????????????????????????"
  421:        (char-list->port (open-output-buffered-port flusher 7)
  422:                         '(#\?? #\?? #\?? #\?? #\?? #\?? #\?? #\?? #\?? #\??
  423:                           #\?? #\?? #\?? #\?? #\??)))
  424: 
  425: (test* "buffered port (putc, bufsiz=30)"
  426:        #*"??????????????????????????????"
  427:        (char-list->port (open-output-buffered-port flusher 30)
  428:                         '(#\?? #\?? #\?? #\?? #\?? #\?? #\?? #\?? #\?? #\??
  429:                           #\?? #\?? #\?? #\?? #\??)))
  430: 
  431: (test* "buffered port (puts, bufsiz=6)"
  432:        #*"??????????????????????????????"
  433:        (string-list->port (open-output-buffered-port flusher 6)
  434:                           '("??????" "??????" "??????" "??????" "??????")))
  435: 
  436: (test* "buffered port (puts, bufsiz=7)"
  437:        #*"??????????????????????????????"
  438:        (string-list->port (open-output-buffered-port flusher 7)
  439:                           '("??????" "??????" "??????" "??????" "??????")))
  440: 
  441: (test* "buffered port (puts, bufsiz=7)"
  442:        #*"??????????????????????????????"
  443:        (string-list->port (open-output-buffered-port flusher 7)
  444:                           '("??????????" "??????????" "????????" "??")))
  445: 
  446: (test* "buffered port (puts, bufsiz=3)"
  447:        #*"??????????????????????????????"
  448:        (string-list->port (open-output-buffered-port flusher 3)
  449:                           '("??????????" "??????????" "????????" "??")))
  450: 
  451: ;;-------------------------------------------------------------------
  452: (test-section "regexp")
  453: 
  454: (test* "regexp" "??a???"
  455:        (cond ((rxmatch #/([??-??-z])+/ "xy??a???d??)
  456:               => rxmatch-substring)
  457:              (else #f)))
  458: (test* "regexp" "??a???"
  459:        (cond ((rxmatch #/([??-??-z])+/i "XY??a???d??)
  460:               => rxmatch-substring)
  461:              (else #f)))
  462: 
  463: (test* "regexp" #f
  464:        (cond ((rxmatch #/(.*)a/ "??????")
  465:               => rxmatch-substring)
  466:              (else #f)))
  467: 
  468: (test* "regexp" "????a"