summaryrefslogtreecommitdiff
path: root/src/ChezScheme/mats/io.ms
diff options
context:
space:
mode:
Diffstat (limited to 'src/ChezScheme/mats/io.ms')
-rw-r--r--src/ChezScheme/mats/io.ms88
1 files changed, 45 insertions, 43 deletions
diff --git a/src/ChezScheme/mats/io.ms b/src/ChezScheme/mats/io.ms
index f7fa30ad94..10e9af3883 100644
--- a/src/ChezScheme/mats/io.ms
+++ b/src/ChezScheme/mats/io.ms
@@ -20,6 +20,8 @@
; are enabled in io.ss
(define (custom-port-warning? x) #t)
+(define prettytest.ss (format "~a/prettytest.ss" *mats-dir*))
+
(mat port-operations
(error? (close-port cons))
; the following several clauses test various open-file-output-port options
@@ -510,12 +512,12 @@
(not (file-port? (open-input-string "hello")))
(or (threaded?) (= (port-file-descriptor (console-input-port)) 0))
(or (threaded?) (= (port-file-descriptor (console-output-port)) 1))
- (> (let ([ip (open-input-file "mat.ss")])
+ (> (let ([ip (open-input-file prettytest.ss)])
(let ([n (and (file-port? ip) (port-file-descriptor ip))])
(close-port ip)
n))
1)
- (> (let ([ip (open-input-file "mat.ss" 'compressed)])
+ (> (let ([ip (open-input-file prettytest.ss 'compressed)])
(let ([n (and (file-port? ip) (port-file-descriptor ip))])
(close-port ip)
n))
@@ -2111,7 +2113,7 @@
(error? (file-buffer-size (+ (most-positive-fixnum) 1)))
(error? (file-buffer-size 1024.0))
(parameterize ([file-buffer-size (* (file-buffer-size) 2)])
- (let ([ip (open-file-input-port "prettytest.ss")])
+ (let ([ip (open-file-input-port prettytest.ss)])
(let ([n (bytevector-length (binary-port-input-buffer ip))])
(close-input-port ip)
(eqv? n (file-buffer-size)))))
@@ -2162,11 +2164,11 @@
(lambda (op) (put-bytevector op (get-bytevector-all ip))))))
(fnlength ofn))
(define (compress-file-test fmt)
- (let ([orig (fnlength "prettytest.ss")]
- [low (compress-file "prettytest.ss" "testfile.ss" fmt 'low)]
- [medium (compress-file "prettytest.ss" "testfile.ss" fmt 'medium)]
- [high (compress-file "prettytest.ss" "testfile.ss" fmt 'high)]
- [maximum (compress-file "prettytest.ss" "testfile.ss" fmt 'maximum)])
+ (let ([orig (fnlength prettytest.ss)]
+ [low (compress-file prettytest.ss "testfile.ss" fmt 'low)]
+ [medium (compress-file prettytest.ss "testfile.ss" fmt 'medium)]
+ [high (compress-file prettytest.ss "testfile.ss" fmt 'high)]
+ [maximum (compress-file prettytest.ss "testfile.ss" fmt 'maximum)])
(define-syntax test1
(syntax-rules ()
[(_ level)
@@ -2229,28 +2231,28 @@
(test (+ 1 i)))))
(loop))))))))))))
(and
- (cmp (open-file-input-port "prettytest.ss")
- (open-file-input-port "prettytest.ss"))
- (cmp (open-file-input-port "prettytest.ss" (file-options compressed))
- (open-file-input-port "prettytest.ss"))
- (cmp (open-file-input-port "prettytest.ss")
- (open-file-input-port "prettytest.ss" (file-options compressed)))
- (cmp (open-file-input-port "prettytest.ss" (file-options compressed))
- (open-file-input-port "prettytest.ss" (file-options compressed)))
+ (cmp (open-file-input-port prettytest.ss)
+ (open-file-input-port prettytest.ss))
+ (cmp (open-file-input-port prettytest.ss (file-options compressed))
+ (open-file-input-port prettytest.ss))
+ (cmp (open-file-input-port prettytest.ss)
+ (open-file-input-port prettytest.ss (file-options compressed)))
+ (cmp (open-file-input-port prettytest.ss (file-options compressed))
+ (open-file-input-port prettytest.ss (file-options compressed)))
(begin
- (cp (open-file-input-port "prettytest.ss")
+ (cp (open-file-input-port prettytest.ss)
(open-file-output-port "testfile.ss" (file-options replace compressed)))
#t)
(cmp (open-file-input-port "testfile.ss" (file-options compressed))
- (open-file-input-port "prettytest.ss"))
+ (open-file-input-port prettytest.ss))
(not (cmp (open-file-input-port "testfile.ss")
- (open-file-input-port "prettytest.ss")))
+ (open-file-input-port prettytest.ss)))
(begin
- (cp (open-file-input-port "prettytest.ss")
+ (cp (open-file-input-port prettytest.ss)
(open-file-output-port "testfile.ss" (file-options no-fail no-truncate append compressed)))
#t)
(not (cmp (open-file-input-port "testfile.ss" (file-options compressed))
- (open-file-input-port "prettytest.ss")))))
+ (open-file-input-port prettytest.ss)))))
; test workaround for bogus gzclose error return for empty input files
(and
(eqv? (call-with-port
@@ -3186,24 +3188,24 @@
(if compressed? (file-options compressed replace) (file-options replace))
(buffer-mode block)
(make-transcoder codec)))
- (time (cmp (in "prettytest.ss" #f (latin-1-codec)) (in "prettytest.ss" #f (latin-1-codec))))
- (time (cmp (in "prettytest.ss" #t (latin-1-codec)) (in "prettytest.ss" #f (latin-1-codec))))
- (time (cmp (in "prettytest.ss" #f (latin-1-codec)) (in "prettytest.ss" #t (latin-1-codec))))
- (time (cmp (in "prettytest.ss" #t (latin-1-codec)) (in "prettytest.ss" #t (latin-1-codec))))
- (time (cmp (in "prettytest.ss" #f (utf-8-codec)) (in "prettytest.ss" #f (utf-8-codec))))
- (time (cmp (in "prettytest.ss" #t (utf-8-codec)) (in "prettytest.ss" #f (utf-8-codec))))
- (time (cmp (in "prettytest.ss" #f (utf-8-codec)) (in "prettytest.ss" #t (utf-8-codec))))
- (time (cmp (in "prettytest.ss" #t (utf-8-codec)) (in "prettytest.ss" #t (utf-8-codec))))
- (cp (in "prettytest.ss" #f (latin-1-codec)) (out "testfile.ss" #t (latin-1-codec)))
- (cmp (in "prettytest.ss" #f (latin-1-codec)) (in "testfile.ss" #t (latin-1-codec)))
- (cmp (in "prettytest.ss" #t (latin-1-codec)) (in "testfile.ss" #t (latin-1-codec)))
- (cmp (in "prettytest.ss" #f (utf-8-codec)) (in "testfile.ss" #t (utf-8-codec)))
- (cmp (in "prettytest.ss" #t (utf-8-codec)) (in "testfile.ss" #t (utf-8-codec)))
- (cp (in "prettytest.ss" #f (utf-8-codec)) (out "testfile.ss" #t (utf-8-codec)))
- (cmp (in "prettytest.ss" #f (latin-1-codec)) (in "testfile.ss" #t (latin-1-codec)))
- (cmp (in "prettytest.ss" #t (latin-1-codec)) (in "testfile.ss" #t (latin-1-codec)))
- (cmp (in "prettytest.ss" #f (utf-8-codec)) (in "testfile.ss" #t (utf-8-codec)))
- (cmp (in "prettytest.ss" #t (utf-8-codec)) (in "testfile.ss" #t (utf-8-codec)))
+ (time (cmp (in prettytest.ss #f (latin-1-codec)) (in prettytest.ss #f (latin-1-codec))))
+ (time (cmp (in prettytest.ss #t (latin-1-codec)) (in prettytest.ss #f (latin-1-codec))))
+ (time (cmp (in prettytest.ss #f (latin-1-codec)) (in prettytest.ss #t (latin-1-codec))))
+ (time (cmp (in prettytest.ss #t (latin-1-codec)) (in prettytest.ss #t (latin-1-codec))))
+ (time (cmp (in prettytest.ss #f (utf-8-codec)) (in prettytest.ss #f (utf-8-codec))))
+ (time (cmp (in prettytest.ss #t (utf-8-codec)) (in prettytest.ss #f (utf-8-codec))))
+ (time (cmp (in prettytest.ss #f (utf-8-codec)) (in prettytest.ss #t (utf-8-codec))))
+ (time (cmp (in prettytest.ss #t (utf-8-codec)) (in prettytest.ss #t (utf-8-codec))))
+ (cp (in prettytest.ss #f (latin-1-codec)) (out "testfile.ss" #t (latin-1-codec)))
+ (cmp (in prettytest.ss #f (latin-1-codec)) (in "testfile.ss" #t (latin-1-codec)))
+ (cmp (in prettytest.ss #t (latin-1-codec)) (in "testfile.ss" #t (latin-1-codec)))
+ (cmp (in prettytest.ss #f (utf-8-codec)) (in "testfile.ss" #t (utf-8-codec)))
+ (cmp (in prettytest.ss #t (utf-8-codec)) (in "testfile.ss" #t (utf-8-codec)))
+ (cp (in prettytest.ss #f (utf-8-codec)) (out "testfile.ss" #t (utf-8-codec)))
+ (cmp (in prettytest.ss #f (latin-1-codec)) (in "testfile.ss" #t (latin-1-codec)))
+ (cmp (in prettytest.ss #t (latin-1-codec)) (in "testfile.ss" #t (latin-1-codec)))
+ (cmp (in prettytest.ss #f (utf-8-codec)) (in "testfile.ss" #t (utf-8-codec)))
+ (cmp (in prettytest.ss #t (utf-8-codec)) (in "testfile.ss" #t (utf-8-codec)))
#t)
; test workaround for bogus gzclose error return for empty input files
(and
@@ -3222,7 +3224,7 @@
(let ()
(define pretty-test-string
(call-with-port
- (open-file-input-port "prettytest.ss"
+ (open-file-input-port prettytest.ss
(file-options) (buffer-mode none) (native-transcoder))
get-string-all))
(define cp ; doesn't close the ports
@@ -3269,11 +3271,11 @@
(if compressed? (file-options compressed replace) (file-options replace))
(buffer-mode block)
(make-transcoder codec)))
- (time (cmp (in "prettytest.ss" #f (latin-1-codec)) (open-string-input-port pretty-test-string)))
- (time (cmp (open-string-input-port pretty-test-string) (in "prettytest.ss" #f (latin-1-codec))))
+ (time (cmp (in prettytest.ss #f (latin-1-codec)) (open-string-input-port pretty-test-string)))
+ (time (cmp (open-string-input-port pretty-test-string) (in prettytest.ss #f (latin-1-codec))))
(let-values ([(op retrieve) (open-string-output-port)])
(cp (open-string-input-port pretty-test-string) op)
- (cmp (in "prettytest.ss" #f (latin-1-codec)) (open-string-input-port (retrieve))))
+ (cmp (in prettytest.ss #f (latin-1-codec)) (open-string-input-port (retrieve))))
#t)
)
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-05 22:06:00 +0000