b4d452cc71
sizes of pathnames produced by expansion of tilde (home-directory)
prefixes by replacing S_pathname, S_pathname_impl, and S_homedir
with S_malloc_pathname, which always mallocs space for the result.
one thread-safety issue involved the use of static strings for expanded
pathnames and affected various file-system operations. the other
affected the file open routines and involved use of the incoming
pathname while deactivated. the incoming pathname is sometimes if not
always a pointer into a Scheme bytevector, which can be overwritten if a
collection occurs while the thread is deactivated. the size limitation
corresponded to the use of the static strings, which were limited to
PATH_MAX bytes. (PATH_MAX typically isn't actually the maximum path
length in contemporary operating systems.) eliminated similar issues
for wide pathnames under Windows by adding S_malloc_wide_pathname.
consumers of the old routines have been modified to use the new
routines and to free the result strings. the various file operations
now consistently treat a pathname with an unresolvable home directory
as a pathname that happens to start with a tilde. eliminated unused
foreign-symbol binding of "(cs)pathname" to S_pathname.
io.c, externs.h, new_io.c, prim5.c, scheme.c, prim.c
- various places where a call to close or gzclose was retried when
the close operation was interrupted no longer do so, since this can
cause problems when another thread has reallocated the same file
descriptor.
new_io.c
- now using vcvarsall type x86_amd64 rather than amd64 when the
former appears to supported and the latter does not, as is the
case with VS Express 2015.
c/Mf-a6nt, c/Mf-ta6nt
- commented out one of the thread mats that consistently causes
indefinite delays under Windows and OpenBSD due to starvation.
thread.ms
- increased wait time for a couple of subprocess responses
6.ms
- added call to collector to close files opened during iconv mats
specifically for when mats are run under Windows with no iconv dll.
io.ms
original commit: ad44924307c576eb2fc92e7958afe8b615a7f48b
3478 lines
176 KiB
Scheme
3478 lines
176 KiB
Scheme
;;; 6.ms
|
||
;;; Copyright 1984-2016 Cisco Systems, Inc.
|
||
;;;
|
||
;;; Licensed under the Apache License, Version 2.0 (the "License");
|
||
;;; you may not use this file except in compliance with the License.
|
||
;;; You may obtain a copy of the License at
|
||
;;;
|
||
;;; http://www.apache.org/licenses/LICENSE-2.0
|
||
;;;
|
||
;;; Unless required by applicable law or agreed to in writing, software
|
||
;;; distributed under the License is distributed on an "AS IS" BASIS,
|
||
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||
;;; See the License for the specific language governing permissions and
|
||
;;; limitations under the License.
|
||
|
||
;;; sections 6-1 and 6-2:
|
||
|
||
(mat current-input-port
|
||
(port? (current-input-port))
|
||
(input-port? (current-input-port))
|
||
(eq? (current-input-port) (console-input-port))
|
||
)
|
||
|
||
(mat current-output-port
|
||
(port? (current-output-port))
|
||
(output-port? (current-output-port))
|
||
(eq? (current-output-port) (console-output-port))
|
||
)
|
||
|
||
(mat port-operations
|
||
(error? (open-input-file "nonexistent file"))
|
||
(error? (open-input-file "nonexistent file" 'compressed))
|
||
(error? (open-output-file "/nonexistent/directory/nonexistent/file"))
|
||
(error? (open-output-file "/nonexistent/directory/nonexistent/file" 'replace))
|
||
(error? (open-input-output-file "/nonexistent/directory/nonexistent/file"))
|
||
(error? (open-input-output-file "/nonexistent/directory/nonexistent/file" 'truncate))
|
||
; the following several clauses test various open-output-file options
|
||
(let ([p (open-output-file "testfile.ss" 'truncate)])
|
||
(and (port? p) (output-port? p) (begin (close-output-port p) #t)))
|
||
(error? (open-output-file "testfile.ss"))
|
||
(error? (open-output-file "testfile.ss" 'error))
|
||
(let ([p (open-output-file "testfile.ss" 'replace)])
|
||
(and (port? p) (output-port? p) (begin (close-output-port p) #t)))
|
||
(let ([p (open-output-file "testfile.ss" 'truncate)])
|
||
(and (port? p) (output-port? p) (begin (close-output-port p) #t)))
|
||
(let ([p (open-output-file "testfile.ss" 'truncate)])
|
||
(display "\"hello" p)
|
||
(close-output-port p)
|
||
(let ([p (open-output-file "testfile.ss" 'append)])
|
||
(display " there\"" p)
|
||
(close-output-port p)
|
||
(let ([p (open-input-file "testfile.ss")])
|
||
(and (equal? (read p) "hello there")
|
||
(eof-object? (read p))
|
||
(begin (close-input-port p) #t)))))
|
||
; the following tests open-output-file, close-output-port, write,
|
||
; display, and newline---and builds testfile.ss for the next test
|
||
(let ([p (let loop () (if (file-exists? "testfile.ss")
|
||
(begin (delete-file "testfile.ss" #f) (loop))
|
||
(open-output-file "testfile.ss")))])
|
||
(for-each (lambda (x) (write x p) (display " " p))
|
||
'(a b c d e))
|
||
(newline p)
|
||
(close-output-port p)
|
||
#t)
|
||
; the following tests open-input-file, close-input-port, read,
|
||
; and eof-object?
|
||
(equal? (let ([p (open-input-file "testfile.ss")])
|
||
(let f ([x (read p)])
|
||
(if (eof-object? x)
|
||
(begin (close-input-port p) '())
|
||
(cons x (f (read p))))))
|
||
'(a b c d e))
|
||
; the following tests with-output-to-file, close-port,
|
||
; and write-char---and builds testfile.ss for the next test
|
||
(equal? (call-with-values
|
||
(lambda ()
|
||
(with-output-to-file "testfile.ss"
|
||
(lambda ()
|
||
(for-each (lambda (c) (write-char c))
|
||
(string->list "a b c d e"))
|
||
(values 1 2 3))
|
||
'replace))
|
||
list)
|
||
'(1 2 3))
|
||
; the following tests with-input-from-file, close-port,
|
||
; read-char, unread-char, and eof-object?
|
||
(equal? (with-input-from-file "testfile.ss"
|
||
(lambda ()
|
||
(list->string
|
||
(let f ()
|
||
(let ([c (read-char)])
|
||
(if (eof-object? c)
|
||
'()
|
||
(begin (unread-char c)
|
||
(let ([c (read-char)])
|
||
(cons c (f))))))))))
|
||
"a b c d e")
|
||
; the following tests call-with-output-file, close-port,
|
||
; and write-char---and builds testfile.ss for the next test
|
||
(equal? (call-with-values
|
||
(lambda ()
|
||
(call-with-output-file "testfile.ss"
|
||
(lambda (p)
|
||
(for-each (lambda (c) (write-char c p))
|
||
(string->list "a b c d e"))
|
||
(close-port p)
|
||
(values 1 2 3))
|
||
'replace))
|
||
list)
|
||
'(1 2 3))
|
||
; the following tests call-with-input-file, close-port,
|
||
; read-char, unread-char, and eof-object?
|
||
(equal? (call-with-input-file "testfile.ss"
|
||
(lambda (p)
|
||
(list->string
|
||
(let f ()
|
||
(let ([c (read-char p)])
|
||
(if (eof-object? c)
|
||
(begin (close-port p) '())
|
||
(begin (unread-char c p)
|
||
(let ([c (read-char p)])
|
||
(cons c (f))))))))))
|
||
"a b c d e")
|
||
; the following tests call-with-input-file, close-port,
|
||
; read-char, unread-char, and eof-object?
|
||
(equal? (call-with-values
|
||
(lambda ()
|
||
(call-with-input-file "testfile.ss"
|
||
(lambda (p)
|
||
(apply values
|
||
(let f ()
|
||
(let ([c (read-char p)])
|
||
(if (eof-object? c)
|
||
(begin (close-port p) '())
|
||
(begin (unread-char c p)
|
||
(let ([c (read-char p)])
|
||
(cons c (f)))))))))))
|
||
(lambda ls (list->string ls)))
|
||
"a b c d e")
|
||
; the following tests call-with-input-file, close-input-port,
|
||
; read-char, peek-char, and eof-object?
|
||
(equal? (call-with-input-file "testfile.ss"
|
||
(lambda (p)
|
||
(list->string
|
||
(let f ()
|
||
(let ([c (peek-char p)])
|
||
(if (eof-object? c)
|
||
(begin (close-input-port p) '())
|
||
(let ([c (read-char p)])
|
||
(cons c (f)))))))))
|
||
"a b c d e")
|
||
; test various errors related to input ports
|
||
(begin (set! ip (open-input-file "testfile.ss"))
|
||
(and (port? ip) (input-port? ip)))
|
||
(error? (unread-char #\a ip))
|
||
(eqv? (read-char ip) #\a)
|
||
(begin (unread-char #\a ip) (eqv? (read-char ip) #\a))
|
||
(begin (clear-input-port ip) #t)
|
||
(error? (unread-char #\a ip))
|
||
(error? (write-char #\a ip))
|
||
(error? (write 'a ip))
|
||
(error? (display 'a ip))
|
||
(error? (newline ip))
|
||
(error? (fprintf ip "hi"))
|
||
(error? (flush-output-port ip))
|
||
(error? (clear-output-port ip))
|
||
(begin (close-input-port ip) #t)
|
||
(error? (read-char ip))
|
||
(error? (read ip))
|
||
(error? (char-ready? ip))
|
||
; test various errors related to output ports
|
||
(begin (set! op (open-output-file "testfile.ss" 'replace))
|
||
(and (port? op) (output-port? op)))
|
||
(error? (char-ready? op))
|
||
(error? (peek-char op))
|
||
(error? (read-char op))
|
||
(error? (unread-char #\a op))
|
||
(error? (read op))
|
||
(error? (clear-input-port op))
|
||
(begin (close-output-port op) #t)
|
||
(error? (write-char #\a op))
|
||
(error? (write 'a op))
|
||
(error? (display 'a op))
|
||
(error? (newline op))
|
||
(error? (fprintf op "hi"))
|
||
(error? (flush-output-port op))
|
||
(error? (clear-output-port op))
|
||
(error? (current-output-port 'a))
|
||
(error? (current-input-port 'a))
|
||
(begin (current-output-port (console-output-port)) #t)
|
||
(begin (current-input-port (console-input-port)) #t)
|
||
|
||
; the following tests open-input-string, open-output-string, read-char,
|
||
; eof-object?, unread-char, write-char, and get-ouptut-string
|
||
(let ([s "hi there, mom!"])
|
||
(let ([ip (open-input-string s)] [op (open-output-string)])
|
||
(do ([c (read-char ip) (read-char ip)])
|
||
((eof-object? c)
|
||
(equal? (get-output-string op) s))
|
||
(unread-char c ip)
|
||
(write-char (read-char ip) op))))
|
||
|
||
(error? (with-input-from-string))
|
||
(error? (with-input-from-string "a"))
|
||
(error? (with-input-from-string 'a (lambda () 3)))
|
||
(error? (with-input-from-string "a" 'foo))
|
||
(error? (with-input-from-string (lambda () 3) "a"))
|
||
(error? (with-input-from-string '(this too?) values))
|
||
(error? (with-input-from-string "a" (lambda () 3) 'compressed))
|
||
(error? (with-output-to-string))
|
||
(error? (with-output-to-string "a"))
|
||
(error? (with-output-to-string 'a (lambda () 3)))
|
||
(error? (with-output-to-string '(this too?)))
|
||
(error? (eof-object #!eof))
|
||
(eq? (with-input-from-string "" read) #!eof)
|
||
(eq? (with-input-from-string "" read) (eof-object))
|
||
(eq? (eof-object) #!eof)
|
||
(error? (with-input-from-string "'" read))
|
||
; the following tests with-input-from-string, with-output-to-string,
|
||
; read-char, eof-object?, unread-char, and write-char
|
||
(let ([s "hi there, mom!"])
|
||
(equal?
|
||
(with-input-from-string s
|
||
(lambda ()
|
||
(with-output-to-string
|
||
(lambda ()
|
||
(do ([c (read-char) (read-char)])
|
||
((eof-object? c))
|
||
(unread-char c)
|
||
(write-char (read-char)))))))
|
||
s))
|
||
|
||
; the following makes sure that call-with-{in,out}put-file close the
|
||
; port (from Dave Boyer)---at least on systems which restrict the
|
||
; number of open ports to less than 20
|
||
(let loop ((i 20))
|
||
(or (zero? i)
|
||
(begin (call-with-output-file "testfile.ss"
|
||
(lambda (p) (write i p))
|
||
'replace)
|
||
(and (eq? (call-with-input-file "testfile.ss"
|
||
(lambda (p) (read p)))
|
||
i)
|
||
(loop (- i 1))))))
|
||
|
||
; test source information in error messages from read
|
||
(error?
|
||
(begin
|
||
(with-output-to-file "testfile.ss"
|
||
(lambda () (display "(cons 1 2 . 3 4)"))
|
||
'replace)
|
||
(let ([ip (open-input-file "testfile.ss")])
|
||
(dynamic-wind
|
||
void
|
||
(lambda () (read ip))
|
||
(lambda () (close-input-port ip))))))
|
||
|
||
; test source information in error messages from read
|
||
(error?
|
||
(begin
|
||
(with-output-to-file "testfile.ss"
|
||
(lambda () (display "(cons 1 2 ] 3 4)"))
|
||
'replace)
|
||
(let ([ip (open-input-file "testfile.ss")])
|
||
(dynamic-wind
|
||
void
|
||
(lambda () (read ip))
|
||
(lambda () (close-input-port ip))))))
|
||
)
|
||
|
||
(mat port-operations1
|
||
(error? (open-input-output-file))
|
||
(error? (open-input-output-file 'furball))
|
||
(error? (open-input-output-file "/probably/not/a/good/path"))
|
||
(error? (open-input-output-file "testfile.ss" 'compressed))
|
||
(error? (open-input-output-file "testfile.ss" 'uncompressed))
|
||
(begin
|
||
(define $ppp (open-input-output-file "testfile.ss"))
|
||
(and (input-port? $ppp) (output-port? $ppp) (port? $ppp)))
|
||
(error? (truncate-file $ppp -3))
|
||
(error? (truncate-file $ppp 'all-the-way))
|
||
(eof-object?
|
||
(begin
|
||
(truncate-file $ppp)
|
||
(display "hello" $ppp)
|
||
(flush-output-port $ppp)
|
||
(read $ppp)))
|
||
(eq? (begin (file-position $ppp 0) (read $ppp)) 'hello)
|
||
(eqv? (begin
|
||
(display "goodbye\n" $ppp)
|
||
(truncate-file $ppp 9)
|
||
(file-position $ppp))
|
||
9)
|
||
(eof-object? (read $ppp))
|
||
(eqv? (begin (file-position $ppp 0) (file-position $ppp)) 0)
|
||
(eq? (read $ppp) 'hellogood)
|
||
(eqv? (begin
|
||
(display "byebye\n" $ppp)
|
||
(truncate-file $ppp 0)
|
||
(file-position $ppp))
|
||
0)
|
||
(eof-object? (read $ppp))
|
||
(eof-object?
|
||
(begin
|
||
(close-port $ppp)
|
||
(let ([ip (open-input-file "testfile.ss")])
|
||
(let ([c (read-char ip)])
|
||
(close-input-port ip)
|
||
c))))
|
||
(error?
|
||
(let ([ip (open-input-file "testfile.ss")])
|
||
(dynamic-wind
|
||
void
|
||
(lambda () (truncate-file ip))
|
||
(lambda () (close-input-port ip)))))
|
||
(error? (truncate-file 'animal-crackers))
|
||
(error? (truncate-file))
|
||
(error? (truncate-file $ppp))
|
||
(let ([op (open-output-string)])
|
||
(and (= (file-position op) 0)
|
||
(= (file-length op) 0)
|
||
(begin (fresh-line op) #t)
|
||
(= (file-length op) 0)
|
||
(= (file-position op) 0)
|
||
(do ([i 4000 (fx- i 1)])
|
||
((fx= i 0) #t)
|
||
(display "hello" op))
|
||
(= (file-length op) 20000)
|
||
(= (file-position op) 20000)
|
||
(begin (file-position op 5000) #t)
|
||
(= (file-position op) 5000)
|
||
(= (file-length op) 20000)
|
||
(begin (truncate-file op) #t)
|
||
(= (file-length op) 0)
|
||
(= (file-position op) 0)
|
||
(begin (truncate-file op 17) #t)
|
||
(= (file-length op) 17)
|
||
(= (file-position op) 17)
|
||
(begin (display "okay" op) #t)
|
||
(= (file-length op) 21)
|
||
(= (file-position op) 21)
|
||
(equal? (substring (get-output-string op) 17 21) "okay")
|
||
(= (file-length op) 0)
|
||
(= (file-position op) 0)
|
||
(begin (fresh-line op) #t)
|
||
(= (file-length op) 0)
|
||
(= (file-position op) 0)
|
||
(begin
|
||
(write-char #\a op)
|
||
(fresh-line op)
|
||
#t)
|
||
(= (file-position op) 2)
|
||
(begin (fresh-line op) #t)
|
||
(= (file-position op) 2)
|
||
(equal? (get-output-string op) "a\n")))
|
||
(let ([ip (open-input-string "beam me up, scotty!")]
|
||
[s (make-string 10)])
|
||
(and (= (file-position ip) 0)
|
||
(= (file-length ip) 19)
|
||
(not (eof-object? (peek-char ip)))
|
||
(equal? (read ip) 'beam)
|
||
(= (file-position ip) 4)
|
||
(not (eof-object? (peek-char ip)))
|
||
(equal? (block-read ip s 10) 10)
|
||
(equal? s " me up, sc")
|
||
(= (file-position ip) 14)
|
||
(equal? (block-read ip s 10) 5)
|
||
(equal? s "otty!p, sc")
|
||
(= (file-position ip) 19)
|
||
(eof-object? (peek-char ip))
|
||
(eof-object? (read-char ip))
|
||
(eof-object? (block-read ip s 10))
|
||
(eof-object? (block-read ip s 0))
|
||
(begin
|
||
(file-position ip 10)
|
||
(= (file-position ip) 10))
|
||
(equal? (block-read ip s 10) 9)
|
||
(equal? s ", scotty!c")))
|
||
(error? ; unhandled message
|
||
(get-output-string (open-input-string "oops")))
|
||
(error? ; unhandled message
|
||
(let ([op (open-output-file "testfile.ss" 'replace)])
|
||
(dynamic-wind
|
||
void
|
||
(lambda () (get-output-string op))
|
||
(lambda () (close-output-port op)))))
|
||
)
|
||
|
||
(mat compression
|
||
(let ()
|
||
(define cp
|
||
(lambda (mode src dst)
|
||
(define buf-size 4096)
|
||
(let ([buf (make-string buf-size)])
|
||
(call-with-output-file dst
|
||
(lambda (op)
|
||
(call-with-input-file src
|
||
(lambda (ip)
|
||
(let lp ()
|
||
(let ([n (block-read ip buf buf-size)])
|
||
(unless (eof-object? n) (block-write op buf n) (lp)))))))
|
||
mode))))
|
||
(define cmp
|
||
(lambda (mode1 src1 mode2 src2)
|
||
(define buf-size 4096)
|
||
(let ([buf1 (make-string buf-size)]
|
||
[buf2 (make-string buf-size)])
|
||
(call-with-input-file src1
|
||
(lambda (ip1)
|
||
(call-with-input-file src2
|
||
(lambda (ip2)
|
||
(let lp ()
|
||
(let ([n1 (block-read ip1 buf1 buf-size)]
|
||
[n2 (block-read ip2 buf2 buf-size)])
|
||
(if (eof-object? n1)
|
||
(eof-object? n2)
|
||
(and (eqv? n1 n2)
|
||
(string=? (substring buf1 0 n1)
|
||
(substring buf2 0 n2))
|
||
(lp))))))
|
||
mode2))
|
||
mode1))))
|
||
(and
|
||
(cmp '() "prettytest.ss" '() "prettytest.ss")
|
||
(cmp '(compressed) "prettytest.ss" '() "prettytest.ss")
|
||
(cmp '() "prettytest.ss" '(compressed) "prettytest.ss")
|
||
(cmp '(compressed) "prettytest.ss" '(compressed) "prettytest.ss")
|
||
(begin
|
||
(cp '(replace compressed) "prettytest.ss" "testfile.ss")
|
||
#t)
|
||
(cmp '(compressed) "testfile.ss" '() "prettytest.ss")
|
||
(not (= (call-with-input-file "testfile.ss" file-length) (call-with-input-file "prettytest.ss" file-length)))
|
||
; the following test could cause an error with anything but latin-1 codec
|
||
#;(not (cmp '() "testfile.ss" '() "prettytest.ss"))
|
||
(begin
|
||
(cp '(compressed append) "prettytest.ss" "testfile.ss")
|
||
#t)
|
||
(not (cmp '(compressed) "testfile.ss" '() "prettytest.ss"))
|
||
))
|
||
(error? (open-output-file "testfile.ss" '(replace append)))
|
||
(error? (open-output-file "testfile.ss" '(append truncate)))
|
||
; test workaround for bogus gzclose error return for empty input files
|
||
(and
|
||
(eqv? (with-output-to-file "testfile.ss" void 'replace) (void))
|
||
(eof-object? (with-input-from-file "testfile.ss" read 'compressed)))
|
||
)
|
||
|
||
(mat read-comment
|
||
(equal? '; this is the first comment
|
||
(a ; second comment
|
||
#;(third ; comment in comment
|
||
comment #;(comment #1=e in
|
||
. #;(comment in comment in comment)
|
||
comment)) b ; fourth comment
|
||
c #| fifth comment #| more
|
||
nesting here |# |# d
|
||
; sixth and final comment
|
||
#1#)
|
||
'(a b c d e))
|
||
(equal? (read (open-input-string "; this is the first comment
|
||
(a ; second comment
|
||
#;(third ; comment in comment
|
||
comment #;(comment #1=e in
|
||
. #;(comment in comment in comment)
|
||
comment)) b ; fourth comment
|
||
c #| fifth comment #| more
|
||
nesting here |# |# d
|
||
; sixth and final comment
|
||
#1#)"))
|
||
'(a b c d e))
|
||
(equal? (read (open-input-string "(#|##|# |#|#1
|
||
#||#2
|
||
#|||#3
|
||
#|#||#|#4
|
||
#|| hello ||#5
|
||
#| ; rats |#)"))
|
||
'(1 2 3 4 5))
|
||
)
|
||
|
||
(mat read-graph
|
||
(begin
|
||
(define read-test-graph
|
||
(case-lambda
|
||
[(s) (read-test-graph s s)]
|
||
[(s1 s2)
|
||
(string=?
|
||
(parameterize ((print-graph #t))
|
||
(format "~s" (read (open-input-string s1))))
|
||
s2)]))
|
||
#t)
|
||
(error? ; verify that the error message is NOT "invalid memory reference"
|
||
(let ((ip (open-input-string "(cons 0 #0#)")))
|
||
((#%$make-read ip #t #f) #t)))
|
||
(let ()
|
||
(define-record foo ((immutable x) (immutable y)))
|
||
(record-reader 'foo (record-rtd (make-foo 3 4)))
|
||
(and
|
||
(read-test-graph "#0=#[foo (#0#) 0]")
|
||
(read-test-graph "#0=(#[foo #0# 0])")
|
||
(read-test-graph "#[foo #0=(a b c) #0#]")))
|
||
(error? (read-test-graph "#0=#[foo #0# #0#]"))
|
||
(read-test-graph "#(123 #[foo #0=(a b c) #0#])")
|
||
(read-test-graph "#(#0=#[foo #1=(a b c) #1#] 0 #0#)")
|
||
(read-test-graph "#(#1# 0 #1=#[foo #0=(a b c) #0#])"
|
||
"#(#0=#[foo #1=(a b c) #1#] 0 #0#)")
|
||
(read-test-graph "#(123 #0=(#0#))")
|
||
(read-test-graph "#(123 #0=(#0#))")
|
||
(let ()
|
||
(define-record r1 ((mutable a) (immutable b)))
|
||
(define-record r2 ((immutable a)))
|
||
(let* ((x2 (make-r2 (make-r1 '* '(a b c)))) (x1 (r2-a x2)))
|
||
(set-r1-a! x1 x2)
|
||
(record-reader 'r1 (record-rtd (make-r1 3 4)))
|
||
(record-reader 'r2 (record-rtd (make-r2 3)))
|
||
(read-test-graph
|
||
(parameterize ((print-graph #t))
|
||
(format "~s" (list (r1-b x1) x1))))))
|
||
(read-test-graph "(#0=(a b c) #1=#[r1 #[r2 #1#] #0#])")
|
||
)
|
||
|
||
(mat block-io
|
||
; test block-write and build testfile.ss for the following test
|
||
(let ([p (open-output-file "testfile.ss" 'truncate)])
|
||
(block-write p "hi there")
|
||
(display " mom" p)
|
||
(block-write p ", how are you?xxxx" (string-length ", how are you?"))
|
||
(newline p)
|
||
(let ([s (make-string 100 #\X)])
|
||
(string-set! s 99 #\newline)
|
||
(let ([s (apply string-append (make-list 10 s))])
|
||
(let ([s (apply string-append (make-list 10 s))])
|
||
(block-write p s)
|
||
(block-write p s 5000))))
|
||
(close-output-port p)
|
||
#t)
|
||
; test block-read
|
||
(let ([random-read-up
|
||
(lambda (p n)
|
||
(let f ([n n] [ls '()])
|
||
(if (fx= n 0)
|
||
(apply string-append (reverse ls))
|
||
(if (fxodd? n)
|
||
(f (- n 1) (cons (string (read-char p)) ls))
|
||
(let ([s (make-string (random (fx+ n 1)))])
|
||
(let ([i (if (fx= (random 2) 0)
|
||
(block-read p s)
|
||
(block-read p s (string-length s)))])
|
||
(f (- n i) (cons (substring s 0 i) ls))))))))])
|
||
(let ([s (make-string 100 #\X)])
|
||
(string-set! s 99 #\newline)
|
||
(let ([s (apply string-append (make-list 10 s))])
|
||
(let ([s (apply string-append (make-list 10 s))])
|
||
(let ([s (string-append "hi there mom, how are you?"
|
||
(string #\newline)
|
||
s
|
||
(substring s 0 5000))])
|
||
(let ([p (open-input-file "testfile.ss")])
|
||
(let ([t (random-read-up p (string-length s))])
|
||
(and (eof-object? (read-char p))
|
||
(string=? t s)
|
||
(eqv? (close-input-port p) (void))))))))))
|
||
; test for bug: block-read complained when handler returned eof
|
||
(eof-object?
|
||
(let ((p (make-input-port (lambda args #!eof) "")))
|
||
(block-read p (make-string 100))))
|
||
)
|
||
|
||
(mat file-length-and-file-position
|
||
(procedure? file-length)
|
||
(procedure? file-position)
|
||
(let ([s "hi there"])
|
||
(let ([n (string-length s)]
|
||
[p (open-output-file "testfile.ss" 'replace)])
|
||
(and (eqv? (file-length p) 0)
|
||
(begin (display s p)
|
||
(= (file-position p) (file-length p) n))
|
||
(begin (display #\space p)
|
||
(= (file-position p) (file-length p) (+ n 1)))
|
||
(eqv? (file-position p 1) (void))
|
||
(write-char #\o p)
|
||
(eqv? (file-position p 2000) (void))
|
||
(begin (display s p)
|
||
(= (file-length p) (file-position p) (+ 2000 n)))
|
||
(eqv? (close-output-port p) (void)))))
|
||
;;; no error is reported, which isn't serious
|
||
; (error? (file-position (open-input-file "testfile.ss") 10000))
|
||
(error?
|
||
(let ((p (open-input-file "testfile.ss")))
|
||
(dynamic-wind
|
||
void
|
||
(lambda () (file-position p -1))
|
||
(lambda () (close-input-port p)))))
|
||
(guard (c [(i/o-invalid-position-error? c)])
|
||
(let ([p (open-input-file "testfile.ss")])
|
||
(dynamic-wind
|
||
void
|
||
(lambda ()
|
||
(file-position p (if (fixnum? (expt 2 32)) (- (expt 2 63) 1) (- (expt 2 31) 1)))
|
||
#t)
|
||
(lambda () (close-input-port p)))))
|
||
(error?
|
||
(let ([p (open-input-file "testfile.ss")])
|
||
(dynamic-wind
|
||
void
|
||
(lambda () (file-position p (expt 2 64)))
|
||
(lambda () (close-input-port p)))))
|
||
(error? (file-position 1))
|
||
(error? (file-length 1))
|
||
(let ([s "hi there"])
|
||
(let ([n (string-length s)] [p (open-input-file "testfile.ss")])
|
||
(and (eqv? (file-length p) (+ 2000 n))
|
||
(eq? (read p) 'ho)
|
||
(eq? (read p) 'there)
|
||
(eqv? (file-position p) n)
|
||
(eqv? (file-position p 2000) (void))
|
||
(eq? (read p) 'hi)
|
||
(eq? (read p) 'there)
|
||
(= (file-position p) (file-length p) (+ 2000 n))
|
||
(eqv? (close-input-port p) (void)))))
|
||
)
|
||
|
||
(mat string-port-file-position
|
||
(let ([ip (open-input-string "hit me")])
|
||
(and (eq? (read ip) 'hit)
|
||
(eq? (file-position ip) 3)
|
||
(begin
|
||
(file-position ip 1)
|
||
(eq? (read ip) 'it))
|
||
(begin
|
||
(file-position ip 6)
|
||
(eof-object? (read ip)))
|
||
(begin
|
||
(file-position ip 0)
|
||
(eq? (read ip) 'hit))))
|
||
(error? (file-position (open-input-string "hi") 3))
|
||
(error? (file-position (open-input-string "hi") -1))
|
||
(let ()
|
||
(define f
|
||
(lambda (n)
|
||
(let ([op (open-output-string)])
|
||
(and (begin
|
||
(write 'ab op)
|
||
(eq? (file-position op) 2))
|
||
(begin
|
||
(file-position op 4)
|
||
(write 'ef op)
|
||
(eq? (file-position op) 6))
|
||
(begin
|
||
(file-position op 2)
|
||
(write 'cd op)
|
||
(eq? (file-position op) 4))
|
||
(begin
|
||
(set-port-length! op n)
|
||
(get-output-string op))))))
|
||
(and (equal? (f 6) "abcdef")
|
||
(equal? (f 4) "abcd")
|
||
(equal? (f 2) "ab")
|
||
(equal? (f 0) "")
|
||
(equal? (f 5) "abcde")
|
||
(let ((s (f 2000)))
|
||
(and s (= (string-length s) 2000)))))
|
||
(error? (file-position (open-output-string) -1))
|
||
)
|
||
|
||
(mat fresh-line
|
||
(procedure? fresh-line)
|
||
(error? (fresh-line 3))
|
||
(error? (fresh-line (open-input-string "hello")))
|
||
(equal?
|
||
(with-output-to-string
|
||
(lambda ()
|
||
(fresh-line)
|
||
(fresh-line)
|
||
(display "hello")
|
||
(fresh-line)
|
||
(fresh-line)))
|
||
"hello\n")
|
||
(begin
|
||
(with-output-to-file "testfile.ss"
|
||
(lambda ()
|
||
(fresh-line)
|
||
(fresh-line)
|
||
(display "hello")
|
||
(fresh-line)
|
||
(fresh-line))
|
||
'replace)
|
||
#t)
|
||
(call-with-input-file "testfile.ss"
|
||
(lambda (p)
|
||
(let ([s (make-string 100)])
|
||
(and
|
||
(= (block-read p s (string-length s)) 6)
|
||
(string=? (substring s 0 6) "hello\n")
|
||
(eof-object? (read-char p))))))
|
||
(begin
|
||
(with-output-to-file "testfile.ss"
|
||
(lambda ()
|
||
(write-char #\a)
|
||
(fresh-line)
|
||
(flush-output-port)
|
||
(set-port-bol! (current-output-port) #f)
|
||
(fresh-line)
|
||
(write-char #\b)
|
||
(flush-output-port)
|
||
(set-port-bol! (current-output-port) #t)
|
||
(fresh-line)
|
||
(fresh-line)
|
||
(write-char #\c)
|
||
(fresh-line)
|
||
(fresh-line))
|
||
'replace)
|
||
#t)
|
||
(call-with-input-file "testfile.ss"
|
||
(lambda (p)
|
||
(let ([s (make-string 100)])
|
||
(and
|
||
(= (block-read p s (string-length s)) 6)
|
||
(string=? (substring s 0 6) "a\n\nbc\n")
|
||
(eof-object? (read-char p))))))
|
||
)
|
||
|
||
(mat char-ready?
|
||
(procedure? char-ready?)
|
||
(let ([x (open-input-string "a")])
|
||
(and (char-ready? x)
|
||
(eqv? (read-char x) #\a)
|
||
(char-ready? x)
|
||
(eof-object? (read-char x))))
|
||
)
|
||
|
||
(mat clear-input-port ; test interactively
|
||
(procedure? clear-input-port)
|
||
)
|
||
|
||
;;; pretty-equal? is like equal? except that it considers gensyms
|
||
;;; with equal print names to be equal and any two nans to be equal.
|
||
(define pretty-equal?
|
||
(rec equal?
|
||
(lambda (x y) ; mostly snarfed from 5_1.ss
|
||
(or (cond
|
||
[(eq? x y) #t]
|
||
[(pair? x)
|
||
(and (pair? y)
|
||
(equal? (car x) (car y))
|
||
(equal? (cdr x) (cdr y)))]
|
||
[(symbol? x)
|
||
(and (gensym? x)
|
||
(gensym? y)
|
||
(string=? (symbol->string x) (symbol->string y)))]
|
||
[(or (null? x) (null? y)) #f]
|
||
[(or (char? x) (char? y)) #f]
|
||
[(flonum? x)
|
||
(and (flonum? y)
|
||
(or (let ([nan? (lambda (x) (not (fl= x x)))])
|
||
(and (nan? x) (nan? y)))
|
||
(fl= x y)))]
|
||
[(number? x)
|
||
(and (number? y)
|
||
(if (exact? x)
|
||
(and (exact? y) (= x y))
|
||
(and (equal? (real-part x) (real-part y))
|
||
(equal? (imag-part x) (imag-part y)))))]
|
||
[(string? x) (and (string? y) (string=? x y))]
|
||
[(box? x) (and (box? y) (equal? (unbox x) (unbox y)))]
|
||
[(vector? x)
|
||
(and (vector? y)
|
||
(= (vector-length x) (vector-length y))
|
||
(let f ([i (- (vector-length x) 1)])
|
||
(or (< i 0)
|
||
(and (equal? (vector-ref x i) (vector-ref y i))
|
||
(f (1- i))))))]
|
||
[(fxvector? x)
|
||
(and (fxvector? y)
|
||
(= (fxvector-length x) (fxvector-length y))
|
||
(let f ([i (- (fxvector-length x) 1)])
|
||
(or (< i 0)
|
||
(and (fx= (fxvector-ref x i) (fxvector-ref y i))
|
||
(f (1- i))))))]
|
||
[(bytevector? x)
|
||
(and (bytevector? y)
|
||
(bytevector=? x y))]
|
||
[else #f])
|
||
(parameterize ([print-length 6] [print-level 3])
|
||
(display "----------------------\n")
|
||
(pretty-print x)
|
||
(pretty-print '=/=)
|
||
(pretty-print y)
|
||
(display "----------------------\n")
|
||
#f)))))
|
||
|
||
(mat pretty-print
|
||
(let ([pretty-copy
|
||
(lambda (ifn ofn)
|
||
(let ([ip (open-input-file ifn)]
|
||
[op (open-output-file ofn 'replace)])
|
||
(dynamic-wind
|
||
(lambda () #f)
|
||
(rec loop
|
||
(lambda ()
|
||
(let ([x (read ip)])
|
||
(or (eof-object? x)
|
||
(parameterize ([print-unicode #f])
|
||
(pretty-print x op)
|
||
(newline op)
|
||
(loop))))))
|
||
(lambda ()
|
||
(close-input-port ip)
|
||
(close-output-port op)))))])
|
||
(pretty-copy "prettytest.ss" "testfile.ss"))
|
||
(let ([p1 (open-input-file "prettytest.ss")]
|
||
[p2 (open-input-file "testfile.ss")])
|
||
(dynamic-wind
|
||
(lambda () #f)
|
||
(rec loop
|
||
(lambda ()
|
||
(let ([x1 (read p1)] [x2 (read p2)])
|
||
(unless (pretty-equal? x1 x2)
|
||
(errorf 'pretty-equal "~s is not equal to ~s" x1 x2))
|
||
(or (eof-object? x1) (loop)))))
|
||
(lambda ()
|
||
(close-input-port p1)
|
||
(close-input-port p2))))
|
||
(error? (pretty-format))
|
||
(error? (pretty-format 'foo 'x 'x))
|
||
(error? (pretty-format 3 'x))
|
||
(error? (pretty-format 'foo '(bad 0 ... ... 0 format)))
|
||
(list? (pretty-format 'let))
|
||
(let ([x (pretty-format 'let)])
|
||
(pretty-format 'let x)
|
||
(equal? x (pretty-format 'let)))
|
||
(string=?
|
||
(parameterize ([pretty-standard-indent 2] [pretty-one-line-limit 1])
|
||
(pretty-format 'frob '(frob (x 1 ...) 3 (x #f ...) 4 (x y 3 ...) ...))
|
||
(with-output-to-string
|
||
(lambda ()
|
||
(pretty-print '(frob (alpha b c d)
|
||
(peter o n m)
|
||
(zero 1 2 3)
|
||
(nine 8 7 6))))))
|
||
"(frob (alpha\n b\n c\n d)\n (peter\n o\n n\n m)\n (zero 1\n 2\n 3)\n (nine 8\n 7\n 6))\n")
|
||
(eqv? (begin (pretty-format 'frob #f) (pretty-format 'frob)) #f)
|
||
(equal?
|
||
(with-output-to-string
|
||
(lambda ()
|
||
(pretty-print ''#'#`#,#,@,,@`(a b c))))
|
||
"'#'#`#,#,@,,@`(a b c)\n")
|
||
)
|
||
|
||
(mat write
|
||
(let ([unpretty-copy
|
||
(lambda (ifn ofn)
|
||
(let ([ip (open-input-file ifn)]
|
||
[op (open-output-file ofn 'replace)])
|
||
(dynamic-wind
|
||
(lambda () #f)
|
||
(rec loop
|
||
(lambda ()
|
||
(let ([x (read ip)])
|
||
(or (eof-object? x)
|
||
(parameterize ([print-unicode #f])
|
||
(write x op)
|
||
(newline op)
|
||
(loop))))))
|
||
(lambda ()
|
||
(close-input-port ip)
|
||
(close-output-port op)))))])
|
||
(unpretty-copy "prettytest.ss" "testfile.ss"))
|
||
(let ([p1 (open-input-file "prettytest.ss")]
|
||
[p2 (open-input-file "testfile.ss")])
|
||
(dynamic-wind
|
||
(lambda () #f)
|
||
(rec loop
|
||
(lambda ()
|
||
(let ([x1 (read p1)] [x2 (read p2)])
|
||
(unless (pretty-equal? x1 x2)
|
||
(errorf 'pretty-equal "~s is not equal to ~s" x1 x2))
|
||
(or (eof-object? x1) (loop)))))
|
||
(lambda ()
|
||
(close-input-port p1)
|
||
(close-input-port p2))))
|
||
)
|
||
|
||
(mat fasl
|
||
(pretty-equal?
|
||
(begin
|
||
(call-with-port
|
||
(open-file-output-port "testfile.ss" (file-options replace))
|
||
(lambda (p) (fasl-write +nan.0 p)))
|
||
(call-with-port (open-file-input-port "testfile.ss") fasl-read))
|
||
(/ 0.0 0.0))
|
||
(let ([ls (with-input-from-file "prettytest.ss"
|
||
(rec f
|
||
(lambda ()
|
||
(let ([x (read)])
|
||
(if (eof-object? x) '() (cons x (f)))))))])
|
||
(define-record frob (x1 (uptr x2) (fixnum x3) (float x4) (double x5) (wchar_t x6) (integer-64 x7) (char x8) (unsigned-64 x9)))
|
||
(let ([x (make-frob '#(#&3+4i 3.456+723i 3/4) 7500000 (most-negative-fixnum) +nan.0 3.1415 #\x3d0
|
||
(- (expt 2 63) 5) #\$ (- (expt 2 64) 5))])
|
||
(define put-stuff
|
||
(lambda (p)
|
||
(fasl-write (cons x x) p)
|
||
(fasl-write (list +nan.0 +inf.0 -inf.0 -0.0) p)
|
||
(for-each (lambda (x) (fasl-write x p)) ls)))
|
||
(define (get-stuff fasl-read)
|
||
(lambda (p)
|
||
(let ([y (fasl-read p)])
|
||
(and (equal? ($record->vector (car y)) ($record->vector x))
|
||
(eq? (cdr y) (car y))
|
||
(pretty-equal? (fasl-read p) (list +nan.0 +inf.0 -inf.0 -0.0))
|
||
(let loop ([ls ls])
|
||
(let ([x1 (fasl-read p)] [x2 (if (null? ls) #!eof (car ls))])
|
||
(unless (pretty-equal? x1 x2)
|
||
(errorf #f "~s is not equal to ~s" x1 x2))
|
||
(or (eof-object? x1) (loop (cdr ls)))))))))
|
||
(call-with-port
|
||
(open-file-output-port "testfile.ss" (file-options replace))
|
||
put-stuff)
|
||
(and
|
||
(call-with-port
|
||
(open-file-input-port "testfile.ss")
|
||
(get-stuff fasl-read))
|
||
(call-with-port
|
||
(open-file-input-port "testfile.ss" (file-options compressed))
|
||
(get-stuff fasl-read))
|
||
(call-with-port
|
||
(open-file-input-port "testfile.ss" (file-options compressed))
|
||
(get-stuff (lambda (p)
|
||
(when (eof-object? (lookahead-u8 p)) (printf "done\n"))
|
||
(fasl-read p))))
|
||
(begin
|
||
(call-with-port
|
||
(open-file-output-port "testfile.ss" (file-options compressed replace))
|
||
put-stuff)
|
||
(call-with-port
|
||
(open-file-input-port "testfile.ss" (file-options compressed))
|
||
(get-stuff fasl-read)))
|
||
(call-with-port
|
||
(open-bytevector-input-port
|
||
(call-with-bytevector-output-port put-stuff))
|
||
(get-stuff fasl-read)))))
|
||
(eqv? (fasl-file "prettytest.ss" "testfile.ss") (void))
|
||
(let ([ls (with-input-from-file "prettytest.ss"
|
||
(rec f
|
||
(lambda ()
|
||
(let ([x (read)])
|
||
(if (eof-object? x) '() (cons x (f)))))))])
|
||
(call-with-port
|
||
(open-file-input-port "testfile.ss")
|
||
(lambda (p)
|
||
(let loop ([ls ls])
|
||
(let ([x1 (fasl-read p)] [x2 (if (null? ls) #!eof (car ls))])
|
||
(unless (pretty-equal? x1 x2)
|
||
(errorf #f "~s is not equal to ~s" x1 x2))
|
||
(or (eof-object? x1) (loop (cdr ls))))))))
|
||
(equal?
|
||
(with-interrupts-disabled
|
||
(let ([ls (cons (weak-cons 'a 'b) (weak-cons 'c (cons 'd (weak-cons 'e #f))))])
|
||
(call-with-port
|
||
(open-file-output-port "testfile.ss" (file-options replace))
|
||
(lambda (p) (fasl-write ls p))))
|
||
(let ([ls (call-with-port (open-file-input-port "testfile.ss") fasl-read)])
|
||
(list
|
||
(equal? ls '((a . b) c d e . #f))
|
||
(weak-pair? ls)
|
||
(weak-pair? (car ls))
|
||
(weak-pair? (cdr ls))
|
||
(weak-pair? (cddr ls))
|
||
(weak-pair? (cdddr ls)))))
|
||
'(#t #f #t #t #f #t))
|
||
)
|
||
|
||
(mat clear-output-port ; test interactively
|
||
(procedure? clear-output-port)
|
||
)
|
||
|
||
(mat flush-output-port ; test interactively
|
||
(procedure? flush-output-port)
|
||
)
|
||
|
||
;;; section 6-3:
|
||
|
||
(mat format
|
||
(equal? (format "abcde") "abcde")
|
||
(equal? (format "~s ~a ~c ~~ ~%" "hi" "there" #\X)
|
||
(string-append "\"hi\" there X ~ " (string #\newline)))
|
||
(equal? (format "~s" car) "#<procedure car>")
|
||
(equal? (format "~s" (lambda () #f)) "#<procedure>")
|
||
)
|
||
|
||
(mat printf
|
||
(let ([p (open-output-string)])
|
||
(parameterize ([current-output-port p])
|
||
(printf "~s:~s" 3 4))
|
||
(equal? (get-output-string p) "3:4"))
|
||
)
|
||
|
||
(mat fprintf
|
||
(let ([p (open-output-string)])
|
||
(fprintf p "~s.~s:~s" 'abc 345 "xyz")
|
||
(equal? (get-output-string p) "abc.345:\"xyz\""))
|
||
)
|
||
|
||
(mat cp1in-verify-format-warnings
|
||
(warning? (parameterize ([#%$suppress-primitive-inlining #f])
|
||
(eval '(lambda () (import scheme) (format "~a~~~s" 5)))))
|
||
(warning? (parameterize ([#%$suppress-primitive-inlining #f])
|
||
(eval '(lambda () (import scheme) (format "~a~a~a~s" 1 2 3 4 5 6)))))
|
||
(warning? (parameterize ([#%$suppress-primitive-inlining #f])
|
||
(eval '(mat/cf (lambda () (import scheme) (format "~a~~~s" 5))))))
|
||
(warning? (parameterize ([#%$suppress-primitive-inlining #f])
|
||
(eval '(mat/cf (lambda () (import scheme) (format "~a~a~a~s" 1 2 3 4 5 6))))))
|
||
|
||
(warning? (parameterize ([#%$suppress-primitive-inlining #f])
|
||
(eval '(lambda () (import scheme) (printf "abc~s")))))
|
||
(warning? (parameterize ([#%$suppress-primitive-inlining #f])
|
||
(eval '(lambda () (import scheme) (printf "~%~abc~adef~ag~s~~~%" 1 2 3 4 5)))))
|
||
(warning? (parameterize ([#%$suppress-primitive-inlining #f])
|
||
(eval '(mat/cf (lambda () (import scheme) (printf "abc~s"))))))
|
||
(warning? (parameterize ([#%$suppress-primitive-inlining #f])
|
||
(eval '(mat/cf (lambda () (import scheme) (printf "~%~abc~adef~ag~s~~~%" 1 2 3 4 5))))))
|
||
|
||
(warning? (parameterize ([#%$suppress-primitive-inlining #f])
|
||
(eval '(lambda (p) (import scheme) (fprintf p "abc~s")))))
|
||
(warning? (parameterize ([#%$suppress-primitive-inlining #f])
|
||
(eval '(lambda (p) (import scheme) (fprintf p "~%~abc~adef~ag~s~~~%" 1 2 3 4 5)))))
|
||
(warning? (parameterize ([#%$suppress-primitive-inlining #f])
|
||
(eval '(mat/cf (lambda (p) (import scheme) (fprintf p "abc~s"))))))
|
||
(warning? (parameterize ([#%$suppress-primitive-inlining #f])
|
||
(eval '(mat/cf (lambda (p) (import scheme) (fprintf p "~%~abc~adef~ag~s~~~%" 1 2 3 4 5))))))
|
||
)
|
||
|
||
(mat print-parameters
|
||
(equal? (parameterize ([print-level 3])
|
||
(format "~s" (let ([x (list 'a)]) (set-car! x x) x)))
|
||
"((((...))))")
|
||
(equal? (parameterize ([print-length 3])
|
||
(format "~s" (let ([x (list 'a)]) (set-cdr! x x) x)))
|
||
"(a a a ...)")
|
||
(equal? (parameterize ([print-graph #t])
|
||
(format "~s" (let ([x (list 'a)]) (set-car! x x) x)))
|
||
"#0=(#0#)")
|
||
(equal? (parameterize ([print-graph #t])
|
||
(format "~s" (let ([x (list 'a)]) (set-cdr! x x) x)))
|
||
"#0=(a . #0#)")
|
||
(equal? (parameterize ([print-graph #t])
|
||
(format "~s" (let ([x (list 'a)] [y (list 'b)])
|
||
(list x y y x))))
|
||
"(#0=(a) #1=(b) #1# #0#)")
|
||
(equal? (parameterize ([print-graph #t])
|
||
(format "~s" (let ([x (list 'a)] [y (list 'b)])
|
||
(vector x y y x))))
|
||
"#(#0=(a) #1=(b) #1# #0#)")
|
||
(equal? (parameterize ([print-graph #t])
|
||
(format "~s" '(#2# #2=#{a b})))
|
||
"(#0=#{a b} #0#)")
|
||
(error? (guard (c [(and (warning? c) (format-condition? c))
|
||
(apply errorf (condition-who c) (condition-message c) (condition-irritants c))])
|
||
(format "~s"
|
||
(let ([x (list '*)])
|
||
(set-car! x x)
|
||
(set-cdr! x x)
|
||
x))))
|
||
(equal? (parameterize ([print-vector-length #f])
|
||
(format "~s ~s" '#5(1 2 3) '#8vfx(5 7 9 8 8 9 -1)))
|
||
"#(1 2 3 3 3) #vfx(5 7 9 8 8 9 -1 -1)")
|
||
(equal? (parameterize ([print-vector-length #t])
|
||
(format "~s ~s" '#(1 2 3 3 3) '#vfx(5 7 9 8 8 9 -1 -1)))
|
||
"#5(1 2 3) #8vfx(5 7 9 8 8 9 -1)")
|
||
(equal? (parameterize ([print-vector-length #f])
|
||
(format "~a ~a" '#5(1 2 3) '#8vfx(5 7 9 8 8 9 -1)))
|
||
"#(1 2 3 3 3) #vfx(5 7 9 8 8 9 -1 -1)")
|
||
(equal? (parameterize ([print-vector-length #t])
|
||
(format "~a ~a" '#(1 2 3 3 3) '#vfx(5 7 9 8 8 9 -1 -1)))
|
||
"#(1 2 3 3 3) #vfx(5 7 9 8 8 9 -1 -1)")
|
||
(equal? (parameterize ([print-vector-length #f])
|
||
(with-output-to-string
|
||
(lambda ()
|
||
(pretty-print '#5(1 2 3))
|
||
(pretty-print '#8vfx(5 7 9 8 8 9 -1)))))
|
||
"#(1 2 3 3 3)\n#vfx(5 7 9 8 8 9 -1 -1)\n")
|
||
(equal? (parameterize ([print-vector-length #t])
|
||
(with-output-to-string
|
||
(lambda ()
|
||
(pretty-print '#(1 2 3 3 3))
|
||
(pretty-print '#vfx(5 7 9 8 8 9 -1 -1)))))
|
||
"#5(1 2 3)\n#8vfx(5 7 9 8 8 9 -1)\n")
|
||
(equal? (parameterize ([print-gensym #f])
|
||
(format "~s" '(#3# #3=#{g0 fool})))
|
||
"(g0 g0)")
|
||
(equal? (parameterize ([print-graph #t] [print-gensym #f])
|
||
(format "~s" '(#4# #4=#{g0 fool})))
|
||
"(#0=g0 #0#)")
|
||
(equal? (parameterize ([print-gensym 'pretty])
|
||
(format "~s" '(#5# #5=#{g0 fool})))
|
||
"(#:g0 #:g0)")
|
||
(equal? (parameterize ([print-graph #t] [print-gensym 'pretty])
|
||
(format "~s" '(#6# #6=#{g0 fool})))
|
||
"(#0=#:g0 #0#)")
|
||
(equal? (parameterize ([print-gensym 'pretty])
|
||
(format "~s" '(#7# #7=#:g0)))
|
||
"(#:g0 #:g0)")
|
||
(let ([g (gensym "x")])
|
||
(parameterize ([print-gensym 'pretty/suffix])
|
||
(equal? (format "~s" g) (format "~s" g))))
|
||
(do ([i 100 (fx- i 1)])
|
||
((fx= i 0) #t)
|
||
(let ([g (gensym "x")])
|
||
(unless (< (string-length (parameterize ([print-gensym 'pretty/suffix])
|
||
(format "~s" g)))
|
||
(string-length (parameterize ([print-gensym #t])
|
||
(format "~s" g))))
|
||
(error #f "failed"))))
|
||
(let ([g (gensym "x")])
|
||
(let ([x (with-input-from-string
|
||
(parameterize ([print-gensym 'pretty/suffix])
|
||
(format "~s" g))
|
||
read)])
|
||
(and (symbol? x) (not (gensym? x)))))
|
||
(equal? (parameterize ([print-gensym 'pretty/suffix])
|
||
(format "~s" '#{g0 cfdhkxfnlo6opm0x-c}))
|
||
"g0.cfdhkxfnlo6opm0x-c")
|
||
(equal? (parameterize ([print-graph #t] [print-gensym 'pretty])
|
||
(format "~s" '(#8# #8=#:g0)))
|
||
"(#0=#:g0 #0#)")
|
||
(equal? (parameterize ([print-brackets #t])
|
||
(let ([p (open-output-string)])
|
||
(pretty-print '(let ((x 3)) x) p)
|
||
(get-output-string p)))
|
||
(format "~a~%" "(let ([x 3]) x)"))
|
||
(equal? (parameterize ([print-brackets #f])
|
||
(let ([p (open-output-string)])
|
||
(pretty-print '(let ((x 3)) x) p)
|
||
(get-output-string p)))
|
||
(format "~a~%" "(let ((x 3)) x)"))
|
||
(equal? (parameterize ([case-sensitive #t])
|
||
(format "~s" (string->symbol "AbcDEfg")))
|
||
"AbcDEfg")
|
||
(equal? (format "~s" (read (open-input-string "abCdEfG")))
|
||
"abCdEfG")
|
||
(equal? (parameterize ([case-sensitive #f])
|
||
(format "~s" (read (open-input-string "abCdEfG"))))
|
||
"abcdefg")
|
||
(equal? (parameterize ([print-radix 36])
|
||
(format "~s" 35))
|
||
"#36rZ")
|
||
(equal? (parameterize ([print-radix 36])
|
||
(format "~a" 35))
|
||
"Z")
|
||
)
|
||
|
||
(mat general-port
|
||
(<= (port-input-index (console-input-port))
|
||
(port-input-size (console-input-port))
|
||
(string-length (port-input-buffer (console-input-port))))
|
||
(<= (port-input-count (console-input-port))
|
||
(string-length (port-input-buffer (console-input-port))))
|
||
(<= (port-output-index (console-output-port))
|
||
(port-output-size (console-output-port))
|
||
(string-length (port-output-buffer (console-output-port))))
|
||
(<= (port-output-count (console-output-port))
|
||
(string-length (port-output-buffer (console-output-port))))
|
||
(equal?
|
||
(let ([sip (open-string-input-port "hello")])
|
||
(let ([n1 (port-input-count sip)])
|
||
(read-char sip)
|
||
(list n1 (port-input-count sip))))
|
||
'(5 4))
|
||
(equal?
|
||
(let ([op (make-output-port (lambda args (error #f "oops")) (make-string 10))])
|
||
(let ([n1 (port-output-count op)])
|
||
(display "hey!" op)
|
||
(list n1 (port-output-count op))))
|
||
'(10 6))
|
||
(let ()
|
||
(define make-two-way-port
|
||
; no local buffering
|
||
; close-port passed through
|
||
(lambda (ip op)
|
||
(define handler
|
||
(lambda (msg . args)
|
||
(record-case (cons msg args)
|
||
[block-read (p s n) (block-read ip s n)]
|
||
[block-write (p s n) (block-write op s n)]
|
||
[char-ready? (p) (char-ready? ip)]
|
||
[clear-input-port (p) (clear-input-port ip)]
|
||
[clear-output-port (p) (clear-output-port op)]
|
||
[close-port (p)
|
||
(close-port ip)
|
||
(close-port op)
|
||
(mark-port-closed! p)]
|
||
; [file-length (p) #f]
|
||
[file-position (p . pos)
|
||
(if (null? pos)
|
||
(most-negative-fixnum)
|
||
(errorf 'two-way-port "cannot reposition"))]
|
||
[flush-output-port (p) (flush-output-port op)]
|
||
[peek-char (p) (peek-char ip)]
|
||
[port-name (p) "two-way port"]
|
||
[read-char (p) (read-char ip)]
|
||
[unread-char (c p) (unread-char c ip)]
|
||
[write-char (c p) (write-char c op)]
|
||
[else (errorf 'two-way-port "operation ~s not handled"
|
||
msg)])))
|
||
(make-input/output-port handler "" "")))
|
||
(let ([sip (open-input-string "far out")]
|
||
[sop (open-output-string)])
|
||
(let ([p1 (make-two-way-port sip sop)])
|
||
(and (port? p1)
|
||
(begin (write (read p1) p1)
|
||
(string=? (get-output-string sop) "far"))
|
||
(char-ready? p1)
|
||
(char=? (read-char p1) #\space)
|
||
(char=? (read-char p1) #\o)
|
||
(begin (unread-char #\o p1)
|
||
(char=? (read-char p1) #\o))
|
||
; can't count on clear-output-port doing anything for
|
||
; string output ports, so next two checks are bogus
|
||
#;(begin (write-char #\a p1)
|
||
(clear-output-port p1)
|
||
(string=? (get-output-string sop) ""))
|
||
(begin
|
||
(file-position sip (file-length sip))
|
||
(char-ready? p1))
|
||
(eof-object? (peek-char p1))
|
||
; make sure these don't error out
|
||
(eq? (clear-input-port p1) (void))
|
||
(eq? (clear-output-port p1) (void))
|
||
(begin (close-port p1) (port-closed? p1))
|
||
(port-closed? sip)
|
||
(port-closed? sop)))))
|
||
(let ()
|
||
(define make-broadcast-port
|
||
; local buffering
|
||
; closed-port not passed through
|
||
; critical sections used where necessary to protect against interrupts
|
||
; uses block-write to dump buffers to subordinate ports
|
||
; check cltl2 to see what it says about local buffering,
|
||
; and about passing through flush, clear, and close
|
||
; size set so that buffer always has room for character to be written,
|
||
; allowing buffer to be flushed as soon as it becomes full
|
||
(lambda ports
|
||
(define handler
|
||
(lambda (msg . args)
|
||
(record-case (cons msg args)
|
||
; [block-read (p s n) #f]
|
||
[block-write (p s n)
|
||
(unless (null? ports)
|
||
(with-interrupts-disabled
|
||
(flush-output-port p)
|
||
(for-each (lambda (p) (block-write p s n))
|
||
ports)))]
|
||
; [char-ready? (p) (char-ready? ip)]
|
||
; [clear-input-port (p) (clear-input-port ip)]
|
||
[clear-output-port (p) (set-port-output-index! p 0)]
|
||
[close-port (p)
|
||
(set-port-output-size! p 0)
|
||
(mark-port-closed! p)]
|
||
; [file-length (p) #f]
|
||
[file-position (p . pos)
|
||
(if (null? pos)
|
||
(most-negative-fixnum)
|
||
(errorf 'broadcast-port "cannot reposition"))]
|
||
[flush-output-port (p)
|
||
(with-interrupts-disabled
|
||
(unless (null? ports)
|
||
(let ([b (port-output-buffer p)]
|
||
[i (port-output-index p)])
|
||
(for-each (lambda (p) (block-write p b i))
|
||
ports)))
|
||
(set-port-output-index! p 0))]
|
||
; [peek-char (p) (peek-char ip)]
|
||
[port-name (p) "broadcast port"]
|
||
; [read-char (p) (read-char ip)]
|
||
; [unread-char (c p) (unread-char c ip)]
|
||
[write-char (c p)
|
||
(with-interrupts-disabled
|
||
(unless (null? ports)
|
||
(let ([b (port-output-buffer p)]
|
||
[i (port-output-index p)])
|
||
; could check here to be sure that we really need
|
||
; to flush
|
||
(string-set! b i c)
|
||
(for-each (lambda (p)
|
||
(block-write p b (fx+ i 1)))
|
||
ports)))
|
||
(set-port-output-index! p 0))]
|
||
[else (errorf 'broadcast-port "operation ~s not handled"
|
||
msg)])))
|
||
(let ([len 1024])
|
||
(let ([p (make-output-port handler (make-string len))])
|
||
(set-port-output-size! p (fx- len 1))
|
||
p))))
|
||
(let ([p (make-broadcast-port)])
|
||
(and (port? p)
|
||
(let ([x (make-string 1000 #\a)])
|
||
(let loop ([i 1000])
|
||
(if (fx= i 0)
|
||
(fx<= (port-output-index p)
|
||
(port-output-size p)
|
||
(string-length (port-output-buffer p)))
|
||
(begin (display x p)
|
||
(loop (fx- i 1))))))
|
||
(begin (close-port p) (port-closed? p))))
|
||
(let ([sop (open-output-string)])
|
||
(let ([p (make-broadcast-port sop sop)])
|
||
(and (port? p)
|
||
(let ([x "abcde"])
|
||
(display x p)
|
||
(and (string=? (get-output-string sop) "")
|
||
(begin (flush-output-port p)
|
||
(string=? (get-output-string sop)
|
||
(string-append x x)))))
|
||
(begin (close-output-port p) (port-closed? p))))))
|
||
|
||
(let ()
|
||
(define make-transcript-port
|
||
; local buffering; run into problems with unread-char and
|
||
; clear-output-port otherwise
|
||
; close-port passed through to tp only
|
||
(lambda (ip op tp)
|
||
(define handler
|
||
(lambda (msg . args)
|
||
(record-case (cons msg args)
|
||
[block-read (p str cnt)
|
||
(with-interrupts-disabled
|
||
(let ([b (port-input-buffer p)]
|
||
[i (port-input-index p)]
|
||
[s (port-input-size p)])
|
||
(if (< i s)
|
||
(let ([cnt (fxmin cnt (fx- s i))])
|
||
(do ([i i (fx+ i 1)]
|
||
[j 0 (fx+ j 1)])
|
||
((fx= j cnt)
|
||
(set-port-input-index! p i)
|
||
cnt)
|
||
(string-set! str j (string-ref b i))))
|
||
(let ([cnt (block-read ip str cnt)])
|
||
(unless (eof-object? cnt)
|
||
(block-write tp str cnt))
|
||
cnt))))]
|
||
[char-ready? (p)
|
||
(or (< (port-input-index p) (port-input-size p))
|
||
(char-ready? ip))]
|
||
[clear-input-port (p)
|
||
; set size to zero rather than index to size
|
||
; in order to invalidate unread-char
|
||
(set-port-input-size! p 0)]
|
||
[clear-output-port (p) (set-port-output-index! p 0)]
|
||
[close-port (p)
|
||
(flush-output-port p)
|
||
(close-port tp)
|
||
(set-port-output-size! p 0)
|
||
(set-port-input-size! p 0)
|
||
(mark-port-closed! p)]
|
||
; [file-length (p) #f]
|
||
[file-position (p . pos)
|
||
(if (null? pos)
|
||
(most-negative-fixnum)
|
||
(errorf 'transcript-port "cannot reposition"))]
|
||
[flush-output-port (p)
|
||
(with-interrupts-disabled
|
||
(let ([b (port-output-buffer p)]
|
||
[i (port-output-index p)])
|
||
(block-write op b i)
|
||
(block-write tp b i)
|
||
(set-port-output-index! p 0)
|
||
(flush-output-port op)
|
||
(flush-output-port tp)))]
|
||
[peek-char (p)
|
||
(with-interrupts-disabled
|
||
(let ([b (port-input-buffer p)]
|
||
[i (port-input-index p)]
|
||
[s (port-input-size p)])
|
||
(if (fx< i s)
|
||
(string-ref b i)
|
||
(begin (flush-output-port p)
|
||
(let ([s (block-read ip b)])
|
||
(if (eof-object? s)
|
||
s
|
||
(begin (block-write tp b s)
|
||
(set-port-input-size! p s)
|
||
(string-ref b 0))))))))]
|
||
[port-name (p) "transcript"]
|
||
[read-char (p)
|
||
(with-interrupts-disabled
|
||
(let ([c (peek-char p)])
|
||
(unless (eof-object? c)
|
||
(set-port-input-index! p
|
||
(fx+ (port-input-index p) 1)))
|
||
c))]
|
||
[unread-char (c p)
|
||
(with-interrupts-disabled
|
||
(let ([b (port-input-buffer p)]
|
||
[i (port-input-index p)]
|
||
[s (port-input-size p)])
|
||
(when (fx= i 0)
|
||
(errorf 'unread-char
|
||
"tried to unread too far on ~s"
|
||
p))
|
||
(set-port-input-index! p (fx- i 1))
|
||
; following could be skipped; supposed to be
|
||
; same character
|
||
(string-set! b (fx- i 1) c)))]
|
||
[write-char (c p)
|
||
(with-interrupts-disabled
|
||
(let ([b (port-output-buffer p)]
|
||
[i (port-output-index p)]
|
||
[s (port-output-size p)])
|
||
(string-set! b i c)
|
||
; could check here to be sure that we really need
|
||
; to flush
|
||
(block-write op b (fx+ i 1))
|
||
(block-write tp b (fx+ i 1))
|
||
(set-port-output-index! p 0)))]
|
||
[block-write (p str cnt)
|
||
(with-interrupts-disabled
|
||
(let ([b (port-output-buffer p)]
|
||
[i (port-output-index p)])
|
||
; flush buffered data
|
||
(when (fx> i 0)
|
||
(block-write op b i)
|
||
(block-write tp b i))
|
||
; write new data
|
||
(block-write op str cnt)
|
||
(block-write tp str cnt)
|
||
(set-port-output-index! p 0)))]
|
||
[else (errorf 'transcript-port "operation ~s not handled"
|
||
msg)])))
|
||
(let ([ib (make-string 100)] [ob (make-string 100)])
|
||
(let ([p (make-input/output-port handler ib ob)])
|
||
(if (char-ready? ip)
|
||
; kludge so that old input doesn't show up after later
|
||
; output (e.g., input newline after output prompt)
|
||
(let ((n (block-read ip ib (string-length ib))))
|
||
(if (eof-object? n)
|
||
(set-port-input-size! p 0)
|
||
(set-port-input-size! p n)))
|
||
(set-port-input-size! p 0))
|
||
(set-port-output-size! p (fx- (string-length ob) 1))
|
||
p))))
|
||
; (define-record tp-frame (cip cop tp))
|
||
; (define tp-stack '())
|
||
; (define transcript-on
|
||
; (lambda (fn)
|
||
; (with-interrupts-disabled
|
||
; (let ((cip (console-input-port))
|
||
; (cop (console-output-port)))
|
||
; (let ((tp (make-transcript-port cip cop
|
||
; (open-output-file fn 'replace))))
|
||
; (set! tp-stack (cons (make-tp-frame cip cop tp) tp-stack))
|
||
; (console-output-port tp)
|
||
; (console-input-port tp)
|
||
; (when (eq? (current-input-port) cip)
|
||
; (current-input-port tp))
|
||
; (when (eq? (current-output-port) cop)
|
||
; (current-output-port tp)))))))
|
||
; (define transcript-off
|
||
; (lambda ()
|
||
; (with-interrupts-disabled
|
||
; (when (null? tp-stack) (errorf 'transcript-off "no transcript running"))
|
||
; (let ((frame (car tp-stack)))
|
||
; (let ((cip (tp-frame-cip frame))
|
||
; (cop (tp-frame-cop frame))
|
||
; (tp (tp-frame-tp frame)))
|
||
; (console-input-port cip)
|
||
; (console-output-port cop)
|
||
; (when (eq? (current-input-port) tp) (current-input-port cip))
|
||
; (when (eq? (current-output-port) tp) (current-output-port cop))
|
||
; (set! tp-stack (cdr tp-stack))
|
||
; (close-port tp))))))
|
||
(let ([ip (open-input-string (format "2"))]
|
||
[op (open-output-string)]
|
||
[tp (open-output-string)])
|
||
(let ([p (make-transcript-port ip op tp)])
|
||
(and (begin (display "1" p) (eq? (read p) 2))
|
||
(begin (display "3" p)
|
||
(flush-output-port p)
|
||
(and (string=? (get-output-string op) "13")
|
||
; 2 doesn't show up since we scan past available
|
||
; input (see "kludge" above)
|
||
(string=? (get-output-string tp) "13")))
|
||
(begin (close-port p)
|
||
(and (port-closed? p) (port-closed? tp)))))))
|
||
)
|
||
|
||
(mat port-handler
|
||
(begin (set! ph (port-handler (current-output-port)))
|
||
(procedure? ph))
|
||
(string? (ph 'port-name (current-output-port)))
|
||
(error? (ph))
|
||
(error? (ph 'foo))
|
||
(error? (ph 'foo (current-output-port)))
|
||
(error? (ph 'read-char))
|
||
(error? (ph 'write-char))
|
||
(error? (ph 'write-char 3))
|
||
(error? (ph 'write-char (current-input-port)))
|
||
(error? (ph 'write-char 'a (current-output-port)))
|
||
(error? (ph 'write-char #\a 'a))
|
||
(error? (ph 'write-char #\a (open-input-string "hello")))
|
||
(error? (ph 'write-char #\a (current-output-port) 'a))
|
||
(boolean? (ph 'char-ready? (current-input-port)))
|
||
)
|
||
|
||
(mat char-name
|
||
(eqv? (char-name 'space) #\space)
|
||
(eqv? (char-name #\space) 'space)
|
||
(eqv? (char-name 'tab) #\tab)
|
||
(eqv? (char-name #\tab) 'tab)
|
||
(eqv? (char-name 'return) #\return)
|
||
(eqv? (char-name #\return) 'return)
|
||
(eqv? (char-name 'page) #\page)
|
||
(eqv? (char-name #\page) 'page)
|
||
(eqv? (char-name 'linefeed) #\linefeed)
|
||
(eqv? (char-name #\linefeed) 'newline)
|
||
(eqv? (char-name 'newline) #\newline)
|
||
(eqv? (char-name #\newline) 'newline)
|
||
(eqv? (char-name #\backspace) 'backspace)
|
||
(eqv? (char-name 'backspace) #\backspace)
|
||
(eqv? (char-name #\rubout) 'delete)
|
||
(eqv? (char-name 'rubout) #\rubout)
|
||
(eqv? (char-name #\nul) 'nul)
|
||
(eqv? (char-name 'nul) #\nul)
|
||
(eqv? (char-name 'foo) #f)
|
||
(eqv? (char-name 'delete) #\delete)
|
||
(eqv? (char-name #\delete) 'delete)
|
||
(eqv? (char-name 'vtab) #\vtab)
|
||
(eqv? (char-name #\vtab) 'vtab)
|
||
(eqv? (char-name 'alarm) #\alarm)
|
||
(eqv? (char-name #\alarm) 'alarm)
|
||
(eqv? (char-name 'esc) #\esc)
|
||
(eqv? (char-name #\esc) 'esc)
|
||
(error? (read (open-input-string "#\\foo")))
|
||
(and (eqv? (char-name 'foo #\003) (void))
|
||
(eqv? (char-name 'foo) #\003)
|
||
(eqv? (char-name #\003) 'foo)
|
||
(eqv? (read (open-input-string "#\\foo")) #\003))
|
||
(equal?
|
||
(begin
|
||
(char-name 'foo #f)
|
||
(list (char-name 'foo) (char-name #\003)))
|
||
'(#f #f))
|
||
(error? (read (open-input-string "#\\new\\line")))
|
||
(error? (read (open-input-string "#\\new\\x6c;ine")))
|
||
)
|
||
|
||
(mat string-escapes
|
||
(eqv? (string-ref "ab\b" 2) #\backspace)
|
||
(eqv? (string-ref "\n" 0) #\newline)
|
||
(eqv? (string-ref "a\fb" 1) #\page)
|
||
(eqv? (string-ref "ab\r" 2) #\return)
|
||
(eqv? (string-ref "\t" 0) #\tab)
|
||
(eqv? (string-ref "\a\v" 0) #\bel)
|
||
(eqv? (string-ref "\a\v" 1) #\vt)
|
||
(eqv? (string-ref "\000" 0) #\nul)
|
||
(eqv? (string-ref "\x00;" 0) #\nul)
|
||
(eqv? (string-ref "a\x20;b" 1) #\space)
|
||
(eqv? (string-ref "\\\"\'" 0) #\\)
|
||
(eqv? (string-ref "\\\"\'" 1) #\")
|
||
(eqv? (string-ref "\\\"\'" 2) #\')
|
||
(= (char->integer (string-ref "a\012" 1)) #o12 10)
|
||
(= (char->integer (string-ref "a\015" 1)) #o15 13)
|
||
(= (char->integer (string-ref "a\177" 1)) #o177 127)
|
||
(= (char->integer (string-ref "a\377" 1)) #o377 255)
|
||
(error? (read (open-input-string "\"ab\\\"")))
|
||
(error? (read (open-input-string "\"ab\\0\"")))
|
||
(error? (read (open-input-string "\"ab\\01\"")))
|
||
(error? (read (open-input-string "\"ab\\*\"")))
|
||
(error? (read (open-input-string "\"ab\\x\"")))
|
||
(error? (read (open-input-string "\"ab\\x*\"")))
|
||
(error? (read (open-input-string "\"ab\\xg\"")))
|
||
(equal? (format "~s" "\bab\nc\f\rd\t\v\a") "\"\\bab\\nc\\f\\rd\\t\\v\\a\"")
|
||
)
|
||
|
||
(mat read-token
|
||
(let ([ip (open-input-string "(cons 33 #;hello \"rot\")")])
|
||
(and (let-values ([vals (read-token ip)])
|
||
(equal? vals '(lparen #f 0 1)))
|
||
(let-values ([vals (read-token ip)])
|
||
(equal? vals '(atomic cons 1 5)))
|
||
(let-values ([vals (read-token ip)])
|
||
(equal? vals '(atomic 33 6 8)))
|
||
(let-values ([vals (read-token ip)])
|
||
(equal? vals '(quote datum-comment 9 11)))
|
||
(let-values ([vals (read-token ip)])
|
||
(equal? vals '(atomic hello 11 16)))
|
||
(let-values ([vals (read-token ip)])
|
||
(equal? vals '(atomic "rot" 17 22)))
|
||
(let-values ([vals (read-token ip)])
|
||
(equal? vals '(rparen #f 22 23)))))
|
||
(let ()
|
||
(define with-input-from-string
|
||
(lambda (s p)
|
||
(parameterize ([current-input-port (open-input-string s)])
|
||
(p))))
|
||
(with-input-from-string "\n#17#\n"
|
||
(lambda ()
|
||
(let-values ([vals (read-token)])
|
||
(equal? vals '(insert 17 1 5))))))
|
||
(let ()
|
||
(with-output-to-file "testfile.ss"
|
||
(lambda () (display "\n#eat\n"))
|
||
'replace)
|
||
#t)
|
||
(error?
|
||
(let* ([ip (open-file-input-port "testfile.ss")]
|
||
[sfd (#%$source-file-descriptor "testfile.ss" ip)]
|
||
[ip (transcoded-port ip (native-transcoder))])
|
||
(dynamic-wind
|
||
void
|
||
(lambda () (read-token ip sfd))
|
||
(lambda () (close-input-port ip)))))
|
||
(let ()
|
||
(with-output-to-file "testfile.ss"
|
||
(lambda () (display "\neat\n"))
|
||
'replace)
|
||
#t)
|
||
; $transcoded-source-port is no more
|
||
#;(equal?
|
||
(let-values ([vals (let* ([ip (open-file-input-port "testfile.ss")]
|
||
[sfd (#%$source-file-descriptor "testfile.ss" ip)]
|
||
[ip (#%$transcoded-source-port ip (native-transcoder))])
|
||
(dynamic-wind
|
||
void
|
||
(lambda () (read-token ip sfd))
|
||
(lambda () (close-input-port ip))))])
|
||
vals)
|
||
'(atomic eat 1 4))
|
||
)
|
||
|
||
(define read-test
|
||
(lambda (s)
|
||
(with-output-to-file "testfile.ss"
|
||
(lambda () (display s))
|
||
'replace)
|
||
(load "testfile.ss" values)
|
||
#t))
|
||
(define load-test
|
||
(lambda (s)
|
||
(with-output-to-file "testfile.ss"
|
||
(lambda () (display s))
|
||
'replace)
|
||
(load "testfile.ss")
|
||
#t))
|
||
(define compile-test
|
||
(lambda (s)
|
||
(with-output-to-file "testfile.ss"
|
||
(lambda () (display s))
|
||
'replace)
|
||
(compile-file "testfile.ss")
|
||
(load "testfile.so")
|
||
#t))
|
||
|
||
(define-syntax xmat
|
||
(syntax-rules ()
|
||
[(_ string ...)
|
||
(begin
|
||
(mat read-test (error? (read-test string)) ...)
|
||
(mat load-test (error? (load-test string)) ...)
|
||
(mat compile-test (error? (compile-test string)) ...))]))
|
||
|
||
(begin (define-record f800 (a b)) (record-reader "zinjanthropus" (type-descriptor f800)))
|
||
(begin (define-record $acyclic ((immutable notme))) (record-reader '$acyclic (type-descriptor $acyclic)))
|
||
|
||
(xmat
|
||
"; Test error \"fasl object created by different release\"\n; This one is the list (a b c d) created by version 5.9b\n\n#@ 5.9b a b c d\f& \n"
|
||
)
|
||
|
||
(xmat
|
||
"; Test error \"bracketed list terminated by close parenthesis\"\n\n(define nil '[))\n\n"
|
||
"; Test error \"bracketed list terminated by close parenthesis\"\n\n(cond [(foobar) 'baz) [else 'ok])\n\n"
|
||
"; Test error \"bracketed list terminated by close parenthesis\"\n\n(define pair '[a . b))\n\n"
|
||
"; Test error \"duplicate mark #~s= seen\"\n\n(#327=(a b c #327=d) #327#)\n\n"
|
||
"; Test error \"expected close brace terminating gensym syntax\"\n\n(define #{foo |bar|\n (lambda (zap doodle)\n zap))\n\n"
|
||
"; Test error \"expected close brace terminating gensym syntax\"\n\n(define foo\n (lambda (#{foo |bar| none)\n 'quack))\n\n"
|
||
"; Test error \"expected one item after dot (.)\"\n\n(define foo\n (lambda (a b . )\n 'zapp))\n\n"
|
||
"; Test error \"expected one item after dot (.)\"\n\n(define foo\n (lambda [a b . ]\n 'zapp))\n\n"
|
||
"; Test error \"invalid character #\\\\~a~a~a\"\n\n(memv #\\401 (string->list \"abcd\"))\n\n"
|
||
"; Test error \"invalid character #\\\\~a~a\"\n\n(make-list 25 (make-string 100 #\\37d))\n"
|
||
"; Test error \"invalid character name\"\n\n(memv #\\bugsbunny (string->list \"looneytunes\"))\n"
|
||
"; Test error \"invalid character name\"\n\n(memv #\\new (string->list \"deal\"))\n"
|
||
"; Test error \"invalid character name\"\n\n(memv #\\Space (string->list \"no deal\"))\n"
|
||
"; Test error \"invalid character name\"\n\n(memv #\\SPACE (string->list \"no deal\"))\n"
|
||
"; Test error \"invalid number syntax\"\n\n(list #e23q3 'a 'b 'c)\n\n"
|
||
"; Test error \"invalid number syntax\"\n\n(list #e3_4i 'a 'b 'c)\n\n"
|
||
"; Test error \"invalid number syntax\"\n\n(list #e3+)"
|
||
"; Test error \"invalid number syntax\"\n\n(sqrt #36r1+1i)\n\n"
|
||
"; Test error \"invalid number syntax\"\n\n(sqrt #36r1+i)\n\n"
|
||
"; Test error \"invalid number syntax\"\n\n(sqrt #36r1+1i)\n\n"
|
||
"; Test error \"invalid number syntax\"\n\n(sqrt #36r1+i)\n\n"
|
||
"; Test error \"cannot represent\"\n\n(sqrt 1/0)\n\n"
|
||
"; Test error \"cannot represent\"\n\n(sqrt 1/0)\n\n"
|
||
"; Test error \"cannot represent\"\n\n(sqrt 1#/0)\n\n"
|
||
"; Test error \"cannot represent\"\n\n(sqrt 1##/0)\n\n"
|
||
"; Test error \"cannot represent\"\n\n(sqrt #e1/0#)\n\n"
|
||
"; Test error \"cannot represent\"\n\n(sqrt #e1/0###)\n\n"
|
||
"; Test error \"cannot represent\"\n\n(sqrt #e1/0###)\n\n"
|
||
"; Test error \"cannot represent\"\n\n(sqrt #e1/0###)\n\n"
|
||
"; Test error \"cannot represent\"\n\n(sqrt #e1/0###)\n\n"
|
||
"; Test error \"cannot represent\"\n\n(sqrt #e+inf.0)\n\n"
|
||
"; Test error \"cannot represent\"\n\n(sqrt #e-inf.0)\n\n"
|
||
"; Test error \"cannot represent\"\n\n(sqrt #e+nan.0)\n\n"
|
||
"; Test error \"cannot represent\"\n\n(sqrt #e0/0e20)\n\n"
|
||
"; Test error \"cannot represent\"\n\n(sqrt #e1@1)\n\n"
|
||
"; Test error \"invalid number syntax\"\n\n(sqrt #e+nan.5)\n\n"
|
||
"; Test error \"invalid sharp-sign prefix #~c\"\n\n(if #T #N #T)\n"
|
||
"; Test error \"invalid sharp-sign prefix ~a~a\"\n\n(if (optimize-til-it-hurts?) (#7%super-fast+ 1 2) (+ 1 2))\n"
|
||
"; Test error \"invalid sharp-sign prefix ~a~a\"\n\n(when #2_3_4 'huh?)\n"
|
||
"; Test error \"invalid string character \\\\~c~c~c\"\n\n (define s \"james stock \\707!\")\n"
|
||
"; Test error \"invalid string character \\\\~c~c\"\n\n\"=tofu\\07gnorefsefawd2slivne\"\n\n"
|
||
"; Test error \"invalid string character \\\\~c\"\n\n\"I need \\3d glasses\"\n"
|
||
"; Test error \"invalid string character\"\n\n(pretty-print \"this is \\xa fine mess\")\n"
|
||
"; Test error \"invalid string character\"\n\n(pretty-print \"this is \\x\")\n"
|
||
"; Test error \"invalid string character\"\n\n(pretty-print \"this is \\xGreat news!\")\n"
|
||
"; Test error \"invalid string character \\\\~c\"\n\n\"status \\quo\"\n"
|
||
"; Test error \"invalid syntax #!~s\"\n\n(when #!whuppo! 1 2 3)\n\n"
|
||
"; Test error \"invalid syntax #!~s\"\n\n(when #!eo 1 2 3)\n\n"
|
||
"; Test error \"invalid syntax #v~s\"\n\n(list #vxx())\n"
|
||
"; Test error \"invalid syntax #~v,'0dv~s\"\n\n(list #073vxx())\n"
|
||
"; Test error \"invalid syntax #v~s\"\n\n(list #vf())\n"
|
||
"; Test error \"invalid syntax #~v,'0dv~s\"\n\n(list #073vf())\n"
|
||
"; Test error \"invalid syntax #v~s\"\n\n(list #vfx[])\n"
|
||
"; Test error \"invalid syntax #~v,'0dv~s\"\n\n(list #073vfx[])\n"
|
||
"; Test error \"invalid vector length\"\n\n(vector-length #999999999999999999999999999999(a b c))\n\n"
|
||
"; Test error \"invalid fxvector length\"\n\n(fxvector-length #999999999999999999999999999999vfx(1 2 3))\n\n"
|
||
"; Test error \"invalid bytevector length\"\n\n(bytevector-length #999999999999999999999999999999vu8(1 2 3))\n\n"
|
||
"; Test error \"mark #~s= missing\"\n\n'(what about this?) ; separate top-level S-expression, so ok.\n\n(begin\n (reverse '(a b . #77#))\n (cons 1 2))"
|
||
"; Test error \"more than one item found after dot (.)\"\n\n(define foo\n (lambda (able baker . charlie delta epsilon)\n 'wow))\n\n"
|
||
"; Test error \"more than one item found after dot (.)\"\n\n(define foo\n (lambda [able baker . charlie delta epsilon]\n 'wow))\n\n"
|
||
"; Test error \"non-symbol found after #[\"\n\n(pretty-print '#[(a \"b c\" #\\d) 1 2 3])\n"
|
||
"; Test error \"outdated object file format\"\n\n\"What is\" #3q\n'(1 2 3)\n\n"
|
||
"; Test error \"parenthesized list terminated by close bracket\"\n\n(define nil '(])\n\n"
|
||
"; Test error \"parenthesized list terminated by close bracket\"\n\n(cond [(foobar) 'baz] (else 'ok])\n\n"
|
||
"; Test error \"parenthesized list terminated by close bracket\"\n\n(define pair '(a . b])\n\n"
|
||
"; Test error \"too many vector elements supplied\"\n\n(pretty-print '#3(one two three four five six seven))\n"
|
||
"; Test error \"non-fixnum found in fxvector\"\n\n(pretty-print '#vfx(1 2.0 3 4))\n"
|
||
"; Test error \"non-fixnum found in fxvector\"\n\n(pretty-print '#3vfx(1 2.0 3 4))\n"
|
||
"; Test error \"too many fxvector elements supplied\"\n\n(pretty-print '#3vfx(1 2 3 4))\n"
|
||
"; Test error \"invalid value 2.0 found in bytevector\"\n\n(pretty-print '#vu8(1 2.0 3 4))\n"
|
||
"; Test error \"invalid value -1 found in bytevector\"\n\n(pretty-print '#3vu8(1 -1 3 4))\n"
|
||
"; Test error \"too many bytevector elements supplied\"\n\n(pretty-print '#3vu8(1 2 3 4))\n"
|
||
"; Test error \"too few fields supplied for record ~s\"\n\n(define x '#[zinjanthropus 3])"
|
||
"; Test error \"too many fields supplied for record ~s\"\n\n(define x '#[zinjanthropus 3 4 5])"
|
||
"; Test error \"unexpected close bracket\"\n\n1 2 3 ]\n"
|
||
"; Test error \"unexpected close parenthesis\"\n\n(define x 3))\n"
|
||
"; Test error \"unexpected dot\"\n\n(lambda (x . . y) x)\n\n"
|
||
"; Test error \"unexpected dot\"\n\n(lambda ( . y) y)\n\n"
|
||
"; Test error \"unexpected dot\"\n\n(define x '(a . b . c))\n"
|
||
"; Test error \"unexpected dot\"\n\n(define x '[a . b . c])\n"
|
||
"; Test error \"unexpected end-of-file reading block comment\"\n(pretty-print\n #| foo\n #| bar |#\n baz \"pickle ; not eof on string since we're in block comment"
|
||
"; Test error \"unexpected end-of-file reading block comment\"\n(pretty-print\n #| foo\n #"
|
||
"; Test error \"unexpected end-of-file reading block comment\"\n(pretty-print\n #| foo\n |"
|
||
"; Test error \"unexpected end-of-file reading box\"\n\n #& ; box is empty!\n"
|
||
"; Test error \"unexpected end-of-file reading bracketed list\" (before first element)\n\n(lambda (x y z)\n (cond\n [\n\n "
|
||
"; Test error \"unexpected end-of-file reading bracketed list\"\n\n(lambda (x y z)\n (cond\n [(< x 1) y\n [else z]\n\n\n"
|
||
"; Test error \"unexpected end-of-file reading bracketed list\" (after dot)\n\n(car '[a b . c\n\n"
|
||
"; Test error \"unexpected end-of-file reading bracketed list\" (after element after dot)\n\n(car '[a b . c\n\n"
|
||
"; Test error \"unexpected end-of-file reading character\"\n#\\"
|
||
"; Test error \"unexpected end-of-file reading character\"\n#\\new"
|
||
"; Test error \"unexpected end-of-file reading character\"\n#\\02"
|
||
"; Test error \"unexpected end-of-file reading expression comment\"\n\n(define oops '#; ; that's all I've got!\n"
|
||
"; Test error \"unexpected end-of-file reading gensym\"\n(pretty-print '#{"
|
||
"; Test error \"unexpected end-of-file reading gensym\"\n(pretty-print '#{foo"
|
||
"; Test error \"unexpected end-of-file reading gensym\"\n(pretty-print '#{foo |bar|"
|
||
"; Test error \"unexpected end-of-file reading graph mark\"\n(define x '#1=\n"
|
||
"; Test error \"unexpected end-of-file reading hash-bang syntax\"\n\n(list #!eo"
|
||
"; Test error \"unexpected end-of-file reading #v syntax\"\n\"would this be cool?\" #v"
|
||
"; Test error \"unexpected end-of-file reading #~v,'0dv syntax\"\n\"would this be cool?\" #01v"
|
||
"; Test error \"unexpected end-of-file reading #v syntax\"\n\"would this be cool?\" #vf"
|
||
"; Test error \"unexpected end-of-file reading #~v,'0dv syntax\"\n\"would this be cool?\" #01vf"
|
||
"; Test error \"unexpected end-of-file reading #v syntax\"\n\"would this be cool?\" #vfx"
|
||
"; Test error \"unexpected end-of-file reading #~v,'0dv syntax\"\n\"would this be cool?\" #01vfx"
|
||
"; Test error \"unexpected end-of-file reading list\" (before first element) \n\n (\n\n "
|
||
"; Test error \"unexpected end-of-file reading list\"\n\n(lambda (x y z\n (cond\n [(< x 1) y]\n [else z]))\n\n"
|
||
"; Test error \"unexpected end-of-file reading list\" (after dot)\n\n(car '(a b . \n\n"
|
||
"; Test error \"unexpected end-of-file reading list\" (after element after dot)\n\n(car '(a b . c\n\n"
|
||
"; Test error \"unexpected end-of-file reading # prefix\"\n\"would this be cool?\" #"
|
||
"; Test error \"unexpected end-of-file reading # prefix\"\n\"would this be cool?\" #35"
|
||
"; Test error \"unexpected end-of-file reading number\"\n\n(list #e3+"
|
||
"; Test error \"unexpected end-of-file reading quote\"\n(define fido ' \n\n\n"
|
||
"; Test error \"unexpected end-of-file reading quasiquote\"\n(define e ` \n"
|
||
"; Test error \"unexpected end-of-file reading unquote\"\n(define e `(+ ,(* 2 3) , \n\n"
|
||
"; Test error \"unexpected end-of-file reading unquote-splicing\"\n(define r (list 1 2 3))\n(set! r `(0 ,@ \n\n"
|
||
"; Test error \"unexpected end-of-file reading quasisyntax\"\n(define e #` \n"
|
||
"; Test error \"unexpected end-of-file reading unsyntax\"\n(define e #`(+ #,(* 2 3) #, \n\n"
|
||
"; Test error \"unexpected end-of-file reading unsyntax-splicing\"\n(define r (list 1 2 3))\n(set! r #`(0 #,@ \n\n"
|
||
"; Test error \"unexpected end-of-file reading record\"\n\n(define oops '#[ \n\n"
|
||
"; Test error \"unexpected end-of-file reading record\"\n\n(define oops '#[$acyclic \n\n"
|
||
"; Test error \"unexpected end-of-file reading string\"\n\n(printf \"This is \\\"not\\\" what I meant)\n\n"
|
||
"; Test error \"unexpected end-of-file reading string\"\n\n(define s \"hello \\"
|
||
"; Test error \"unexpected end-of-file reading string\"\n\n(define s \"hello \\0"
|
||
"; Test error \"unexpected end-of-file reading string\"\n\n(define s \"hello \\03"
|
||
"; Test error \"unexpected end-of-file reading string\"\n\n(define s \"hello \\x"
|
||
"; Test error \"unexpected end-of-file reading string\"\n\n(define s \"hello \\x2"
|
||
"; Test error \"unexpected end-of-file reading string\"\n\n(list \"abc\\x3c3"
|
||
"; Test error \"invalid code point value 2097152 in string hex escape\"\n\n(list \"abc\\x200000;\")"
|
||
"; Test error \"invalid character q in string hex escape\"\n\n(list \"abc\\xq;\")"
|
||
"; Test error \"invalid character \" in string hex escape\"\n\n(list \"abc\\x\")"
|
||
"; Test error \"unexpected end-of-file reading symbol\"\n\n(list 'abc\\"
|
||
"; Test error \"unexpected end-of-file reading symbol\"\n\n(cons '|froma\\|gerie\\ %dq|jl&"
|
||
"; Test error \"unexpected end-of-file reading symbol\"\n(pretty-print\n #| foo\n #| bar |#\n |#\n|# #| oops |#"
|
||
"; Test error \"unexpected end-of-file reading symbol\"\n\n(list 'abc\\x"
|
||
"; Test error \"unexpected end-of-file reading symbol\"\n\n(list 'abc\\x3c3"
|
||
"; Test error \"invalid code point value 2097152 in symbol hex escape\"\n\n(list 'abc\\x200000;)"
|
||
"; Test error \"invalid character q in symbol hex escape\"\n\n(list 'abc\\xq;)"
|
||
"; Test error \"unexpected end-of-file reading vector\"\n\n (define v '#(a b \n"
|
||
"; Test error \"unexpected end-of-file reading vector\"\n\n (define v '#35(a b \n"
|
||
"; Test error \"unexpected end-of-file reading fxvector\"\n\n (define v '#vfx(0 1 \n"
|
||
"; Test error \"unexpected end-of-file reading fxvector\"\n\n (define v '#35vfx(0 1 \n"
|
||
"; Test error \"unexpected end-of-file reading bytevector\"\n\n (define v '#vu8(0 1 \n"
|
||
"; Test error \"unexpected end-of-file reading bytevector\"\n\n (define v '#35vu8(0 1 \n"
|
||
"; Test error \"unrecognized record name ~s\"\n#[zsunekunvliwndwalv 1 2 3 4]"
|
||
"; Test error \"unresolvable cycle\"\n\n(define oops '#1=#[$acyclic #1#])\n"
|
||
"; Test error \"open brace syntax not allowed in #!r6rs mode\"\n\n#!r6rs '{\n"
|
||
"; Test error \"close brace syntax not allowed in #!r6rs mode\"\n\n#!r6rs '}\n"
|
||
"; Test error \"#[...] record syntax not allowed in #!r6rs mode\"\n\n#!r6rs '#[abc]\n"
|
||
"; Test error \"#{...} gensym syntax not allowed in #!r6rs mode\"\n\n#!r6rs '#{abc def}\n"
|
||
"; Test error \"#& box syntax not allowed in #!r6rs mode\"\n\n#!r6rs '#&box\n"
|
||
"; Test error \"#% primitive syntax not allowed in #!r6rs mode\"\n\n#!r6rs #%car\n"
|
||
"; Test error \"#: gensym syntax not allowed in #!r6rs mode\"\n\n#!r6rs #:g0\n"
|
||
"; Test error \"#<n>(...) vector syntax not allowed in #!r6rs mode\"\n\n#!r6rs '#3(a b c)\n"
|
||
"; Test error \"#<n>r number syntax not allowed in #!r6rs mode\"\n\n#!r6rs '#3r1201\n"
|
||
"; Test error \"#<n># insert syntax not allowed in #!r6rs mode\"\n\n#!r6rs '#3#\n"
|
||
"; Test error \"#<n>= mark syntax not allowed in #!r6rs mode\"\n\n#!r6rs '#3=\n"
|
||
"; Test error \"#<n>% primitive syntax not allowed in #!r6rs mode\"\n\n#!r6rs #3%car\n"
|
||
"; Test error \"octal character syntax not allowed in #!r6rs mode\"\n\n#!r6rs #\\010\n"
|
||
"; Test error \"invalid delimiter 1 for character\"\n\n#\\0001\n"
|
||
"; Test error \"delimiter { is not allowed in #!r6rs mode\"\n\n#!r6rs #\\0{\n"
|
||
"; Test error \"#!eof syntax not allowed in #!r6rs mode\"\n\n#!r6rs #!eof\n"
|
||
"; Test error \"#!bwp syntax not allowed in #!r6rs mode\"\n\n#!r6rs #!bwp\n"
|
||
"; Test error \"#vfx(...) fxvector syntax not allowed in #!r6rs mode\"\n\n#!r6rs '#vfx(1 2 3)\n"
|
||
"; Test error \"#<n>vfx(...) fxvector syntax not allowed in #!r6rs mode\"\n\n#!r6rs '#3vfx(1 2 3)\n"
|
||
"; Test error \"#<n>vu8(...) fxvector syntax not allowed in #!r6rs mode\"\n\n#!r6rs '#3vu8(1 2 3)\n"
|
||
"; Test error \"octal string-character syntax not allowed in #!r6rs mode\"\n\n#!r6rs \"a\\010b\"\n"
|
||
"; Test error \"back-slash symbol escape syntax not allowed in #!r6rs mode\"\n\n#!r6rs ab\\ cd\n"
|
||
"; Test error \"|...| symbol escape syntax not allowed in #!r6rs mode\"\n\n#!r6rs |ab cd|\n"
|
||
"; Test error \"@abc symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs @abc\n"
|
||
"; Test error \"123a symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs 123a\n"
|
||
"; Test error \"123# number syntax not allowed in #!r6rs mode\"\n\n#!r6rs 123#\n"
|
||
"; Test error \"#x1/2e2 number syntax not allowed in #!r6rs mode\"\n\n#!r6rs 1/2e2\n"
|
||
"; Test error \"#x.3 number syntax not allowed in #!r6rs mode\"\n\n#!r6rs #x.3\n"
|
||
|
||
; following tests adapted from the read0 benchmark distributed by Will
|
||
; Clinger, which as of 08/08/2009 appears to be in the public domain,
|
||
; with no license, copyright notice, author name, or date.
|
||
"; Test error \"\x488; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x488;\n"
|
||
"; Test error \"@ symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs @\n"
|
||
"; Test error \"@b symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs @b\n"
|
||
"; Test error \"@ symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs @\n"
|
||
"; Test error \"\x488; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x488;\n"
|
||
"; Test error \"\x489; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x489;\n"
|
||
"; Test error \"\x660; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x660;\n"
|
||
"; Test error \"\x661; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x661;\n"
|
||
"; Test error \"\x662; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x662;\n"
|
||
"; Test error \"\x663; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x663;\n"
|
||
"; Test error \"\x664; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x664;\n"
|
||
"; Test error \"\x665; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x665;\n"
|
||
"; Test error \"\x666; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x666;\n"
|
||
"; Test error \"\x667; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x667;\n"
|
||
"; Test error \"\x668; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x668;\n"
|
||
"; Test error \"\x669; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x669;\n"
|
||
#;"; Test error \"\x6DE; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x6DE;\n" ; switched from Me to So in Unicode 7.0
|
||
"; Test error \"\x6F0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x6F0;\n"
|
||
"; Test error \"\x6F1; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x6F1;\n"
|
||
"; Test error \"\x6F2; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x6F2;\n"
|
||
"; Test error \"\x6F3; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x6F3;\n"
|
||
"; Test error \"\x6F4; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x6F4;\n"
|
||
"; Test error \"\x6F5; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x6F5;\n"
|
||
"; Test error \"\x6F6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x6F6;\n"
|
||
"; Test error \"\x6F7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x6F7;\n"
|
||
"; Test error \"\x6F8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x6F8;\n"
|
||
"; Test error \"\x6F9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x6F9;\n"
|
||
"; Test error \"\x7C0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x7C0;\n"
|
||
"; Test error \"\x7C1; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x7C1;\n"
|
||
"; Test error \"\x7C2; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x7C2;\n"
|
||
"; Test error \"\x7C3; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x7C3;\n"
|
||
"; Test error \"\x7C4; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x7C4;\n"
|
||
"; Test error \"\x7C5; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x7C5;\n"
|
||
"; Test error \"\x7C6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x7C6;\n"
|
||
"; Test error \"\x7C7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x7C7;\n"
|
||
"; Test error \"\x7C8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x7C8;\n"
|
||
"; Test error \"\x7C9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x7C9;\n"
|
||
"; Test error \"\x903; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x903;\n"
|
||
"; Test error \"\x93E; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x93E;\n"
|
||
"; Test error \"\x93F; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x93F;\n"
|
||
"; Test error \"\x940; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x940;\n"
|
||
"; Test error \"\x949; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x949;\n"
|
||
"; Test error \"\x94A; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x94A;\n"
|
||
"; Test error \"\x94B; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x94B;\n"
|
||
"; Test error \"\x94C; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x94C;\n"
|
||
"; Test error \"\x966; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x966;\n"
|
||
"; Test error \"\x967; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x967;\n"
|
||
"; Test error \"\x968; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x968;\n"
|
||
"; Test error \"\x969; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x969;\n"
|
||
"; Test error \"\x96A; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x96A;\n"
|
||
"; Test error \"\x96B; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x96B;\n"
|
||
"; Test error \"\x96C; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x96C;\n"
|
||
"; Test error \"\x96D; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x96D;\n"
|
||
"; Test error \"\x96E; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x96E;\n"
|
||
"; Test error \"\x96F; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x96F;\n"
|
||
"; Test error \"\x982; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x982;\n"
|
||
"; Test error \"\x983; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x983;\n"
|
||
"; Test error \"\x9BE; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x9BE;\n"
|
||
"; Test error \"\x9BF; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x9BF;\n"
|
||
"; Test error \"\x9C0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x9C0;\n"
|
||
"; Test error \"\x9C7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x9C7;\n"
|
||
"; Test error \"\x9C8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x9C8;\n"
|
||
"; Test error \"\x9CB; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x9CB;\n"
|
||
"; Test error \"\x9CC; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x9CC;\n"
|
||
"; Test error \"\x9D7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x9D7;\n"
|
||
"; Test error \"\x9E6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x9E6;\n"
|
||
"; Test error \"\x9E7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x9E7;\n"
|
||
"; Test error \"\x9E8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x9E8;\n"
|
||
"; Test error \"\x9E9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x9E9;\n"
|
||
"; Test error \"\x9EA; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x9EA;\n"
|
||
"; Test error \"\x9EB; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x9EB;\n"
|
||
"; Test error \"\x9EC; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x9EC;\n"
|
||
"; Test error \"\x9ED; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x9ED;\n"
|
||
"; Test error \"\x9EE; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x9EE;\n"
|
||
"; Test error \"\x9EF; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x9EF;\n"
|
||
"; Test error \"\xA03; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA03;\n"
|
||
"; Test error \"\xA3E; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA3E;\n"
|
||
"; Test error \"\xA3F; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA3F;\n"
|
||
"; Test error \"\xA40; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA40;\n"
|
||
"; Test error \"\xA66; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA66;\n"
|
||
"; Test error \"\xA67; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA67;\n"
|
||
"; Test error \"\xA68; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA68;\n"
|
||
"; Test error \"\xA69; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA69;\n"
|
||
"; Test error \"\xA6A; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA6A;\n"
|
||
"; Test error \"\xA6B; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA6B;\n"
|
||
"; Test error \"\xA6C; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA6C;\n"
|
||
"; Test error \"\xA6D; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA6D;\n"
|
||
"; Test error \"\xA6E; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA6E;\n"
|
||
"; Test error \"\xA6F; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA6F;\n"
|
||
"; Test error \"\xA83; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA83;\n"
|
||
"; Test error \"\xABE; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xABE;\n"
|
||
"; Test error \"\xABF; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xABF;\n"
|
||
"; Test error \"\xAC0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAC0;\n"
|
||
"; Test error \"\xAC9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAC9;\n"
|
||
"; Test error \"\xACB; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xACB;\n"
|
||
"; Test error \"\xACC; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xACC;\n"
|
||
"; Test error \"\xAE6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAE6;\n"
|
||
"; Test error \"\xAE7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAE7;\n"
|
||
"; Test error \"\xAE8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAE8;\n"
|
||
"; Test error \"\xAE9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAE9;\n"
|
||
"; Test error \"\xAEA; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAEA;\n"
|
||
"; Test error \"\xAEB; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAEB;\n"
|
||
"; Test error \"\xAEC; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAEC;\n"
|
||
"; Test error \"\xAED; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAED;\n"
|
||
"; Test error \"\xAEE; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAEE;\n"
|
||
"; Test error \"\xAEF; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAEF;\n"
|
||
"; Test error \"\xB02; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB02;\n"
|
||
"; Test error \"\xB03; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB03;\n"
|
||
"; Test error \"\xB3E; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB3E;\n"
|
||
"; Test error \"\xB40; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB40;\n"
|
||
"; Test error \"\xB47; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB47;\n"
|
||
"; Test error \"\xB48; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB48;\n"
|
||
"; Test error \"\xB4B; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB4B;\n"
|
||
"; Test error \"\xB4C; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB4C;\n"
|
||
"; Test error \"\xB57; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB57;\n"
|
||
"; Test error \"\xB66; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB66;\n"
|
||
"; Test error \"\xB67; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB67;\n"
|
||
"; Test error \"\xB68; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB68;\n"
|
||
"; Test error \"\xB69; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB69;\n"
|
||
"; Test error \"\xB6A; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB6A;\n"
|
||
"; Test error \"\xB6B; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB6B;\n"
|
||
"; Test error \"\xB6C; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB6C;\n"
|
||
"; Test error \"\xB6D; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB6D;\n"
|
||
"; Test error \"\xB6E; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB6E;\n"
|
||
"; Test error \"\xB6F; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB6F;\n"
|
||
"; Test error \"\xBBE; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBBE;\n"
|
||
"; Test error \"\xBBF; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBBF;\n"
|
||
"; Test error \"\xBC1; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBC1;\n"
|
||
"; Test error \"\xBC2; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBC2;\n"
|
||
"; Test error \"\xBC6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBC6;\n"
|
||
"; Test error \"\xBC7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBC7;\n"
|
||
"; Test error \"\xBC8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBC8;\n"
|
||
"; Test error \"\xBCA; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBCA;\n"
|
||
"; Test error \"\xBCB; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBCB;\n"
|
||
"; Test error \"\xBCC; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBCC;\n"
|
||
"; Test error \"\xBD7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBD7;\n"
|
||
"; Test error \"\xBE6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBE6;\n"
|
||
"; Test error \"\xBE7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBE7;\n"
|
||
"; Test error \"\xBE8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBE8;\n"
|
||
"; Test error \"\xBE9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBE9;\n"
|
||
"; Test error \"\xBEA; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBEA;\n"
|
||
"; Test error \"\xBEB; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBEB;\n"
|
||
"; Test error \"\xBEC; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBEC;\n"
|
||
"; Test error \"\xBED; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBED;\n"
|
||
"; Test error \"\xBEE; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBEE;\n"
|
||
"; Test error \"\xBEF; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBEF;\n"
|
||
"; Test error \"\xC01; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC01;\n"
|
||
"; Test error \"\xC02; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC02;\n"
|
||
"; Test error \"\xC03; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC03;\n"
|
||
"; Test error \"\xC41; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC41;\n"
|
||
"; Test error \"\xC42; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC42;\n"
|
||
"; Test error \"\xC43; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC43;\n"
|
||
"; Test error \"\xC44; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC44;\n"
|
||
"; Test error \"\xC66; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC66;\n"
|
||
"; Test error \"\xC67; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC67;\n"
|
||
"; Test error \"\xC68; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC68;\n"
|
||
"; Test error \"\xC69; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC69;\n"
|
||
"; Test error \"\xC6A; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC6A;\n"
|
||
"; Test error \"\xC6B; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC6B;\n"
|
||
"; Test error \"\xC6C; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC6C;\n"
|
||
"; Test error \"\xC6D; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC6D;\n"
|
||
"; Test error \"\xC6E; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC6E;\n"
|
||
"; Test error \"\xC6F; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC6F;\n"
|
||
"; Test error \"\xC82; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC82;\n"
|
||
"; Test error \"\xC83; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC83;\n"
|
||
"; Test error \"\xCBE; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCBE;\n"
|
||
"; Test error \"\xCC0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCC0;\n"
|
||
"; Test error \"\xCC1; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCC1;\n"
|
||
"; Test error \"\xCC2; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCC2;\n"
|
||
"; Test error \"\xCC3; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCC3;\n"
|
||
"; Test error \"\xCC4; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCC4;\n"
|
||
"; Test error \"\xCC7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCC7;\n"
|
||
"; Test error \"\xCC8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCC8;\n"
|
||
"; Test error \"\xCCA; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCCA;\n"
|
||
"; Test error \"\xCCB; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCCB;\n"
|
||
"; Test error \"\xCD5; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCD5;\n"
|
||
"; Test error \"\xCD6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCD6;\n"
|
||
"; Test error \"\xCE6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCE6;\n"
|
||
"; Test error \"\xCE7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCE7;\n"
|
||
"; Test error \"\xCE8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCE8;\n"
|
||
"; Test error \"\xCE9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCE9;\n"
|
||
"; Test error \"\xCEA; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCEA;\n"
|
||
"; Test error \"\xCEB; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCEB;\n"
|
||
"; Test error \"\xCEC; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCEC;\n"
|
||
"; Test error \"\xCED; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCED;\n"
|
||
"; Test error \"\xCEE; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCEE;\n"
|
||
"; Test error \"\xCEF; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCEF;\n"
|
||
"; Test error \"\xD02; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD02;\n"
|
||
"; Test error \"\xD03; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD03;\n"
|
||
"; Test error \"\xD3E; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD3E;\n"
|
||
"; Test error \"\xD3F; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD3F;\n"
|
||
"; Test error \"\xD40; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD40;\n"
|
||
"; Test error \"\xD46; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD46;\n"
|
||
"; Test error \"\xD47; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD47;\n"
|
||
"; Test error \"\xD48; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD48;\n"
|
||
"; Test error \"\xD4A; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD4A;\n"
|
||
"; Test error \"\xD4B; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD4B;\n"
|
||
"; Test error \"\xD4C; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD4C;\n"
|
||
"; Test error \"\xD57; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD57;\n"
|
||
"; Test error \"\xD66; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD66;\n"
|
||
"; Test error \"\xD67; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD67;\n"
|
||
"; Test error \"\xD68; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD68;\n"
|
||
"; Test error \"\xD69; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD69;\n"
|
||
"; Test error \"\xD6A; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD6A;\n"
|
||
"; Test error \"\xD6B; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD6B;\n"
|
||
"; Test error \"\xD6C; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD6C;\n"
|
||
"; Test error \"\xD6D; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD6D;\n"
|
||
"; Test error \"\xD6E; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD6E;\n"
|
||
"; Test error \"\xD6F; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD6F;\n"
|
||
"; Test error \"\xD82; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD82;\n"
|
||
"; Test error \"\xD83; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD83;\n"
|
||
"; Test error \"\xDCF; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xDCF;\n"
|
||
"; Test error \"\xDD0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xDD0;\n"
|
||
"; Test error \"\xDD1; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xDD1;\n"
|
||
"; Test error \"\xDD8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xDD8;\n"
|
||
"; Test error \"\xDD9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xDD9;\n"
|
||
"; Test error \"\xDDA; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xDDA;\n"
|
||
"; Test error \"\xDDB; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xDDB;\n"
|
||
"; Test error \"\xDDC; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xDDC;\n"
|
||
"; Test error \"\xDDD; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xDDD;\n"
|
||
"; Test error \"\xDDE; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xDDE;\n"
|
||
"; Test error \"\xDDF; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xDDF;\n"
|
||
"; Test error \"\xDF2; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xDF2;\n"
|
||
"; Test error \"\xDF3; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xDF3;\n"
|
||
"; Test error \"\xE50; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xE50;\n"
|
||
"; Test error \"\xE51; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xE51;\n"
|
||
"; Test error \"\xE52; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xE52;\n"
|
||
"; Test error \"\xE53; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xE53;\n"
|
||
"; Test error \"\xE54; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xE54;\n"
|
||
"; Test error \"\xE55; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xE55;\n"
|
||
"; Test error \"\xE56; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xE56;\n"
|
||
"; Test error \"\xE57; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xE57;\n"
|
||
"; Test error \"\xE58; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xE58;\n"
|
||
"; Test error \"\xE59; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xE59;\n"
|
||
"; Test error \"\xED0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xED0;\n"
|
||
"; Test error \"\xED1; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xED1;\n"
|
||
"; Test error \"\xED2; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xED2;\n"
|
||
"; Test error \"\xED3; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xED3;\n"
|
||
"; Test error \"\xED4; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xED4;\n"
|
||
"; Test error \"\xED5; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xED5;\n"
|
||
"; Test error \"\xED6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xED6;\n"
|
||
"; Test error \"\xED7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xED7;\n"
|
||
"; Test error \"\xED8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xED8;\n"
|
||
"; Test error \"\xED9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xED9;\n"
|
||
"; Test error \"\xF20; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xF20;\n"
|
||
"; Test error \"\xF21; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xF21;\n"
|
||
"; Test error \"\xF22; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xF22;\n"
|
||
"; Test error \"\xF23; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xF23;\n"
|
||
"; Test error \"\xF24; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xF24;\n"
|
||
"; Test error \"\xF25; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xF25;\n"
|
||
"; Test error \"\xF26; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xF26;\n"
|
||
"; Test error \"\xF27; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xF27;\n"
|
||
"; Test error \"\xF28; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xF28;\n"
|
||
"; Test error \"\xF29; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xF29;\n"
|
||
"; Test error \"\xF3E; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xF3E;\n"
|
||
"; Test error \"\xF3F; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xF3F;\n"
|
||
"; Test error \"\xF7F; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xF7F;\n"
|
||
"; Test error \"\x102B; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x102B;\n"
|
||
"; Test error \"\x102C; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x102C;\n"
|
||
"; Test error \"\x1031; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1031;\n"
|
||
"; Test error \"\x1038; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1038;\n"
|
||
"; Test error \"\x103B; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x103B;\n"
|
||
"; Test error \"\x103C; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x103C;\n"
|
||
"; Test error \"\x1040; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1040;\n"
|
||
"; Test error \"\x1041; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1041;\n"
|
||
"; Test error \"\x1042; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1042;\n"
|
||
"; Test error \"\x1043; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1043;\n"
|
||
"; Test error \"\x1044; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1044;\n"
|
||
"; Test error \"\x1045; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1045;\n"
|
||
"; Test error \"\x1046; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1046;\n"
|
||
"; Test error \"\x1047; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1047;\n"
|
||
"; Test error \"\x1048; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1048;\n"
|
||
"; Test error \"\x1049; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1049;\n"
|
||
"; Test error \"\x1056; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1056;\n"
|
||
"; Test error \"\x1057; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1057;\n"
|
||
"; Test error \"\x1062; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1062;\n"
|
||
"; Test error \"\x1063; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1063;\n"
|
||
"; Test error \"\x1064; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1064;\n"
|
||
"; Test error \"\x1067; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1067;\n"
|
||
"; Test error \"\x1068; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1068;\n"
|
||
"; Test error \"\x1069; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1069;\n"
|
||
"; Test error \"\x106A; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x106A;\n"
|
||
"; Test error \"\x106B; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x106B;\n"
|
||
"; Test error \"\x106C; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x106C;\n"
|
||
"; Test error \"\x106D; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x106D;\n"
|
||
"; Test error \"\x1083; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1083;\n"
|
||
"; Test error \"\x1084; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1084;\n"
|
||
"; Test error \"\x1087; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1087;\n"
|
||
"; Test error \"\x1088; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1088;\n"
|
||
"; Test error \"\x1089; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1089;\n"
|
||
"; Test error \"\x108A; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x108A;\n"
|
||
"; Test error \"\x108B; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x108B;\n"
|
||
"; Test error \"\x108C; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x108C;\n"
|
||
"; Test error \"\x108F; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x108F;\n"
|
||
"; Test error \"\x1090; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1090;\n"
|
||
"; Test error \"\x1091; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1091;\n"
|
||
"; Test error \"\x1092; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1092;\n"
|
||
"; Test error \"\x1093; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1093;\n"
|
||
"; Test error \"\x1094; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1094;\n"
|
||
"; Test error \"\x1095; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1095;\n"
|
||
"; Test error \"\x1096; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1096;\n"
|
||
"; Test error \"\x1097; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1097;\n"
|
||
"; Test error \"\x1098; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1098;\n"
|
||
"; Test error \"\x1099; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1099;\n"
|
||
"; Test error \"\x17B6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17B6;\n"
|
||
"; Test error \"\x17BE; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17BE;\n"
|
||
"; Test error \"\x17BF; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17BF;\n"
|
||
"; Test error \"\x17C0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17C0;\n"
|
||
"; Test error \"\x17C1; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17C1;\n"
|
||
"; Test error \"\x17C2; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17C2;\n"
|
||
"; Test error \"\x17C3; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17C3;\n"
|
||
"; Test error \"\x17C4; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17C4;\n"
|
||
"; Test error \"\x17C5; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17C5;\n"
|
||
"; Test error \"\x17C7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17C7;\n"
|
||
"; Test error \"\x17C8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17C8;\n"
|
||
"; Test error \"\x17E0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17E0;\n"
|
||
"; Test error \"\x17E1; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17E1;\n"
|
||
"; Test error \"\x17E2; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17E2;\n"
|
||
"; Test error \"\x17E3; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17E3;\n"
|
||
"; Test error \"\x17E4; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17E4;\n"
|
||
"; Test error \"\x17E5; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17E5;\n"
|
||
"; Test error \"\x17E6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17E6;\n"
|
||
"; Test error \"\x17E7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17E7;\n"
|
||
"; Test error \"\x17E8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17E8;\n"
|
||
"; Test error \"\x17E9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17E9;\n"
|
||
"; Test error \"\x1810; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1810;\n"
|
||
"; Test error \"\x1811; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1811;\n"
|
||
"; Test error \"\x1812; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1812;\n"
|
||
"; Test error \"\x1813; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1813;\n"
|
||
"; Test error \"\x1814; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1814;\n"
|
||
"; Test error \"\x1815; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1815;\n"
|
||
"; Test error \"\x1816; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1816;\n"
|
||
"; Test error \"\x1817; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1817;\n"
|
||
"; Test error \"\x1818; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1818;\n"
|
||
"; Test error \"\x1819; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1819;\n"
|
||
"; Test error \"\x1923; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1923;\n"
|
||
"; Test error \"\x1924; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1924;\n"
|
||
"; Test error \"\x1925; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1925;\n"
|
||
"; Test error \"\x1926; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1926;\n"
|
||
"; Test error \"\x1929; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1929;\n"
|
||
"; Test error \"\x192A; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x192A;\n"
|
||
"; Test error \"\x192B; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x192B;\n"
|
||
"; Test error \"\x1930; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1930;\n"
|
||
"; Test error \"\x1931; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1931;\n"
|
||
"; Test error \"\x1933; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1933;\n"
|
||
"; Test error \"\x1934; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1934;\n"
|
||
"; Test error \"\x1935; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1935;\n"
|
||
"; Test error \"\x1936; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1936;\n"
|
||
"; Test error \"\x1937; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1937;\n"
|
||
"; Test error \"\x1938; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1938;\n"
|
||
"; Test error \"\x1946; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1946;\n"
|
||
"; Test error \"\x1947; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1947;\n"
|
||
"; Test error \"\x1948; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1948;\n"
|
||
"; Test error \"\x1949; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1949;\n"
|
||
"; Test error \"\x194A; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x194A;\n"
|
||
"; Test error \"\x194B; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x194B;\n"
|
||
"; Test error \"\x194C; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x194C;\n"
|
||
"; Test error \"\x194D; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x194D;\n"
|
||
"; Test error \"\x194E; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x194E;\n"
|
||
"; Test error \"\x194F; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x194F;\n"
|
||
"; Test error \"\x19B0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19B0;\n"
|
||
"; Test error \"\x19B1; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19B1;\n"
|
||
"; Test error \"\x19B2; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19B2;\n"
|
||
"; Test error \"\x19B3; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19B3;\n"
|
||
"; Test error \"\x19B4; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19B4;\n"
|
||
"; Test error \"\x19B5; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19B5;\n"
|
||
"; Test error \"\x19B6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19B6;\n"
|
||
"; Test error \"\x19B7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19B7;\n"
|
||
"; Test error \"\x19B8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19B8;\n"
|
||
"; Test error \"\x19B9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19B9;\n"
|
||
"; Test error \"\x19BA; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19BA;\n"
|
||
"; Test error \"\x19BB; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19BB;\n"
|
||
"; Test error \"\x19BC; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19BC;\n"
|
||
"; Test error \"\x19BD; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19BD;\n"
|
||
"; Test error \"\x19BE; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19BE;\n"
|
||
"; Test error \"\x19BF; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19BF;\n"
|
||
"; Test error \"\x19C0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19C0;\n"
|
||
"; Test error \"\x19C8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19C8;\n"
|
||
"; Test error \"\x19C9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19C9;\n"
|
||
"; Test error \"\x19D0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19D0;\n"
|
||
"; Test error \"\x19D1; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19D1;\n"
|
||
"; Test error \"\x19D2; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19D2;\n"
|
||
"; Test error \"\x19D3; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19D3;\n"
|
||
"; Test error \"\x19D4; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19D4;\n"
|
||
"; Test error \"\x19D5; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19D5;\n"
|
||
"; Test error \"\x19D6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19D6;\n"
|
||
"; Test error \"\x19D7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19D7;\n"
|
||
"; Test error \"\x19D8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19D8;\n"
|
||
"; Test error \"\x19D9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19D9;\n"
|
||
"; Test error \"\x1A19; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1A19;\n"
|
||
"; Test error \"\x1A1A; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1A1A;\n"
|
||
#;"; Test error \"\x1A1B; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1A1B;\n" ; switched from Mc to Mn in Unicode 7.0
|
||
"; Test error \"\x1B04; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B04;\n"
|
||
"; Test error \"\x1B35; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B35;\n"
|
||
"; Test error \"\x1B3B; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B3B;\n"
|
||
"; Test error \"\x1B3D; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B3D;\n"
|
||
"; Test error \"\x1B3E; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B3E;\n"
|
||
"; Test error \"\x1B3F; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B3F;\n"
|
||
"; Test error \"\x1B40; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B40;\n"
|
||
"; Test error \"\x1B41; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B41;\n"
|
||
"; Test error \"\x1B43; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B43;\n"
|
||
"; Test error \"\x1B44; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B44;\n"
|
||
"; Test error \"\x1B50; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B50;\n"
|
||
"; Test error \"\x1B51; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B51;\n"
|
||
"; Test error \"\x1B52; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B52;\n"
|
||
"; Test error \"\x1B53; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B53;\n"
|
||
"; Test error \"\x1B54; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B54;\n"
|
||
"; Test error \"\x1B55; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B55;\n"
|
||
"; Test error \"\x1B56; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B56;\n"
|
||
"; Test error \"\x1B57; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B57;\n"
|
||
"; Test error \"\x1B58; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B58;\n"
|
||
"; Test error \"\x1B59; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B59;\n"
|
||
"; Test error \"\x1B82; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B82;\n"
|
||
"; Test error \"\x1BA1; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1BA1;\n"
|
||
"; Test error \"\x1BA6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1BA6;\n"
|
||
"; Test error \"\x1BA7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1BA7;\n"
|
||
"; Test error \"\x1BAA; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1BAA;\n"
|
||
"; Test error \"\x1BB0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1BB0;\n"
|
||
"; Test error \"\x1BB1; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1BB1;\n"
|
||
"; Test error \"\x1BB2; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1BB2;\n"
|
||
"; Test error \"\x1BB3; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1BB3;\n"
|
||
"; Test error \"\x1BB4; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1BB4;\n"
|
||
"; Test error \"\x1BB5; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1BB5;\n"
|
||
"; Test error \"\x1BB6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1BB6;\n"
|
||
"; Test error \"\x1BB7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1BB7;\n"
|
||
"; Test error \"\x1BB8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1BB8;\n"
|
||
"; Test error \"\x1BB9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1BB9;\n"
|
||
"; Test error \"\x1C24; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C24;\n"
|
||
"; Test error \"\x1C25; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C25;\n"
|
||
"; Test error \"\x1C26; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C26;\n"
|
||
"; Test error \"\x1C27; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C27;\n"
|
||
"; Test error \"\x1C28; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C28;\n"
|
||
"; Test error \"\x1C29; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C29;\n"
|
||
"; Test error \"\x1C2A; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C2A;\n"
|
||
"; Test error \"\x1C2B; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C2B;\n"
|
||
"; Test error \"\x1C34; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C34;\n"
|
||
"; Test error \"\x1C35; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C35;\n"
|
||
"; Test error \"\x1C40; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C40;\n"
|
||
"; Test error \"\x1C41; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C41;\n"
|
||
"; Test error \"\x1C42; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C42;\n"
|
||
"; Test error \"\x1C43; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C43;\n"
|
||
"; Test error \"\x1C44; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C44;\n"
|
||
"; Test error \"\x1C45; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C45;\n"
|
||
"; Test error \"\x1C46; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C46;\n"
|
||
"; Test error \"\x1C47; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C47;\n"
|
||
"; Test error \"\x1C48; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C48;\n"
|
||
"; Test error \"\x1C49; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C49;\n"
|
||
"; Test error \"\x1C50; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C50;\n"
|
||
"; Test error \"\x1C51; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C51;\n"
|
||
"; Test error \"\x1C52; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C52;\n"
|
||
"; Test error \"\x1C53; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C53;\n"
|
||
"; Test error \"\x1C54; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C54;\n"
|
||
"; Test error \"\x1C55; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C55;\n"
|
||
"; Test error \"\x1C56; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C56;\n"
|
||
"; Test error \"\x1C57; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C57;\n"
|
||
"; Test error \"\x1C58; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C58;\n"
|
||
"; Test error \"\x1C59; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C59;\n"
|
||
"; Test error \"\x20DD; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x20DD;\n"
|
||
"; Test error \"\x20DE; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x20DE;\n"
|
||
"; Test error \"\x20DF; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x20DF;\n"
|
||
"; Test error \"\x20E0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x20E0;\n"
|
||
"; Test error \"\x20E2; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x20E2;\n"
|
||
"; Test error \"\x20E3; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x20E3;\n"
|
||
"; Test error \"\x20E4; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x20E4;\n"
|
||
"; Test error \"\xA620; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA620;\n"
|
||
"; Test error \"\xA621; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA621;\n"
|
||
"; Test error \"\xA622; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA622;\n"
|
||
"; Test error \"\xA623; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA623;\n"
|
||
"; Test error \"\xA624; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA624;\n"
|
||
"; Test error \"\xA625; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA625;\n"
|
||
"; Test error \"\xA626; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA626;\n"
|
||
"; Test error \"\xA627; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA627;\n"
|
||
"; Test error \"\xA628; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA628;\n"
|
||
"; Test error \"\xA629; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA629;\n"
|
||
"; Test error \"\xA670; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA670;\n"
|
||
"; Test error \"\xA671; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA671;\n"
|
||
"; Test error \"\xA672; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA672;\n"
|
||
"; Test error \"\xA823; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA823;\n"
|
||
"; Test error \"\xA824; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA824;\n"
|
||
"; Test error \"\xA827; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA827;\n"
|
||
"; Test error \"\xA880; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA880;\n"
|
||
"; Test error \"\xA881; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA881;\n"
|
||
"; Test error \"\xA8B4; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8B4;\n"
|
||
"; Test error \"\xA8B5; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8B5;\n"
|
||
"; Test error \"\xA8B6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8B6;\n"
|
||
"; Test error \"\xA8B7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8B7;\n"
|
||
"; Test error \"\xA8B8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8B8;\n"
|
||
"; Test error \"\xA8B9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8B9;\n"
|
||
"; Test error \"\xA8BA; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8BA;\n"
|
||
"; Test error \"\xA8BB; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8BB;\n"
|
||
"; Test error \"\xA8BC; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8BC;\n"
|
||
"; Test error \"\xA8BD; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8BD;\n"
|
||
"; Test error \"\xA8BE; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8BE;\n"
|
||
"; Test error \"\xA8BF; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8BF;\n"
|
||
"; Test error \"\xA8C0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8C0;\n"
|
||
"; Test error \"\xA8C1; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8C1;\n"
|
||
"; Test error \"\xA8C2; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8C2;\n"
|
||
"; Test error \"\xA8C3; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8C3;\n"
|
||
"; Test error \"\xA8D0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8D0;\n"
|
||
"; Test error \"\xA8D1; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8D1;\n"
|
||
"; Test error \"\xA8D2; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8D2;\n"
|
||
"; Test error \"\xA8D3; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8D3;\n"
|
||
"; Test error \"\xA8D4; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8D4;\n"
|
||
"; Test error \"\xA8D5; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8D5;\n"
|
||
"; Test error \"\xA8D6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8D6;\n"
|
||
"; Test error \"\xA8D7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8D7;\n"
|
||
"; Test error \"\xA8D8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8D8;\n"
|
||
"; Test error \"\xA8D9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8D9;\n"
|
||
"; Test error \"\xA900; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA900;\n"
|
||
"; Test error \"\xA901; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA901;\n"
|
||
"; Test error \"\xA902; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA902;\n"
|
||
"; Test error \"\xA903; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA903;\n"
|
||
"; Test error \"\xA904; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA904;\n"
|
||
"; Test error \"\xA905; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA905;\n"
|
||
"; Test error \"\xA906; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA906;\n"
|
||
"; Test error \"\xA907; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA907;\n"
|
||
"; Test error \"\xA908; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA908;\n"
|
||
"; Test error \"\xA909; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA909;\n"
|
||
"; Test error \"\xA952; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA952;\n"
|
||
"; Test error \"\xA953; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA953;\n"
|
||
"; Test error \"\xAA2F; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAA2F;\n"
|
||
"; Test error \"\xAA30; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAA30;\n"
|
||
"; Test error \"\xAA33; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAA33;\n"
|
||
"; Test error \"\xAA34; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAA34;\n"
|
||
"; Test error \"\xAA4D; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAA4D;\n"
|
||
"; Test error \"\xAA50; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAA50;\n"
|
||
"; Test error \"\xAA51; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAA51;\n"
|
||
"; Test error \"\xAA52; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAA52;\n"
|
||
"; Test error \"\xAA53; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAA53;\n"
|
||
"; Test error \"\xAA54; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAA54;\n"
|
||
"; Test error \"\xAA55; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAA55;\n"
|
||
"; Test error \"\xAA56; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAA56;\n"
|
||
"; Test error \"\xAA57; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAA57;\n"
|
||
"; Test error \"\xAA58; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAA58;\n"
|
||
"; Test error \"\xAA59; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAA59;\n"
|
||
"; Test error \"\xFF10; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xFF10;\n"
|
||
"; Test error \"\xFF11; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xFF11;\n"
|
||
"; Test error \"\xFF12; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xFF12;\n"
|
||
"; Test error \"\xFF13; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xFF13;\n"
|
||
"; Test error \"\xFF14; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xFF14;\n"
|
||
"; Test error \"\xFF15; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xFF15;\n"
|
||
"; Test error \"\xFF16; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xFF16;\n"
|
||
"; Test error \"\xFF17; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xFF17;\n"
|
||
"; Test error \"\xFF18; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xFF18;\n"
|
||
"; Test error \"\xFF19; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xFF19;\n"
|
||
"; Test error \"\x104A0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x104A0;\n"
|
||
"; Test error \"\x104A1; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x104A1;\n"
|
||
"; Test error \"\x104A2; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x104A2;\n"
|
||
"; Test error \"\x104A3; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x104A3;\n"
|
||
"; Test error \"\x104A4; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x104A4;\n"
|
||
"; Test error \"\x104A5; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x104A5;\n"
|
||
"; Test error \"\x104A6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x104A6;\n"
|
||
"; Test error \"\x104A7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x104A7;\n"
|
||
"; Test error \"\x104A8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x104A8;\n"
|
||
"; Test error \"\x104A9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x104A9;\n"
|
||
"; Test error \"\x1D165; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D165;\n"
|
||
"; Test error \"\x1D166; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D166;\n"
|
||
"; Test error \"\x1D16D; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D16D;\n"
|
||
"; Test error \"\x1D16E; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D16E;\n"
|
||
"; Test error \"\x1D16F; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D16F;\n"
|
||
"; Test error \"\x1D170; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D170;\n"
|
||
"; Test error \"\x1D171; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D171;\n"
|
||
"; Test error \"\x1D172; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D172;\n"
|
||
"; Test error \"\x1D7CE; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7CE;\n"
|
||
"; Test error \"\x1D7CF; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7CF;\n"
|
||
"; Test error \"\x1D7D0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7D0;\n"
|
||
"; Test error \"\x1D7D1; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7D1;\n"
|
||
"; Test error \"\x1D7D2; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7D2;\n"
|
||
"; Test error \"\x1D7D3; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7D3;\n"
|
||
"; Test error \"\x1D7D4; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7D4;\n"
|
||
"; Test error \"\x1D7D5; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7D5;\n"
|
||
"; Test error \"\x1D7D6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7D6;\n"
|
||
"; Test error \"\x1D7D7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7D7;\n"
|
||
"; Test error \"\x1D7D8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7D8;\n"
|
||
"; Test error \"\x1D7D9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7D9;\n"
|
||
"; Test error \"\x1D7DA; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7DA;\n"
|
||
"; Test error \"\x1D7DB; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7DB;\n"
|
||
"; Test error \"\x1D7DC; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7DC;\n"
|
||
"; Test error \"\x1D7DD; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7DD;\n"
|
||
"; Test error \"\x1D7DE; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7DE;\n"
|
||
"; Test error \"\x1D7DF; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7DF;\n"
|
||
"; Test error \"\x1D7E0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7E0;\n"
|
||
"; Test error \"\x1D7E1; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7E1;\n"
|
||
"; Test error \"\x1D7E2; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7E2;\n"
|
||
"; Test error \"\x1D7E3; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7E3;\n"
|
||
"; Test error \"\x1D7E4; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7E4;\n"
|
||
"; Test error \"\x1D7E5; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7E5;\n"
|
||
"; Test error \"\x1D7E6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7E6;\n"
|
||
"; Test error \"\x1D7E7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7E7;\n"
|
||
"; Test error \"\x1D7E8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7E8;\n"
|
||
"; Test error \"\x1D7E9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7E9;\n"
|
||
"; Test error \"\x1D7EA; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7EA;\n"
|
||
"; Test error \"\x1D7EB; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7EB;\n"
|
||
"; Test error \"\x1D7EC; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7EC;\n"
|
||
"; Test error \"\x1D7ED; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7ED;\n"
|
||
"; Test error \"\x1D7EE; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7EE;\n"
|
||
"; Test error \"\x1D7EF; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7EF;\n"
|
||
"; Test error \"\x1D7F0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7F0;\n"
|
||
"; Test error \"\x1D7F1; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7F1;\n"
|
||
"; Test error \"\x1D7F2; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7F2;\n"
|
||
"; Test error \"\x1D7F3; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7F3;\n"
|
||
"; Test error \"\x1D7F4; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7F4;\n"
|
||
"; Test error \"\x1D7F5; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7F5;\n"
|
||
"; Test error \"\x1D7F6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7F6;\n"
|
||
"; Test error \"\x1D7F7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7F7;\n"
|
||
"; Test error \"\x1D7F8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7F8;\n"
|
||
"; Test error \"\x1D7F9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7F9;\n"
|
||
"; Test error \"\x1D7FA; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7FA;\n"
|
||
"; Test error \"\x1D7FB; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7FB;\n"
|
||
"; Test error \"\x1D7FC; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7FC;\n"
|
||
"; Test error \"\x1D7FD; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7FD;\n"
|
||
"; Test error \"\x1D7FE; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7FE;\n"
|
||
"; Test error \"\x1D7FF; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7FF;\n"
|
||
)
|
||
|
||
(mat record-annotation
|
||
; regression check: make sure annotations do not slip into records
|
||
; by way of graph references
|
||
(let ([p (open-output-file "testfile.ss" 'truncate)])
|
||
(display "(define-record #{%foo %bar} (x y))
|
||
(define $$rats (list '#0=(a b) #;'#1=(d e) '#[#{%foo %bar} #0# #1#]))
|
||
" p)
|
||
(close-output-port p)
|
||
#t)
|
||
(begin
|
||
(load "testfile.ss")
|
||
#t)
|
||
(record? (cadr $$rats) (type-descriptor #{%foo %bar}))
|
||
(let ([r (cadr $$rats)])
|
||
(eq? (%foo-x r) (car $$rats))
|
||
(equal? (%foo-y r) '(d e)))
|
||
)
|
||
|
||
(mat annotation-tests
|
||
(let ([x (read (open-input-string "#1=#2=(#1# . #2#)"))])
|
||
(and (eq? (car x) x) (eq? (cdr x) x)))
|
||
(let ([x (read (open-input-string "(#1=#1# . #1#)"))]
|
||
[y (read (open-input-string "#2=#2#"))])
|
||
(and (eq? (car x) (cdr x)) (eq? (car x) y)))
|
||
(vector? '#(annotation 3 #f 3))
|
||
(vector? (eval (read (open-input-string "'#(annotation #1=(a . #1#) #f #f)"))))
|
||
(load-test "(define-record #{$elmer fudd} (c))\n(define x '#[#{$elmer fudd} 3])\n")
|
||
(and ($elmer? x) (eq? ($elmer-c x) 3))
|
||
(compile-test "(define-record #{$bugs bunny} (c))\n(define x '#[#{$bugs bunny} 3])\n")
|
||
(and ($bugs? x) (eq? ($bugs-c x) 3))
|
||
(load-test "(define-syntax $kwote (lambda (x) `(,#'quote ,x)))\n(define $argh #1=($kwote . #1#))\n")
|
||
(eq? $argh (cdr $argh))
|
||
(compile-test "(define-syntax $kwoat (lambda (x) `(,#'quote ,x)))\n(define $argh #1=($kwoat #1#))\n")
|
||
(eq? $argh (cadr $argh))
|
||
(load-test "(define-syntax $quoat (lambda (x) `(,#'quote ,x)))\n(begin (define x #1=($quoat a)) (define y #1#))\n")
|
||
(eq? x y)
|
||
(load-test "(define x '#1=(17 . #1#))\n(define y '#1=#2=(#1# . #2#))\n(define z '(#1=#1# . #1#))\n(define w '#2=(#1# . #1=#2#))\n")
|
||
(and (eq? (car x) 17) (eq? (cdr x) x))
|
||
(and (eq? (car y) y) (eq? (cdr y) y))
|
||
(and (eq? (car z) (cdr z)) (eq? (car z) (read (open-input-string "#1=#1#"))))
|
||
(and (eq? (car w) w) (eq? (cdr w) w))
|
||
(compile-test "(define x1 '#1=(17 . #1#))\n(define y1 '#1=#2=(#1# . #2#))\n(define z1 '(#1=#1# . #1#))\n(define w1 '#2=(#1# . #1=#2#))\n")
|
||
(and (eq? (car x1) 17) (eq? (cdr x1) x1))
|
||
(and (eq? (car y1) y1) (eq? (cdr y1) y1))
|
||
(and (eq? (car z1) (cdr z1)) (eq? (car z1) (read (open-input-string "#1=#1#"))))
|
||
(and (eq? (car w1) w1) (eq? (cdr w1) w1))
|
||
(load-test "(define-record #{$eager beaver} ((immutable busy)))\n(define x '(#[#{$eager beaver} #1=(a b)] #1#))\n")
|
||
(and ($eager? (car x))
|
||
(equal? ($eager-busy (car x)) '(a b))
|
||
(eq? ($eager-busy (car x)) (cadr x)))
|
||
(compile-test "(define-record #{$beaver eager} ((immutable busy)))\n(define x '(#[#{$beaver eager} #1=(a b)] #1#))\n")
|
||
(and ($beaver? (car x))
|
||
(equal? ($beaver-busy (car x)) '(a b))
|
||
(eq? ($beaver-busy (car x)) (cadr x)))
|
||
; w/quote on record
|
||
(load-test "(define-record #{$tony tiger} ((immutable great!)))\n(define x (list '#[#{$tony tiger} #1=(a b)] '#1#))\n")
|
||
(and ($tony? (car x))
|
||
(equal? ($tony-great! (car x)) '(a b))
|
||
(eq? ($tony-great! (car x)) (cadr x)))
|
||
; missing quote on record; see if annotation still comes back
|
||
(load-test "(define-record #{$tiger tony} ((immutable great!)))\n(define x (list '#[#{$tiger tony} #1=(a b)] '#1#))\n")
|
||
(and ($tiger? (car x))
|
||
(equal? ($tiger-great! (car x)) '(a b))
|
||
(eq? ($tiger-great! (car x)) (cadr x)))
|
||
(load-test "(define-record #{$slow joe} ((double-float pokey)))\n(define x '#[#{$slow joe} 3.4])\n")
|
||
(and ($slow? x) (eqv? ($slow-pokey x) 3.4))
|
||
(load-test "(define-syntax $silly (syntax-rules () ((_ #(a b c) #2(d e)) (list 'a 'b 'c 'd 'e '#(a b c) '#2(d e) '#3(a b c) '#(d e)))))\n(define x ($silly #(#(1 2) #3(3 4 5) #()) #(#0() #3(#&8))))\n")
|
||
(equal?
|
||
x
|
||
'(#2(1 2)
|
||
#3(3 4 5)
|
||
#0()
|
||
#0()
|
||
#3(#&8)
|
||
#3(#2(1 2) #3(3 4 5) #0())
|
||
#2(#0() #3(#&8))
|
||
#3(#2(1 2) #3(3 4 5) #0())
|
||
#2(#0() #3(#&8))))
|
||
(load-test "(define-record #{james kirk} ((double-float girls)))\n(define x '(#2=253.5 . #[#{james kirk} #2#]))\n")
|
||
(and (= (car x) 253.5) (= (james-girls (cdr x)) 253.5))
|
||
(load-test "(define-syntax $peabrain (identifier-syntax (a 4) ((set! a b) (list a b))))\n(define x (+ $peabrain 1))\n(define y (set! $peabrain (* x $peabrain)))\n")
|
||
(and (equal? x 5) (equal? y '(4 20)))
|
||
)
|
||
|
||
(mat symbol-printing
|
||
(equal? (format "~s" '\#foo\|bar) "\\x23;foo\\x7C;bar")
|
||
(eq? '\x23;foo\x7C;bar '\#foo\|bar)
|
||
)
|
||
|
||
(mat with-source-path
|
||
(equal? (source-directories) '("."))
|
||
(equal?
|
||
(with-source-path 'test "I should not be here" list)
|
||
'("I should not be here"))
|
||
(equal?
|
||
(with-source-path 'test "/I/should/not/be/here" list)
|
||
'("/I/should/not/be/here"))
|
||
(equal?
|
||
(with-source-path 'test "fatfib.ss" list)
|
||
'("fatfib.ss"))
|
||
(equal?
|
||
(parameterize ([source-directories '("")])
|
||
(with-source-path 'test "fatfib.ss" list))
|
||
'("fatfib.ss"))
|
||
(error? ; Error in test: file "fatfib.ss" not found in source directories
|
||
(parameterize ([source-directories '("." ".")])
|
||
(with-source-path 'test "fatfib.ss" list)))
|
||
(error? ; Error in test: file "I should not be here" not found in source directories
|
||
(parameterize ([source-directories '("." "../examples")])
|
||
(with-source-path 'test "I should not be here" list)))
|
||
(equal?
|
||
(parameterize ([source-directories '("." "../examples")])
|
||
(with-source-path 'test "mat.ss" list))
|
||
'("mat.ss"))
|
||
(equal?
|
||
(with-source-path 'test "mat.ss" list)
|
||
'("mat.ss"))
|
||
(equal?
|
||
(parameterize ([source-directories '("" "../examples")])
|
||
(with-source-path 'test "mat.ss" list))
|
||
'("mat.ss"))
|
||
(error? ; Error in test: file "mat.ss" not found in source directories
|
||
(parameterize ([source-directories '()])
|
||
(with-source-path 'test "mat.ss" list)))
|
||
(error? ; Error in test: file "mat.ss" not found in source directories
|
||
(parameterize ([source-directories '("../examples")])
|
||
(with-source-path 'test "mat.ss" list)))
|
||
(equal?
|
||
(parameterize ([source-directories '("." "../examples")])
|
||
(with-source-path 'test "fatfib.ss" list))
|
||
'("../examples/fatfib.ss"))
|
||
(equal?
|
||
(parameterize ([source-directories '("." "../examples")])
|
||
(with-source-path 'test "./fatfib.ss" list))
|
||
'("./fatfib.ss"))
|
||
(begin
|
||
(parameterize ([source-directories '("." "../examples")])
|
||
(load "fatfib.ss" compile))
|
||
(procedure? fatfib))
|
||
(equal? ((inspect/object fatfib) 'type) 'procedure)
|
||
(equal?
|
||
(call-with-values
|
||
(lambda () (((inspect/object fatfib) 'code) 'source-path))
|
||
list)
|
||
'("../examples/fatfib.ss" 16 4))
|
||
(equal?
|
||
(parameterize ([source-directories '("." "../examples")])
|
||
(call-with-values
|
||
(lambda () (((inspect/object fatfib) 'code) 'source-path))
|
||
list))
|
||
'("../examples/fatfib.ss" 16 4))
|
||
(begin
|
||
(load "../examples/fatfib.ss" compile)
|
||
(procedure? fatfib))
|
||
(equal? ((inspect/object fatfib) 'type) 'procedure)
|
||
(equal?
|
||
(call-with-values
|
||
(lambda () (((inspect/object fatfib) 'code) 'source-path))
|
||
list)
|
||
'("../examples/fatfib.ss" 16 4))
|
||
(or (windows?)
|
||
(equal?
|
||
(parameterize ([cd "/"] [source-directories (list (cd))])
|
||
(call-with-values
|
||
(lambda () (((inspect/object fatfib) 'code) 'source-path))
|
||
list))
|
||
(list (format "~a/../examples/fatfib.ss" (cd)) 16 4)))
|
||
(begin
|
||
(parameterize ([source-directories (list (parameterize ([cd ".."]) (cd)))])
|
||
(load "examples/fatfib.ss" compile))
|
||
(procedure? fatfib))
|
||
(equal? ((inspect/object fatfib) 'type) 'procedure)
|
||
(equal?
|
||
(call-with-values
|
||
(lambda () (((inspect/object fatfib) 'code) 'source-path))
|
||
(lambda (x y z) (list (path-last x) y z)))
|
||
'("fatfib.ss" 16 4))
|
||
(equal?
|
||
(parameterize ([source-directories (list (parameterize ([cd ".."]) (cd)))])
|
||
(call-with-values
|
||
(lambda () (((inspect/object fatfib) 'code) 'source-path))
|
||
list))
|
||
(list (format "~a/examples/fatfib.ss" (parameterize ([cd ".."]) (cd))) 16 4))
|
||
(equal?
|
||
(parameterize ([cd ".."] [source-directories '("examples")])
|
||
(call-with-values
|
||
(lambda () (((inspect/object fatfib) 'code) 'source-path))
|
||
(lambda (x y z) (list (path-last x) y z))))
|
||
'("fatfib.ss" 16 4))
|
||
(or (windows?) (embedded?)
|
||
(begin
|
||
(system "ln -s ../examples .")
|
||
(load "examples/fatfib.ss" compile)
|
||
(system "/bin/rm examples")
|
||
#t))
|
||
(or (windows?) (embedded?)
|
||
(equal?
|
||
(call-with-values
|
||
(lambda () (((inspect/object fatfib) 'code) 'source-path))
|
||
list)
|
||
'("examples/fatfib.ss" 359)))
|
||
(or (windows?) (embedded?)
|
||
(equal?
|
||
(parameterize ([source-directories '("..")])
|
||
(call-with-values
|
||
(lambda () (((inspect/object fatfib) 'code) 'source-path))
|
||
list))
|
||
'("../examples/fatfib.ss" 16 4)))
|
||
(or (windows?) (embedded?)
|
||
(equal?
|
||
(parameterize ([source-directories '("../examples")])
|
||
(call-with-values
|
||
(lambda () (((inspect/object fatfib) 'code) 'source-path))
|
||
list))
|
||
'("../examples/fatfib.ss" 16 4)))
|
||
(or (windows?) (embedded?)
|
||
(equal?
|
||
(parameterize ([source-directories (list (format "~a/examples" (parameterize ([cd ".."]) (cd))))])
|
||
(call-with-values
|
||
(lambda () (((inspect/object fatfib) 'code) 'source-path))
|
||
list))
|
||
(list (format "~a/examples/fatfib.ss" (parameterize ([cd ".."]) (cd))) 16 4)))
|
||
)
|
||
|
||
(mat filesystem-operations
|
||
(eqv?
|
||
(directory-separator)
|
||
(if (windows?) #\\ #\/))
|
||
(directory-separator? #\/)
|
||
(or (not (windows?)) (directory-separator? #\\))
|
||
(error? (directory-separator? '/))
|
||
(error? (directory-separator? '"/"))
|
||
(begin
|
||
(delete-file "testfile.ss" #f)
|
||
(delete-file "testfile.ss" #f)
|
||
(delete-file "testfile.ss")
|
||
#t)
|
||
(begin
|
||
(with-output-to-file "testfile.ss" values)
|
||
(r6rs:delete-file "testfile.ss")
|
||
(not (file-exists? "testfile.ss")))
|
||
(error? (delete-file "testfile.ss" #t))
|
||
(error? (r6rs:delete-file "testfile.ss"))
|
||
(and
|
||
(not (file-exists? "testfile.ss"))
|
||
(not (file-exists? "testfile.ss" #t))
|
||
(not (file-exists? "testfile.ss" #f)))
|
||
(and
|
||
(not (file-regular? "testfile.ss"))
|
||
(not (file-regular? "testfile.ss" #t))
|
||
(not (file-regular? "testfile.ss" #f)))
|
||
(and
|
||
(not (file-directory? "testfile.ss"))
|
||
(not (file-directory? "testfile.ss" #t))
|
||
(not (file-directory? "testfile.ss" #f)))
|
||
(not (file-symbolic-link? "testfile.ss"))
|
||
(begin
|
||
(rm-rf "testdir")
|
||
#t)
|
||
(and
|
||
(not (file-exists? "testdir"))
|
||
(not (file-exists? "testdir" #t))
|
||
(not (file-exists? "testdir" #f)))
|
||
(and
|
||
(not (file-regular? "testdir"))
|
||
(not (file-regular? "testdir" #t))
|
||
(not (file-regular? "testdir" #f)))
|
||
(and
|
||
(not (file-directory? "testdir"))
|
||
(not (file-directory? "testdir" #t))
|
||
(not (file-directory? "testdir" #f)))
|
||
(not (file-symbolic-link? "testdir"))
|
||
(begin
|
||
(mkdir "testdir")
|
||
(and
|
||
(file-exists? "testdir")
|
||
(file-exists? "testdir" #t)
|
||
(file-exists? "testdir" #f)))
|
||
(and
|
||
(not (file-regular? "testdir"))
|
||
(not (file-regular? "testdir" #t))
|
||
(not (file-regular? "testdir" #f)))
|
||
(and
|
||
(file-directory? "testdir")
|
||
(file-directory? "testdir" #t)
|
||
(file-directory? "testdir" #f))
|
||
(not (file-symbolic-link? "testdir"))
|
||
(eqv? (directory-list "testdir") '())
|
||
(begin
|
||
(with-output-to-file "testdir/testfile.ss" values)
|
||
(and
|
||
(file-exists? "testdir/testfile.ss")
|
||
(file-exists? "testdir/testfile.ss" #t)
|
||
(file-exists? "testdir/testfile.ss" #f)))
|
||
(and
|
||
(file-regular? "testdir/testfile.ss")
|
||
(file-regular? "testdir/testfile.ss" #t)
|
||
(file-regular? "testdir/testfile.ss" #f))
|
||
(and
|
||
(not (file-directory? "testdir/testfile.ss"))
|
||
(not (file-directory? "testdir/testfile.ss" #t))
|
||
(not (file-directory? "testdir/testfile.ss" #f)))
|
||
(not (file-symbolic-link? "testdir/testfile.ss"))
|
||
(equal? (directory-list "testdir") '("testfile.ss"))
|
||
(begin
|
||
(with-output-to-file "testdir/foo" values)
|
||
(and
|
||
(file-exists? "testdir/foo")
|
||
(file-exists? "testdir/foo" #t)
|
||
(file-exists? "testdir/foo" #f)))
|
||
(begin
|
||
(with-output-to-file "testdir/bar" values)
|
||
(and
|
||
(file-exists? "testdir/bar")
|
||
(file-exists? "testdir/bar" #t)
|
||
(file-exists? "testdir/bar" #f)))
|
||
(file-regular? "testdir/foo")
|
||
(not (file-directory? "testdir/foo"))
|
||
(not (file-symbolic-link? "testdir/foo"))
|
||
(file-regular? "testdir/bar")
|
||
(not (file-directory? "testdir/bar"))
|
||
(not (file-symbolic-link? "testdir/bar"))
|
||
(equal?
|
||
(sort string<? (directory-list "testdir"))
|
||
'("bar" "foo" "testfile.ss"))
|
||
(guard (c [(and (i/o-filename-error? c)
|
||
(equal? (i/o-error-filename c) "testdir"))])
|
||
(delete-directory "testdir" #t))
|
||
(eqv? (delete-directory "testdir" #f) #f)
|
||
(eqv? (delete-directory "testdir") #f)
|
||
(guard (c [(and (i/o-filename-error? c)
|
||
(equal? (i/o-error-filename c) "testdir/testfile.ss"))])
|
||
(delete-directory "testdir/testfile.ss" #t))
|
||
(not (delete-directory "testdir/testfile.ss" #f))
|
||
(not (delete-directory "testdir/testfile.ss"))
|
||
(guard (c [(and (i/o-filename-error? c)
|
||
(equal? (i/o-error-filename c) "testdir"))])
|
||
(delete-file "testdir" #t))
|
||
(not (delete-file "testdir"))
|
||
(not (delete-file "testdir" #f))
|
||
(eqv? (delete-file "testdir/testfile.ss" #t) (void))
|
||
(eqv? (delete-file "testdir/foo" #f) #t)
|
||
(eqv? (delete-file "testdir/bar") #t)
|
||
(not (delete-file "testdir" #f))
|
||
(not (delete-file "testdir"))
|
||
(eqv? (delete-directory "testdir" #f) #t)
|
||
(begin
|
||
(mkdir "testdir")
|
||
(file-exists? "testdir"))
|
||
(eqv? (delete-directory "testdir" #t) (void))
|
||
(begin
|
||
(mkdir "testdir")
|
||
(file-exists? "testdir"))
|
||
(eqv? (delete-directory "testdir") #t)
|
||
(error? (file-exists? 'foo))
|
||
(error? (file-regular? 'foo))
|
||
(error? (file-directory? 'foo))
|
||
(error? (file-symbolic-link? 'foo))
|
||
(error? (file-exists? 'foo #t))
|
||
(error? (file-regular? 'foo #t))
|
||
(error? (file-directory? 'foo #t))
|
||
(error? (file-exists? 'foo #f))
|
||
(error? (file-regular? 'foo #f))
|
||
(error? (file-directory? 'foo #f))
|
||
(error? (delete-file 'foo #t))
|
||
(error? (delete-file 'foo #f))
|
||
(error? (delete-file 'foo))
|
||
(error? (delete-directory 'foo #t))
|
||
(error? (delete-directory 'foo #f))
|
||
(error? (delete-directory 'foo))
|
||
(error? (directory-list 'foo))
|
||
(begin
|
||
(mkdir "testdir")
|
||
(with-output-to-file "testdir/rats" values)
|
||
(file-exists? "testdir"))
|
||
(eqv? (rename-file "testdir" "testdirx") (void))
|
||
(eqv? (rename-file "testdirx/rats" "testdirx/star") (void))
|
||
(not (delete-file "testdirx/rats" #f))
|
||
(eqv? (delete-file "testdirx/star" #t) (void))
|
||
(not (delete-directory "testdir" #f))
|
||
(eqv? (delete-directory "testdirx" #t) (void))
|
||
(or (embedded?) (> (length (directory-list "~")) 0))
|
||
(or (embedded?) (> (length (directory-list "~/")) 0))
|
||
(or (not (windows?))
|
||
(> (length (directory-list "c:")) 0))
|
||
(or (not (windows?))
|
||
(> (length (directory-list "c:/")) 0))
|
||
(or (not (windows?))
|
||
(> (length (directory-list "\\\\?\\c:\\")) 0))
|
||
(or (not (windows?))
|
||
(> (length (directory-list "\\\\?\\c:")) 0))
|
||
(file-directory? "/")
|
||
(file-directory? "/.")
|
||
(file-exists? ".")
|
||
(file-exists? "./")
|
||
(if (windows?)
|
||
(and (file-directory? "c:")
|
||
(file-directory? "c:/")
|
||
(file-directory? "c:/."))
|
||
(not (file-directory? "c:")))
|
||
(if (windows?)
|
||
(and (file-directory? "\\\\?\\c:")
|
||
(file-directory? "\\\\?\\c:\\"))
|
||
(not (file-directory? "\\\\?\\c:")))
|
||
(if (windows?)
|
||
(and (file-exists? "c:")
|
||
(file-exists? "c:/")
|
||
(file-exists? "c:/."))
|
||
(not (file-exists? "c:")))
|
||
(if (windows?)
|
||
(and (file-exists? "\\\\?\\c:")
|
||
(file-exists? "\\\\?\\c:\\"))
|
||
(not (file-exists? "\\\\?\\c:")))
|
||
(if (windows?)
|
||
(and (not (file-regular? "\\\\?\\c:"))
|
||
(not (file-regular? "\\\\?\\c:\\"))
|
||
(or (not (file-exists? "\\\\?\\c:\\autoexec.bat"))
|
||
(file-regular? "\\\\?\\c:\\autoexec.bat")))
|
||
(not (file-regular? "\\\\?\\c:\\autoexec.bat")))
|
||
(error? (get-mode 'foo))
|
||
(error? (get-mode 'foo #t))
|
||
(error? (get-mode 'foo #f))
|
||
(error? (get-mode "probably/not/there"))
|
||
(error? (get-mode "probably/not/there" #f))
|
||
(error? (get-mode "probably/not/there" #t))
|
||
(if (or (windows?) (embedded?))
|
||
(fixnum? (get-mode "mat.ss"))
|
||
(let ([m (get-mode "mat.ss")])
|
||
(and (logtest m #o400)
|
||
(not (logtest m #o111)))))
|
||
(or (not (windows?))
|
||
(and (fixnum? (get-mode "c:"))
|
||
(eqv? (get-mode "c:") (get-mode "c:/"))
|
||
(eqv? (get-mode "c:") (get-mode "c:/."))))
|
||
(if (or (windows?) (embedded?))
|
||
(fixnum? (get-mode "../mats"))
|
||
(eqv? (logand (get-mode "../mats") #o700) #o700))
|
||
(and (eqv? (get-mode "../mats") (get-mode "../mats/"))
|
||
(eqv? (get-mode "../mats") (get-mode "../mats/.")))
|
||
; access times are unreliable on contemporary file systems
|
||
(time? (file-access-time "../../mats/mat.ss"))
|
||
(time<=? (file-change-time "mat.ss") (file-change-time "mat.so"))
|
||
(time<=? (file-modification-time "mat.ss") (file-modification-time "mat.so"))
|
||
(equal?
|
||
(list (time? (file-access-time "../mats"))
|
||
(time? (file-change-time "../mats"))
|
||
(time? (file-modification-time "../mats")))
|
||
'(#t #t #t))
|
||
(equal?
|
||
(list (time? (file-access-time "../mats/"))
|
||
(time? (file-change-time "../mats/"))
|
||
(time? (file-modification-time "../mats/")))
|
||
'(#t #t #t))
|
||
(or (not (windows?))
|
||
(and (time? (file-access-time "c:"))
|
||
(time? (file-change-time "c:"))
|
||
(time? (file-modification-time "c:"))))
|
||
(or (not (windows?))
|
||
(and (time? (file-access-time "c:/"))
|
||
(time? (file-change-time "c:/"))
|
||
(time? (file-modification-time "c:/"))))
|
||
(or (not (windows?))
|
||
(and (time? (file-access-time "\\\\?\\c:"))
|
||
(time? (file-change-time "\\\\?\\c:"))
|
||
(time? (file-modification-time "\\\\?\\c:"))))
|
||
(or (not (windows?))
|
||
(and (time? (file-access-time "\\\\?\\c:\\"))
|
||
(time? (file-change-time "\\\\?\\c:\\"))
|
||
(time? (file-modification-time "\\\\?\\c:\\"))))
|
||
(or (windows?) (embedded?)
|
||
(time=? (file-access-time "Makefile") (file-access-time (format "Mf-~a" (machine-type)))))
|
||
(or (windows?) (embedded?)
|
||
(time=? (file-change-time "Makefile") (file-change-time (format "Mf-~a" (machine-type)))))
|
||
(or (windows?) (embedded?)
|
||
(time=? (file-modification-time "Makefile") (file-modification-time (format "Mf-~a" (machine-type)))))
|
||
(error? (file-access-time "probably/not/there"))
|
||
(error? (file-access-time "probably/not/there" #f))
|
||
(error? (file-access-time "probably/not/there" #t))
|
||
(error? (file-change-time "probably/not/there"))
|
||
(error? (file-change-time "probably/not/there" #f))
|
||
(error? (file-change-time "probably/not/there" #t))
|
||
(error? (file-modification-time "probably/not/there"))
|
||
(error? (file-modification-time "probably/not/there" #f))
|
||
(error? (file-modification-time "probably/not/there" #t))
|
||
)
|
||
|
||
(mat unicode-filesystem-operations
|
||
(begin
|
||
(delete-file "testfile\x3bb;.ss" #f)
|
||
(delete-file "testfile\x3bb;.ss" #f)
|
||
(delete-file "testfile\x3bb;.ss")
|
||
#t)
|
||
(begin
|
||
(with-output-to-file "testfile\x3bb;.ss" values)
|
||
(r6rs:delete-file "testfile\x3bb;.ss")
|
||
(not (file-exists? "testfile\x3bb;.ss")))
|
||
(error? (delete-file "testfile\x3bb;.ss" #t))
|
||
(error? (r6rs:delete-file "testfile\x3bb;.ss"))
|
||
(and
|
||
(not (file-exists? "testfile\x3bb;.ss"))
|
||
(not (file-exists? "testfile\x3bb;.ss" #t))
|
||
(not (file-exists? "testfile\x3bb;.ss" #f)))
|
||
(and
|
||
(not (file-regular? "testfile\x3bb;.ss"))
|
||
(not (file-regular? "testfile\x3bb;.ss" #t))
|
||
(not (file-regular? "testfile\x3bb;.ss" #f)))
|
||
(and
|
||
(not (file-directory? "testfile\x3bb;.ss"))
|
||
(not (file-directory? "testfile\x3bb;.ss" #t))
|
||
(not (file-directory? "testfile\x3bb;.ss" #f)))
|
||
(not (file-symbolic-link? "testfile\x3bb;.ss"))
|
||
(and
|
||
(not (file-exists? "testdir\x3bb;"))
|
||
(not (file-exists? "testdir\x3bb;" #t))
|
||
(not (file-exists? "testdir\x3bb;" #f)))
|
||
(and
|
||
(not (file-regular? "testdir\x3bb;"))
|
||
(not (file-regular? "testdir\x3bb;" #t))
|
||
(not (file-regular? "testdir\x3bb;" #f)))
|
||
(and
|
||
(not (file-directory? "testdir\x3bb;"))
|
||
(not (file-directory? "testdir\x3bb;" #t))
|
||
(not (file-directory? "testdir\x3bb;" #f)))
|
||
(not (file-symbolic-link? "testdir\x3bb;"))
|
||
(begin
|
||
(mkdir "testdir\x3bb;")
|
||
(and
|
||
(file-exists? "testdir\x3bb;")
|
||
(file-exists? "testdir\x3bb;" #t)
|
||
(file-exists? "testdir\x3bb;" #f)))
|
||
(and
|
||
(not (file-regular? "testdir\x3bb;"))
|
||
(not (file-regular? "testdir\x3bb;" #t))
|
||
(not (file-regular? "testdir\x3bb;" #f)))
|
||
(and
|
||
(file-directory? "testdir\x3bb;")
|
||
(file-directory? "testdir\x3bb;" #t)
|
||
(file-directory? "testdir\x3bb;" #f))
|
||
(not (file-symbolic-link? "testdir\x3bb;"))
|
||
(eqv? (directory-list "testdir\x3bb;") '())
|
||
(begin
|
||
(with-output-to-file "testdir\x3bb;/testfile\x3bb;.ss" values)
|
||
(and
|
||
(file-exists? "testdir\x3bb;/testfile\x3bb;.ss")
|
||
(file-exists? "testdir\x3bb;/testfile\x3bb;.ss" #t)
|
||
(file-exists? "testdir\x3bb;/testfile\x3bb;.ss" #f)))
|
||
(and
|
||
(file-regular? "testdir\x3bb;/testfile\x3bb;.ss")
|
||
(file-regular? "testdir\x3bb;/testfile\x3bb;.ss" #t)
|
||
(file-regular? "testdir\x3bb;/testfile\x3bb;.ss" #f))
|
||
(and
|
||
(not (file-directory? "testdir\x3bb;/testfile\x3bb;.ss"))
|
||
(not (file-directory? "testdir\x3bb;/testfile\x3bb;.ss" #t))
|
||
(not (file-directory? "testdir\x3bb;/testfile\x3bb;.ss" #f)))
|
||
(not (file-symbolic-link? "testdir\x3bb;/testfile\x3bb;.ss"))
|
||
(equal? (directory-list "testdir\x3bb;") '("testfile\x3bb;.ss"))
|
||
(begin
|
||
(with-output-to-file "testdir\x3bb;/foo" values)
|
||
(and
|
||
(file-exists? "testdir\x3bb;/foo")
|
||
(file-exists? "testdir\x3bb;/foo" #t)
|
||
(file-exists? "testdir\x3bb;/foo" #f)))
|
||
(begin
|
||
(with-output-to-file "testdir\x3bb;/bar" values)
|
||
(and
|
||
(file-exists? "testdir\x3bb;/bar")
|
||
(file-exists? "testdir\x3bb;/bar" #t)
|
||
(file-exists? "testdir\x3bb;/bar" #f)))
|
||
(file-regular? "testdir\x3bb;/foo")
|
||
(not (file-directory? "testdir\x3bb;/foo"))
|
||
(not (file-symbolic-link? "testdir\x3bb;/foo"))
|
||
(file-regular? "testdir\x3bb;/bar")
|
||
(not (file-directory? "testdir\x3bb;/bar"))
|
||
(not (file-symbolic-link? "testdir\x3bb;/bar"))
|
||
(equal?
|
||
(sort string<? (directory-list "testdir\x3bb;"))
|
||
'("bar" "foo" "testfile\x3bb;.ss"))
|
||
(guard (c [(and (i/o-filename-error? c)
|
||
(equal? (i/o-error-filename c) "testdir\x3bb;"))])
|
||
(delete-directory "testdir\x3bb;" #t))
|
||
(eqv? (delete-directory "testdir\x3bb;" #f) #f)
|
||
(eqv? (delete-directory "testdir\x3bb;") #f)
|
||
(guard (c [(and (i/o-filename-error? c)
|
||
(equal? (i/o-error-filename c) "testdir\x3bb;/testfile\x3bb;.ss"))])
|
||
(delete-directory "testdir\x3bb;/testfile\x3bb;.ss" #t))
|
||
(not (delete-directory "testdir\x3bb;/testfile\x3bb;.ss" #f))
|
||
(not (delete-directory "testdir\x3bb;/testfile\x3bb;.ss"))
|
||
(guard (c [(and (i/o-filename-error? c)
|
||
(equal? (i/o-error-filename c) "testdir\x3bb;"))])
|
||
(delete-file "testdir\x3bb;" #t))
|
||
(not (delete-file "testdir\x3bb;"))
|
||
(not (delete-file "testdir\x3bb;" #f))
|
||
(eqv? (delete-file "testdir\x3bb;/testfile\x3bb;.ss" #t) (void))
|
||
(eqv? (delete-file "testdir\x3bb;/foo" #f) #t)
|
||
(eqv? (delete-file "testdir\x3bb;/bar") #t)
|
||
(not (delete-file "testdir\x3bb;" #f))
|
||
(not (delete-file "testdir\x3bb;"))
|
||
(eqv? (delete-directory "testdir\x3bb;" #f) #t)
|
||
(begin
|
||
(mkdir "testdir\x3bb;")
|
||
(file-exists? "testdir\x3bb;"))
|
||
(eqv? (delete-directory "testdir\x3bb;" #t) (void))
|
||
(begin
|
||
(mkdir "testdir\x3bb;")
|
||
(file-exists? "testdir\x3bb;"))
|
||
(eqv? (delete-directory "testdir\x3bb;") #t)
|
||
(begin
|
||
(mkdir "testdir\x3bb;")
|
||
(with-output-to-file "testdir\x3bb;/ra\x3bb;ts" values)
|
||
(file-exists? "testdir\x3bb;"))
|
||
(fixnum? (get-mode "testdir\x3bb;/ra\x3bb;ts"))
|
||
(time? (file-access-time "testdir\x3bb;/ra\x3bb;ts"))
|
||
(time? (file-change-time "testdir\x3bb;/ra\x3bb;ts"))
|
||
(time? (file-modification-time "testdir\x3bb;/ra\x3bb;ts"))
|
||
(eqv? (rename-file "testdir\x3bb;" "testdir\x3bb;x") (void))
|
||
(eqv? (rename-file "testdir\x3bb;x/ra\x3bb;ts" "testdir\x3bb;x/sta\x3bb;r") (void))
|
||
(not (delete-file "testdir\x3bb;x/ra\x3bb;ts" #f))
|
||
(eqv? (delete-file "testdir\x3bb;x/sta\x3bb;r" #t) (void))
|
||
(not (delete-directory "testdir\x3bb;" #f))
|
||
(eqv? (delete-directory "testdir\x3bb;x" #t) (void))
|
||
(error? (get-mode "probably/not/there\x3bb;"))
|
||
(error? (get-mode "probably/not/there\x3bb;" #f))
|
||
(error? (get-mode "probably/not/there\x3bb;" #t))
|
||
(error? (file-access-time "probably/not/\x3bb;there"))
|
||
(error? (file-access-time "probably/not/\x3bb;there" #f))
|
||
(error? (file-access-time "probably/not/\x3bb;there" #t))
|
||
(error? (file-change-time "probably/not/\x3bb;there"))
|
||
(error? (file-change-time "probably/not/\x3bb;there" #f))
|
||
(error? (file-change-time "probably/not/\x3bb;there" #t))
|
||
(error? (file-modification-time "probably/not/\x3bb;there"))
|
||
(error? (file-modification-time "probably/not/\x3bb;there" #f))
|
||
(error? (file-modification-time "probably/not/\x3bb;there" #t))
|
||
)
|
||
|
||
(mat pathprocs
|
||
(error? (path-absolute? 'a/b/c))
|
||
(error? (path-parent 'a/b/c))
|
||
(error? (path-last 'a/b/c))
|
||
(error? (path-root 'a/b/c))
|
||
(error? (path-extension 'a/b/c))
|
||
|
||
(eq? (path-absolute? "") #f)
|
||
(eq? (path-absolute? "a") #f)
|
||
(eq? (path-absolute? "/") #t)
|
||
(eq? (path-absolute? "//bar/rot") #t)
|
||
(eq? (path-absolute? "~foo/bar") #t)
|
||
(eq? (path-absolute? "~/foo") #t)
|
||
(eq? (path-absolute? "../") #f)
|
||
(eq? (path-absolute? "./") #f)
|
||
(eq? (path-absolute? "/abc") #t)
|
||
(eq? (path-absolute? "foo") #f)
|
||
(eq? (path-absolute? "foo/bar/a.b") #f)
|
||
(eq?
|
||
(path-absolute? "c:abc")
|
||
(and (windows?) #t))
|
||
|
||
(equal? (path-parent "") "")
|
||
(equal? (path-parent "a") "")
|
||
(equal? (path-parent "/") "/")
|
||
(equal? (path-parent "../") "..")
|
||
(equal? (path-parent "./") ".")
|
||
(equal? (path-parent "/abc") "/")
|
||
(equal? (path-parent "foo/bar") "foo")
|
||
(equal? (path-parent "foo/bar/") "foo/bar")
|
||
(equal? (path-parent "foo/bar/a") "foo/bar")
|
||
(equal? (path-parent "foo/bar/a.b") "foo/bar")
|
||
(equal? (path-parent "foo/bar.b.q/a.b") "foo/bar.b.q")
|
||
(equal?
|
||
(path-parent "c:abc")
|
||
(if (windows?) "c:" ""))
|
||
(equal?
|
||
(path-parent "Z:abc")
|
||
(if (windows?) "Z:" ""))
|
||
|
||
(equal? (path-last "") "")
|
||
(equal? (path-last "a") "a")
|
||
(equal? (path-last "/") "")
|
||
(equal? (path-last "../") "")
|
||
(equal? (path-last "./") "")
|
||
(equal? (path-last "//") "")
|
||
(equal? (path-last "/abc") "abc")
|
||
(equal? (path-last "foo/bar") "bar")
|
||
(equal? (path-last "foo/bar/") "")
|
||
(equal? (path-last "foo/bar/a") "a")
|
||
(equal? (path-last "foo/bar/a.b") "a.b")
|
||
(equal? (path-last "foo/bar.b.q/a.b") "a.b")
|
||
(equal?
|
||
(path-last "c:abc")
|
||
(if (windows?) "abc" "c:abc"))
|
||
(equal?
|
||
(path-last "Z:abc")
|
||
(if (windows?) "abc" "Z:abc"))
|
||
|
||
(equal? (path-root "") "")
|
||
(equal? (path-root "a") "a")
|
||
(equal? (path-root "..") "..")
|
||
(equal? (path-root ".") ".")
|
||
(equal? (path-root "..abc") ".")
|
||
(equal? (path-root "abc.") "abc")
|
||
(equal? (path-root "a.b.c") "a.b")
|
||
(equal? (path-root "a.b.c.ss") "a.b.c")
|
||
(equal? (path-last "foo") "foo")
|
||
(equal? (path-root "/foo/bar.b.q/a.b.c") "/foo/bar.b.q/a.b")
|
||
(equal? (path-root "c:/foo/bar.b.q/a.b.c") "c:/foo/bar.b.q/a.b")
|
||
(equal? (path-root "c:") "c:")
|
||
|
||
(equal? (path-extension "") "")
|
||
(equal? (path-extension "a") "")
|
||
(equal? (path-extension "..") "")
|
||
(equal? (path-extension ".") "")
|
||
(equal? (path-extension "..abc") "abc")
|
||
(equal? (path-extension "abc.") "")
|
||
(equal? (path-extension "a.b.c") "c")
|
||
(equal? (path-extension "a.b.c.ss") "ss")
|
||
(equal? (path-extension "/foo/bar.b.q/a.b.c") "c")
|
||
(equal? (path-extension "c:/foo/bar.b.q/a.b.c") "c")
|
||
(equal? (path-extension "c:..") "")
|
||
(equal? (path-extension "c:") "")
|
||
|
||
; if this test fails, search for the asterisks in the printed table
|
||
(let ([okay? #t])
|
||
(define print-table
|
||
(lambda (x* expected**)
|
||
(define print-row
|
||
(lambda (abs? path first rest parent last root extension)
|
||
(printf "~a~11t~a~17t~a~28t~a~39t~a~50t~a~61t~a~73t~a\n"
|
||
abs? path first rest parent last root extension)))
|
||
(print-row "path" " abs" " first" " rest" " parent" " last" " root" " ext")
|
||
(let ([actual** (map (lambda (x)
|
||
(list
|
||
(if (path-absolute? x) "t" "f")
|
||
(path-first x)
|
||
(path-rest x)
|
||
(path-parent x)
|
||
(path-last x)
|
||
(path-root x)
|
||
(path-extension x)))
|
||
x*)])
|
||
(for-each
|
||
(lambda (x expected* actual*)
|
||
(define uscore (lambda (s) (if (eqv? s "") "_" s)))
|
||
(apply print-row x
|
||
(map (lambda (expected actual)
|
||
(format "~a~a"
|
||
(if (string=? expected actual) " " (begin (set! okay? #f) "*"))
|
||
(uscore actual)))
|
||
expected* actual*)))
|
||
x* expected** actual**))))
|
||
|
||
(define-syntax table
|
||
(syntax-rules ()
|
||
[(_ (path abs? first rest parent last root extension) ...)
|
||
(print-table '(path ...)
|
||
'((abs? first rest parent last root extension) ...))]))
|
||
|
||
; common
|
||
(table
|
||
("c" "f" "" "c" "" "c" "c" "")
|
||
("c." "f" "" "c." "" "c." "c" "")
|
||
("c.q" "f" "" "c.q" "" "c.q" "c" "q")
|
||
("c.qq" "f" "" "c.qq" "" "c.qq" "c" "qq")
|
||
("c.qqqqq" "f" "" "c.qqqqq" "" "c.qqqqq" "c" "qqqqq")
|
||
("c.qqq." "f" "" "c.qqq." "" "c.qqq." "c.qqq" "")
|
||
("c.qqq.zz" "f" "" "c.qqq.zz" "" "c.qqq.zz" "c.qqq" "zz")
|
||
("c./" "f" "c." "" "c." "" "c./" "")
|
||
("c.q/" "f" "c.q" "" "c.q" "" "c.q/" "")
|
||
("c.qq.z/" "f" "c.qq.z" "" "c.qq.z" "" "c.qq.z/" "")
|
||
(".qq" "f" "" ".qq" "" ".qq" "" "qq")
|
||
(".qq.z" "f" "" ".qq.z" "" ".qq.z" ".qq" "z")
|
||
("/" "t" "/" "" "/" "" "/" "")
|
||
("/abc" "t" "/" "abc" "/" "abc" "/abc" "")
|
||
("/abc/" "t" "/" "abc/" "/abc" "" "/abc/" "")
|
||
("abc" "f" "" "abc" "" "abc" "abc" "")
|
||
("/abc/def" "t" "/" "abc/def" "/abc" "def" "/abc/def" "")
|
||
("abc//def" "f" "abc" "def" "abc" "def" "abc//def" "")
|
||
(".." "f" ".." "" ".." "" ".." "")
|
||
("../.." "f" ".." ".." ".." ".." "../.." "")
|
||
("../" "f" ".." "" ".." "" "../" "")
|
||
("../a" "f" ".." "a" ".." "a" "../a" "")
|
||
("../a/b" "f" ".." "a/b" "../a" "b" "../a/b" "")
|
||
("." "f" "." "" "." "" "." "")
|
||
("./." "f" "." "." "." "." "./." "")
|
||
("./" "f" "." "" "." "" "./" "")
|
||
("./a" "f" "." "a" "." "a" "./a" "")
|
||
("./a/b" "f" "." "a/b" "./a" "b" "./a/b" "")
|
||
("..." "f" "" "..." "" "..." ".." "")
|
||
(".../" "f" "..." "" "..." "" ".../" "")
|
||
(".../a" "f" "..." "a" "..." "a" ".../a" "")
|
||
(".foo" "f" "" ".foo" "" ".foo" "" "foo")
|
||
(".foo/" "f" ".foo" "" ".foo" "" ".foo/" "")
|
||
(".foo/a" "f" ".foo" "a" ".foo" "a" ".foo/a" "")
|
||
(".foo/a.q" "f" ".foo" "a.q" ".foo" "a.q" ".foo/a" "q")
|
||
("~" "t" "~" "" "~" "" "~" "")
|
||
("~/a" "t" "~" "a" "~" "a" "~/a" "")
|
||
("~/a/" "t" "~" "a/" "~/a" "" "~/a/" "")
|
||
("~/a/b" "t" "~" "a/b" "~/a" "b" "~/a/b" "")
|
||
("~a" "t" "~a" "" "~a" "" "~a" "")
|
||
("~a.b" "t" "~a.b" "" "~a.b" "" "~a.b" "")
|
||
("~a/" "t" "~a" "" "~a" "" "~a/" "")
|
||
("~a/b" "t" "~a" "b" "~a" "b" "~a/b" "")
|
||
("~a/b/" "t" "~a" "b/" "~a/b" "" "~a/b/" "")
|
||
("~a/b/c" "t" "~a" "b/c" "~a/b" "c" "~a/b/c" "")
|
||
)
|
||
|
||
; windows
|
||
(if (windows?)
|
||
(table
|
||
("c:" "t" "c:" "" "c:" "" "c:" "")
|
||
("c:/" "t" "c:/" "" "c:/" "" "c:/" "")
|
||
("c:.." "t" "c:" ".." "c:" ".." "c:.." "")
|
||
("c:../" "t" "c:" "../" "c:.." "" "c:../" "")
|
||
("c:../a" "t" "c:" "../a" "c:.." "a" "c:../a" "")
|
||
("c:." "t" "c:" "." "c:" "." "c:." "")
|
||
("c:./" "t" "c:" "./" "c:." "" "c:./" "")
|
||
("c:./a" "t" "c:" "./a" "c:." "a" "c:./a" "")
|
||
("c:/abc" "t" "c:/" "abc" "c:/" "abc" "c:/abc" "")
|
||
("c:abc" "t" "c:" "abc" "c:" "abc" "c:abc" "")
|
||
("c:abc/def" "t" "c:" "abc/def" "c:abc" "def" "c:abc/def" "")
|
||
("c:/abc/def" "t" "c:/" "abc/def" "c:/abc" "def" "c:/abc/def" "")
|
||
("//abc" "t" "//abc" "" "//abc" "" "//abc" "")
|
||
("//abc/" "t" "//abc" "" "//abc" "" "//abc/" "")
|
||
("//abc/def" "t" "//abc" "def" "//abc" "def" "//abc/def" "")
|
||
("//x.com" "t" "//x.com" "" "//x.com" "" "//x.com" "")
|
||
("\\\\?\\" "t" "\\\\?\\" "" "\\\\?\\" "" "\\\\?\\" "" )
|
||
("\\\\?\\c:" "t" "\\\\?\\c:" "" "\\\\?\\c:" "" "\\\\?\\c:" "" )
|
||
("\\\\?\\c:\\" "t" "\\\\?\\c:\\" "" "\\\\?\\c:\\" "" "\\\\?\\c:\\" "" )
|
||
("\\\\?\\UNC\\" "t" "\\\\?\\UNC\\" "" "\\\\?\\UNC\\" "" "\\\\?\\UNC\\" "" )
|
||
("\\\\?\\Unc\\" "t" "\\\\?\\Unc\\" "" "\\\\?\\Unc\\" "" "\\\\?\\Unc\\" "" )
|
||
("\\\\?\\uNc\\\\" "t" "\\\\?\\uNc\\\\" "" "\\\\?\\uNc\\\\" "" "\\\\?\\uNc\\\\" "" )
|
||
("\\\\?\\unc\\x.com" "t" "\\\\?\\unc\\x.com" "" "\\\\?\\unc\\x.com" "" "\\\\?\\unc\\x.com" "" )
|
||
("\\\\?\\unc\\x.com\\rot.foo" "t" "\\\\?\\unc\\x.com" "rot.foo" "\\\\?\\unc\\x.com" "rot.foo" "\\\\?\\unc\\x.com\\rot" "foo" )
|
||
("\\\\?\\unc\\\\x.com\\rot.foo" "t" "\\\\?\\unc\\\\x.com" "rot.foo" "\\\\?\\unc\\\\x.com" "rot.foo" "\\\\?\\unc\\\\x.com\\rot" "foo" )
|
||
("\\\\?\\unc\\x.com/rot.foo" "t" "\\\\?\\unc\\x.com/rot.foo" "" "\\\\?\\unc\\x.com/rot.foo" "" "\\\\?\\unc\\x.com/rot.foo" "" )
|
||
)
|
||
(table
|
||
("c:" "f" "" "c:" "" "c:" "c:" "")
|
||
("c:/" "f" "c:" "" "c:" "" "c:/" "")
|
||
("c:.." "f" "" "c:.." "" "c:.." "c:." "")
|
||
("c:../" "f" "c:.." "" "c:.." "" "c:../" "")
|
||
("c:../a" "f" "c:.." "a" "c:.." "a" "c:../a" "")
|
||
("c:." "f" "" "c:." "" "c:." "c:" "")
|
||
("c:./" "f" "c:." "" "c:." "" "c:./" "")
|
||
("c:./a" "f" "c:." "a" "c:." "a" "c:./a" "")
|
||
("c:/abc" "f" "c:" "abc" "c:" "abc" "c:/abc" "")
|
||
("c:abc" "f" "" "c:abc" "" "c:abc" "c:abc" "")
|
||
("c:abc/def" "f" "c:abc" "def" "c:abc" "def" "c:abc/def" "")
|
||
("c:/abc/def" "f" "c:" "abc/def" "c:/abc" "def" "c:/abc/def" "")
|
||
("//abc" "t" "/" "abc" "/" "abc" "//abc" "")
|
||
("//abc/" "t" "/" "abc/" "//abc" "" "//abc/" "")
|
||
("//abc/def" "t" "/" "abc/def" "//abc" "def" "//abc/def" "")
|
||
("//x.com" "t" "/" "x.com" "/" "x.com" "//x" "com")
|
||
))
|
||
okay?)
|
||
)
|
||
|
||
(mat binary-vs-textual-port
|
||
(textual-port? (current-input-port))
|
||
(not (binary-port? (current-input-port)))
|
||
(textual-port? (current-output-port))
|
||
(not (binary-port? (current-output-port)))
|
||
|
||
(begin
|
||
(define $handler-standin (#%$port-handler (open-string-input-port "hi")))
|
||
#t)
|
||
|
||
(binary-port? (#%$make-binary-input-port "" $handler-standin '#vu8()))
|
||
(not (textual-port? (#%$make-binary-input-port "" $handler-standin '#vu8())))
|
||
(not (binary-port? (#%$make-textual-input-port "" $handler-standin "")))
|
||
(textual-port? (#%$make-textual-input-port "" $handler-standin ""))
|
||
(not (binary-port? (make-input-port values "")))
|
||
(textual-port? (make-input-port values ""))
|
||
|
||
(binary-port? (#%$make-binary-output-port "" $handler-standin '#vu8()))
|
||
(not (textual-port? (#%$make-binary-output-port "" $handler-standin '#vu8())))
|
||
(not (binary-port? (#%$make-textual-output-port "" $handler-standin "")))
|
||
(textual-port? (#%$make-textual-output-port "" $handler-standin ""))
|
||
(not (binary-port? (make-output-port values "")))
|
||
(textual-port? (make-output-port values ""))
|
||
|
||
(let ((x (make-input-port values "")))
|
||
(and (port? x)
|
||
(and (input-port? x) (textual-port? x))
|
||
(not (and (output-port? x) (binary-port? x)))
|
||
(not (output-port? x))
|
||
(not (binary-port? x))))
|
||
(let ((x (#%$make-binary-input-port "" $handler-standin '#vu8())))
|
||
(and (port? x)
|
||
(and (input-port? x) (binary-port? x))
|
||
(not (and (output-port? x) (textual-port? x)))
|
||
(not (output-port? x))
|
||
(not (textual-port? x))))
|
||
(let ((x (#%$make-textual-input-port "" $handler-standin "")))
|
||
(and (port? x)
|
||
(and (input-port? x) (textual-port? x))
|
||
(not (and (output-port? x) (binary-port? x)))
|
||
(not (output-port? x))
|
||
(not (binary-port? x))))
|
||
(let ((x (make-output-port values "")))
|
||
(and (port? x)
|
||
(and (output-port? x) (textual-port? x))
|
||
(not (and (input-port? x) (binary-port? x)))
|
||
(not (input-port? x))
|
||
(not (binary-port? x))))
|
||
(let ((x (#%$make-binary-output-port "" $handler-standin '#vu8())))
|
||
(and (port? x)
|
||
(and (output-port? x) (binary-port? x))
|
||
(not (and (input-port? x) (textual-port? x)))
|
||
(not (input-port? x))
|
||
(not (textual-port? x))))
|
||
(let ((x (#%$make-textual-output-port "" $handler-standin "")))
|
||
(and (port? x)
|
||
(and (output-port? x) (textual-port? x))
|
||
(not (and (input-port? x) (binary-port? x)))
|
||
(not (input-port? x))
|
||
(not (binary-port? x))))
|
||
)
|
||
|
||
(mat port-name
|
||
(equal? "foo" (port-name (#%$make-binary-output-port "foo" $handler-standin #vu8())))
|
||
(equal? "foo" (port-name (#%$make-textual-output-port "foo" $handler-standin "")))
|
||
(equal? "foo" (let ([x (#%$make-binary-output-port "rot" $handler-standin #vu8())])
|
||
(set-port-name! x "foo")
|
||
(port-name x)))
|
||
(equal? "foo" (let ([x (#%$make-textual-output-port "#f" $handler-standin "")])
|
||
(set-port-name! x "foo")
|
||
(port-name x)))
|
||
(equal? "foo" (port-name (make-output-port (lambda args "foo") "")))
|
||
(equal? "generic" (port-name (make-output-port (lambda args (errorf 'foo "foo")) "")))
|
||
)
|
||
|
||
(mat procedure-name
|
||
(equal? (format "~s" car) "#<procedure car>")
|
||
(equal? (format "~s" (lambda (x) x)) "#<procedure>")
|
||
(begin
|
||
(with-output-to-file "testfile.ss"
|
||
(lambda ()
|
||
(pretty-print '(define ($pn-q x) (lambda (y) (+ x y)))))
|
||
'replace)
|
||
(load "testfile.ss" compile)
|
||
#t)
|
||
(equal? (format "~s" $pn-q) "#<procedure $pn-q at testfile.ss:0>")
|
||
(equal? (format "~s" ($pn-q 3)) "#<procedure at testfile.ss:18>")
|
||
)
|
||
|
||
(mat bignum-printing
|
||
(let ()
|
||
(define wrint
|
||
(let ([digit->char
|
||
(lambda (d)
|
||
(string-ref "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" d))])
|
||
(lambda (n b)
|
||
(if (< n b)
|
||
(write-char (digit->char n))
|
||
(begin
|
||
(wrint (quotient n b) b)
|
||
(write-char (digit->char (remainder n b))))))))
|
||
(do ([i 4000 (fx- i 1)])
|
||
((fx= i 0))
|
||
(let ([n (random (expt 2 (random (* (fixnum-width) 30))))]
|
||
[b (+ 2 (random 35))])
|
||
(unless (let ([s (with-output-to-string (lambda () (wrint n b)))])
|
||
(and (string=?
|
||
(parameterize ([print-radix b]) (format "~a" n))
|
||
s)
|
||
(or (= n 0)
|
||
(string=?
|
||
(parameterize ([print-radix b]) (format "~a" (- n)))
|
||
(format "-~a" s)))))
|
||
(errorf #f "failed in base ~s for ~s" b n))
|
||
(unless (string=?
|
||
(format "~a" n)
|
||
(with-output-to-string (lambda () (wrint n 10))))
|
||
(errorf #f "failed in base 10 for ~s" n))))
|
||
#t)
|
||
)
|
||
|
||
(mat process
|
||
(begin (set! p (process (patch-exec-path $cat_flush)))
|
||
(= (length p) 3))
|
||
(and (port? (car p)) (input-port? (car p))
|
||
(port? (cadr p)) (output-port? (cadr p))
|
||
(integer? (caddr p)))
|
||
(and (file-port? (car p)) (file-port? (cadr p)))
|
||
(and (fixnum? (port-file-descriptor (car p)))
|
||
(fixnum? (port-file-descriptor (cadr p))))
|
||
(let ([ip (car p)])
|
||
(and (not (port-has-port-position? ip))
|
||
(not (port-has-set-port-position!? ip))
|
||
(not (port-has-port-length? ip))
|
||
(not (port-has-set-port-length!? ip))))
|
||
(let ([op (car p)])
|
||
(and (not (port-has-port-position? op))
|
||
(not (port-has-set-port-position!? op))
|
||
(not (port-has-port-length? op))
|
||
(not (port-has-set-port-length!? op))))
|
||
(not (char-ready? (car p)))
|
||
(begin (display "hello " (cadr p))
|
||
(flush-output-port (cadr p))
|
||
#t)
|
||
(begin (sleep (make-time 'time-duration 0 3)) #t) ; wait for subprocess to catch up
|
||
(char-ready? (car p))
|
||
(eq? (read (car p)) 'hello)
|
||
(char-ready? (car p))
|
||
(char=? (read-char (car p)) #\space)
|
||
(not (char-ready? (car p)))
|
||
(begin (close-output-port (cadr p)) #t)
|
||
(begin (sleep (make-time 'time-duration 0 3)) #t) ; wait for subprocess to catch up
|
||
(sanitized-error? (write-char #\a (cadr p)))
|
||
(sanitized-error? (write-char #\newline (cadr p)))
|
||
(sanitized-error? (flush-output-port (cadr p)))
|
||
(char-ready? (car p))
|
||
(eof-object? (read-char (car p)))
|
||
(begin (close-input-port (car p)) #t)
|
||
(sanitized-error? (char-ready? (car p)))
|
||
(sanitized-error? (read-char (car p)))
|
||
(sanitized-error? (clear-input-port (cadr p)))
|
||
)
|