suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

r6rs tests and bug fixes (including PR 9324)

Browse Source 
svn: r9534
This commit is contained in:
Matthew Flatt 2008-04-29 13:02:12 +00:00
parent 2662a36243
commit 94ccfc68c6
2 changed files with 98 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
collects/rnrs/io/ports-6.ss
View File

@ -944,6 +944,24 @@
[(eq? c #\newline) 2] [(eq? c #\newline) 2]
[(eq? c #\return) 2] [(eq? c #\return) 2]
[else 9])))] [else 9])))]
[(char? v)
(case v
[(#\x7) 7] ; #\alarm
[(#\x1B) 5] ; #\esc
[(#\x7F) 8] ; #\delete
[else (and (not (char-graphic? v))
(+ 3
(if ((char->integer v) . < . #x10000)
4
6)))])]
[(bytes? v) (+ 5
(sub1 (bytes-length v))
(for/fold ([len 0])
([b (in-bytes v)])
(+ len (cond
[(b . < . 10) 1]
[(b . < . 100) 2]
[else 3]))))]
[else #f]))] [else #f]))]
[pretty-print-print-hook [pretty-print-print-hook
(lambda (v write? p) (lambda (v write? p)
@ -963,7 +981,35 @@
(let ([s (format "00000~x" (char->integer c))]) (let ([s (format "00000~x" (char->integer c))])
(display (substring s (- (string-length s) 6)) p) (display (substring s (- (string-length s) 6)) p)
(write-char #\; p))])) (write-char #\; p))]))
(write-char #\" p)]))]) (write-char #\" p)]
[(char? v)
(case v
[(#\x7) (display "#\\alarm" p)]
[(#\x1B) (display "#\\esc" p)]
[(#\x7F) (display "#\\delete" p)]
[else
(display "#\\x" p)
(let ([n (number->string (char->integer v) 16)])
(display (make-string
(- (if ((string-length n) . <= . 4)
4
6)
(string-length n))
#\0)
p)
(display n p))])]
[(bytes? v)
(display "#vu8(" p)
(if (zero? (bytes-length v))
(display ")" p)
(begin
(display (bytes-ref v 0) p)
(for ([b (in-bytes v)]
[i (in-naturals)])
(unless (zero? i)
(display " " p)
(display b p)))
(display ")" p)))]))])
(pretty-print v port))) (pretty-print v port)))
;; ---------------------------------------- ;; ----------------------------------------

57
collects/tests/r6rs/io/ports.ss
View File

@ -98,6 +98,20 @@
(test (port-has-set-port-position!? p) #f) (test (port-has-set-port-position!? p) #f)
(test/unspec (close-port p))))])) (test/unspec (close-port p))))]))
(define-syntax test-rw
(syntax-rules ()
[(_ v)
(test (let ([p (open-string-input-port
(call-with-string-output-port
(lambda (p) (put-datum p v))))])
(dynamic-wind
(lambda () 'ok)
(lambda () (get-datum p))
(lambda () (close-port p))))
v)]))
;; ----------------------------------------
(define (run-io-ports-tests) (define (run-io-ports-tests)
(test (enum-set->list (file-options)) '()) (test (enum-set->list (file-options)) '())
@ -701,10 +715,41 @@
;; ---------------------------------------- ;; ----------------------------------------
(test-rw 10)
(test-rw 10.0)
(test-rw 1/2)
(test-rw 1+2i)
(test-rw 1+2.0i)
(test-rw #t)
(test-rw #f)
(test-rw "apple")
(test-rw "app\x3BB;e")
(test-rw "app\x1678;e")
(test-rw #\a)
(test-rw #\x3BB)
(test-rw #\nul)
(test-rw #\alarm)
(test-rw #\backspace)
(test-rw #\tab)
(test-rw #\linefeed)
(test-rw #\newline)
(test-rw #\vtab)
(test-rw #\page)
(test-rw #\return)
(test-rw #\esc)
(test-rw #\space)
(test-rw #\delete)
(test-rw #\xFF)
(test-rw #\x00006587)
(test-rw #\x10FFFF)
(test-rw #\x1678)
(test-rw #vu8())
(test-rw #vu8(1 2 3))
(test-rw '#(a))
(test-rw '#())
(test-rw '#(a 1/2 "str" #vu8(1 2 7)))
;; ----------------------------------------
;; ;;
) ))
(run-io-ports-tests)
(report-test-results)
)