1;;; 6.ms 2;;; Copyright 1984-2017 Cisco Systems, Inc. 3;;; 4;;; Licensed under the Apache License, Version 2.0 (the "License"); 5;;; you may not use this file except in compliance with the License. 6;;; You may obtain a copy of the License at 7;;; 8;;; http://www.apache.org/licenses/LICENSE-2.0 9;;; 10;;; Unless required by applicable law or agreed to in writing, software 11;;; distributed under the License is distributed on an "AS IS" BASIS, 12;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13;;; See the License for the specific language governing permissions and 14;;; limitations under the License. 15 16;;; sections 6-1 and 6-2: 17 18(mat current-input-port 19 (port? (current-input-port)) 20 (input-port? (current-input-port)) 21 (eq? (current-input-port) (console-input-port)) 22 ) 23 24(mat current-output-port 25 (port? (current-output-port)) 26 (output-port? (current-output-port)) 27 (eq? (current-output-port) (console-output-port)) 28 ) 29 30(mat port-operations 31 (error? (open-input-file "nonexistent file")) 32 (error? (open-input-file "nonexistent file" 'compressed)) 33 (error? (open-output-file "/nonexistent/directory/nonexistent/file")) 34 (error? (open-output-file "/nonexistent/directory/nonexistent/file" 'replace)) 35 (error? (open-input-output-file "/nonexistent/directory/nonexistent/file")) 36 (error? (open-input-output-file "/nonexistent/directory/nonexistent/file" 'truncate)) 37 ; the following several clauses test various open-output-file options 38 (let ([p (open-output-file "testfile.ss" 'truncate)]) 39 (and (port? p) (output-port? p) (begin (close-output-port p) #t))) 40 (error? (open-output-file "testfile.ss")) 41 (error? (open-output-file "testfile.ss" 'error)) 42 (let ([p (open-output-file "testfile.ss" 'replace)]) 43 (and (port? p) (output-port? p) (begin (close-output-port p) #t))) 44 (let ([p (open-output-file "testfile.ss" 'truncate)]) 45 (and (port? p) (output-port? p) (begin (close-output-port p) #t))) 46 (let ([p (open-output-file "testfile.ss" 'truncate)]) 47 (display "\"hello" p) 48 (close-output-port p) 49 (let ([p (open-output-file "testfile.ss" 'append)]) 50 (display " there\"" p) 51 (close-output-port p) 52 (let ([p (open-input-file "testfile.ss")]) 53 (and (equal? (read p) "hello there") 54 (eof-object? (read p)) 55 (begin (close-input-port p) #t))))) 56 ; the following tests open-output-file, close-output-port, write, 57 ; display, and newline---and builds testfile.ss for the next test 58 (let ([p (let loop () (if (file-exists? "testfile.ss") 59 (begin (delete-file "testfile.ss" #f) (loop)) 60 (open-output-file "testfile.ss")))]) 61 (for-each (lambda (x) (write x p) (display " " p)) 62 '(a b c d e)) 63 (newline p) 64 (close-output-port p) 65 #t) 66 ; the following tests open-input-file, close-input-port, read, 67 ; and eof-object? 68 (equal? (let ([p (open-input-file "testfile.ss")]) 69 (let f ([x (read p)]) 70 (if (eof-object? x) 71 (begin (close-input-port p) '()) 72 (cons x (f (read p)))))) 73 '(a b c d e)) 74 ; the following tests with-output-to-file, close-port, 75 ; and write-char---and builds testfile.ss for the next test 76 (equal? (call-with-values 77 (lambda () 78 (with-output-to-file "testfile.ss" 79 (lambda () 80 (for-each (lambda (c) (write-char c)) 81 (string->list "a b c d e")) 82 (values 1 2 3)) 83 'replace)) 84 list) 85 '(1 2 3)) 86 ; the following tests with-input-from-file, close-port, 87 ; read-char, unread-char, and eof-object? 88 (equal? (with-input-from-file "testfile.ss" 89 (lambda () 90 (list->string 91 (let f () 92 (let ([c (read-char)]) 93 (if (eof-object? c) 94 '() 95 (begin (unread-char c) 96 (let ([c (read-char)]) 97 (cons c (f)))))))))) 98 "a b c d e") 99 ; the following tests call-with-output-file, close-port, 100 ; and write-char---and builds testfile.ss for the next test 101 (equal? (call-with-values 102 (lambda () 103 (call-with-output-file "testfile.ss" 104 (lambda (p) 105 (for-each (lambda (c) (write-char c p)) 106 (string->list "a b c d e")) 107 (close-port p) 108 (values 1 2 3)) 109 'replace)) 110 list) 111 '(1 2 3)) 112 ; the following tests call-with-input-file, close-port, 113 ; read-char, unread-char, and eof-object? 114 (equal? (call-with-input-file "testfile.ss" 115 (lambda (p) 116 (list->string 117 (let f () 118 (let ([c (read-char p)]) 119 (if (eof-object? c) 120 (begin (close-port p) '()) 121 (begin (unread-char c p) 122 (let ([c (read-char p)]) 123 (cons c (f)))))))))) 124 "a b c d e") 125 ; the following tests call-with-input-file, close-port, 126 ; read-char, unread-char, and eof-object? 127 (equal? (call-with-values 128 (lambda () 129 (call-with-input-file "testfile.ss" 130 (lambda (p) 131 (apply values 132 (let f () 133 (let ([c (read-char p)]) 134 (if (eof-object? c) 135 (begin (close-port p) '()) 136 (begin (unread-char c p) 137 (let ([c (read-char p)]) 138 (cons c (f))))))))))) 139 (lambda ls (list->string ls))) 140 "a b c d e") 141 ; the following tests call-with-input-file, close-input-port, 142 ; read-char, peek-char, and eof-object? 143 (equal? (call-with-input-file "testfile.ss" 144 (lambda (p) 145 (list->string 146 (let f () 147 (let ([c (peek-char p)]) 148 (if (eof-object? c) 149 (begin (close-input-port p) '()) 150 (let ([c (read-char p)]) 151 (cons c (f))))))))) 152 "a b c d e") 153 ; test various errors related to input ports 154 (begin (set! ip (open-input-file "testfile.ss")) 155 (and (port? ip) (input-port? ip))) 156 (error? (unread-char #\a ip)) 157 (eqv? (read-char ip) #\a) 158 (begin (unread-char #\a ip) (eqv? (read-char ip) #\a)) 159 (begin (clear-input-port ip) #t) 160 (error? (unread-char #\a ip)) 161 (error? (write-char #\a ip)) 162 (error? (write 'a ip)) 163 (error? (display 'a ip)) 164 (error? (newline ip)) 165 (error? (fprintf ip "hi")) 166 (error? (flush-output-port ip)) 167 (error? (clear-output-port ip)) 168 (begin (close-input-port ip) #t) 169 (error? (read-char ip)) 170 (error? (read ip)) 171 (error? (char-ready? ip)) 172 ; test various errors related to output ports 173 (begin (set! op (open-output-file "testfile.ss" 'replace)) 174 (and (port? op) (output-port? op))) 175 (error? (char-ready? op)) 176 (error? (peek-char op)) 177 (error? (read-char op)) 178 (error? (unread-char #\a op)) 179 (error? (read op)) 180 (error? (clear-input-port op)) 181 (begin (close-output-port op) #t) 182 (error? (write-char #\a op)) 183 (error? (write 'a op)) 184 (error? (display 'a op)) 185 (error? (newline op)) 186 (error? (fprintf op "hi")) 187 (error? (flush-output-port op)) 188 (error? (clear-output-port op)) 189 (error? (current-output-port 'a)) 190 (error? (current-input-port 'a)) 191 (begin (current-output-port (console-output-port)) #t) 192 (begin (current-input-port (console-input-port)) #t) 193 194 ; the following tests open-input-string, open-output-string, read-char, 195 ; eof-object?, unread-char, write-char, and get-ouptut-string 196 (let ([s "hi there, mom!"]) 197 (let ([ip (open-input-string s)] [op (open-output-string)]) 198 (do ([c (read-char ip) (read-char ip)]) 199 ((eof-object? c) 200 (equal? (get-output-string op) s)) 201 (unread-char c ip) 202 (write-char (read-char ip) op)))) 203 204 (error? (with-input-from-string)) 205 (error? (with-input-from-string "a")) 206 (error? (with-input-from-string 'a (lambda () 3))) 207 (error? (with-input-from-string "a" 'foo)) 208 (error? (with-input-from-string (lambda () 3) "a")) 209 (error? (with-input-from-string '(this too?) values)) 210 (error? (with-input-from-string "a" (lambda () 3) 'compressed)) 211 (error? (with-output-to-string)) 212 (error? (with-output-to-string "a")) 213 (error? (with-output-to-string 'a (lambda () 3))) 214 (error? (with-output-to-string '(this too?))) 215 (error? (eof-object #!eof)) 216 (eq? (with-input-from-string "" read) #!eof) 217 (eq? (with-input-from-string "" read) (eof-object)) 218 (eq? (eof-object) #!eof) 219 (error? (with-input-from-string "'" read)) 220 ; the following tests with-input-from-string, with-output-to-string, 221 ; read-char, eof-object?, unread-char, and write-char 222 (let ([s "hi there, mom!"]) 223 (equal? 224 (with-input-from-string s 225 (lambda () 226 (with-output-to-string 227 (lambda () 228 (do ([c (read-char) (read-char)]) 229 ((eof-object? c)) 230 (unread-char c) 231 (write-char (read-char))))))) 232 s)) 233 234 ; the following makes sure that call-with-{in,out}put-file close the 235 ; port (from Dave Boyer)---at least on systems which restrict the 236 ; number of open ports to less than 20 237 (let loop ((i 20)) 238 (or (zero? i) 239 (begin (call-with-output-file "testfile.ss" 240 (lambda (p) (write i p)) 241 'replace) 242 (and (eq? (call-with-input-file "testfile.ss" 243 (lambda (p) (read p))) 244 i) 245 (loop (- i 1)))))) 246 247 ; test source information in error messages from read 248 (error? 249 (begin 250 (with-output-to-file "testfile.ss" 251 (lambda () (display "(cons 1 2 . 3 4)")) 252 'replace) 253 (let ([ip (open-input-file "testfile.ss")]) 254 (dynamic-wind 255 void 256 (lambda () (read ip)) 257 (lambda () (close-input-port ip)))))) 258 259 ; test source information in error messages from read 260 (error? 261 (begin 262 (with-output-to-file "testfile.ss" 263 (lambda () (display "(cons 1 2 ] 3 4)")) 264 'replace) 265 (let ([ip (open-input-file "testfile.ss")]) 266 (dynamic-wind 267 void 268 (lambda () (read ip)) 269 (lambda () (close-input-port ip)))))) 270 ) 271 272(mat port-operations1 273 (error? (open-input-output-file)) 274 (error? (open-input-output-file 'furball)) 275 (error? (open-input-output-file "/probably/not/a/good/path")) 276 (error? (open-input-output-file "testfile.ss" 'compressed)) 277 (error? (open-input-output-file "testfile.ss" 'uncompressed)) 278 (begin 279 (define $ppp (open-input-output-file "testfile.ss")) 280 (and (input-port? $ppp) (output-port? $ppp) (port? $ppp))) 281 (error? (truncate-file $ppp -3)) 282 (error? (truncate-file $ppp 'all-the-way)) 283 (eof-object? 284 (begin 285 (truncate-file $ppp) 286 (display "hello" $ppp) 287 (flush-output-port $ppp) 288 (read $ppp))) 289 (eq? (begin (file-position $ppp 0) (read $ppp)) 'hello) 290 (eqv? (begin 291 (display "goodbye\n" $ppp) 292 (truncate-file $ppp 9) 293 (file-position $ppp)) 294 9) 295 (eof-object? (read $ppp)) 296 (eqv? (begin (file-position $ppp 0) (file-position $ppp)) 0) 297 (eq? (read $ppp) 'hellogood) 298 (eqv? (begin 299 (display "byebye\n" $ppp) 300 (truncate-file $ppp 0) 301 (file-position $ppp)) 302 0) 303 (eof-object? (read $ppp)) 304 (eof-object? 305 (begin 306 (close-port $ppp) 307 (let ([ip (open-input-file "testfile.ss")]) 308 (let ([c (read-char ip)]) 309 (close-input-port ip) 310 c)))) 311 (error? 312 (let ([ip (open-input-file "testfile.ss")]) 313 (dynamic-wind 314 void 315 (lambda () (truncate-file ip)) 316 (lambda () (close-input-port ip))))) 317 (error? (truncate-file 'animal-crackers)) 318 (error? (truncate-file)) 319 (error? (truncate-file $ppp)) 320 (let ([op (open-output-string)]) 321 (and (= (file-position op) 0) 322 (= (file-length op) 0) 323 (begin (fresh-line op) #t) 324 (= (file-length op) 0) 325 (= (file-position op) 0) 326 (do ([i 4000 (fx- i 1)]) 327 ((fx= i 0) #t) 328 (display "hello" op)) 329 (= (file-length op) 20000) 330 (= (file-position op) 20000) 331 (begin (file-position op 5000) #t) 332 (= (file-position op) 5000) 333 (= (file-length op) 20000) 334 (begin (truncate-file op) #t) 335 (= (file-length op) 0) 336 (= (file-position op) 0) 337 (begin (truncate-file op 17) #t) 338 (= (file-length op) 17) 339 (= (file-position op) 17) 340 (begin (display "okay" op) #t) 341 (= (file-length op) 21) 342 (= (file-position op) 21) 343 (equal? (substring (get-output-string op) 17 21) "okay") 344 (= (file-length op) 0) 345 (= (file-position op) 0) 346 (begin (fresh-line op) #t) 347 (= (file-length op) 0) 348 (= (file-position op) 0) 349 (begin 350 (write-char #\a op) 351 (fresh-line op) 352 #t) 353 (= (file-position op) 2) 354 (begin (fresh-line op) #t) 355 (= (file-position op) 2) 356 (equal? (get-output-string op) "a\n"))) 357 (let ([ip (open-input-string "beam me up, scotty!")] 358 [s (make-string 10)]) 359 (and (= (file-position ip) 0) 360 (= (file-length ip) 19) 361 (not (eof-object? (peek-char ip))) 362 (equal? (read ip) 'beam) 363 (= (file-position ip) 4) 364 (not (eof-object? (peek-char ip))) 365 (equal? (block-read ip s 10) 10) 366 (equal? s " me up, sc") 367 (= (file-position ip) 14) 368 (equal? (block-read ip s 10) 5) 369 (equal? s "otty!p, sc") 370 (= (file-position ip) 19) 371 (eof-object? (peek-char ip)) 372 (eof-object? (read-char ip)) 373 (eof-object? (block-read ip s 10)) 374 (eof-object? (block-read ip s 0)) 375 (begin 376 (file-position ip 10) 377 (= (file-position ip) 10)) 378 (equal? (block-read ip s 10) 9) 379 (equal? s ", scotty!c"))) 380 (error? ; unhandled message 381 (get-output-string (open-input-string "oops"))) 382 (error? ; unhandled message 383 (let ([op (open-output-file "testfile.ss" 'replace)]) 384 (dynamic-wind 385 void 386 (lambda () (get-output-string op)) 387 (lambda () (close-output-port op))))) 388 ) 389 390(mat compression 391 (let () 392 (define cp 393 (lambda (mode src dst) 394 (define buf-size 4096) 395 (let ([buf (make-string buf-size)]) 396 (call-with-output-file dst 397 (lambda (op) 398 (call-with-input-file src 399 (lambda (ip) 400 (let lp () 401 (let ([n (block-read ip buf buf-size)]) 402 (unless (eof-object? n) (block-write op buf n) (lp))))))) 403 mode)))) 404 (define cmp 405 (lambda (mode1 src1 mode2 src2) 406 (define buf-size 4096) 407 (let ([buf1 (make-string buf-size)] 408 [buf2 (make-string buf-size)]) 409 (call-with-input-file src1 410 (lambda (ip1) 411 (call-with-input-file src2 412 (lambda (ip2) 413 (let lp () 414 (let ([n1 (block-read ip1 buf1 buf-size)] 415 [n2 (block-read ip2 buf2 buf-size)]) 416 (if (eof-object? n1) 417 (eof-object? n2) 418 (and (eqv? n1 n2) 419 (string=? (substring buf1 0 n1) 420 (substring buf2 0 n2)) 421 (lp)))))) 422 mode2)) 423 mode1)))) 424 (and 425 (cmp '() "prettytest.ss" '() "prettytest.ss") 426 (cmp '(compressed) "prettytest.ss" '() "prettytest.ss") 427 (cmp '() "prettytest.ss" '(compressed) "prettytest.ss") 428 (cmp '(compressed) "prettytest.ss" '(compressed) "prettytest.ss") 429 (begin 430 (cp '(replace compressed) "prettytest.ss" "testfile.ss") 431 #t) 432 (cmp '(compressed) "testfile.ss" '() "prettytest.ss") 433 (not (= (call-with-input-file "testfile.ss" file-length) (call-with-input-file "prettytest.ss" file-length))) 434 ; the following test could cause an error with anything but latin-1 codec 435 #;(not (cmp '() "testfile.ss" '() "prettytest.ss")) 436 (begin 437 (cp '(compressed append) "prettytest.ss" "testfile.ss") 438 #t) 439 (not (cmp '(compressed) "testfile.ss" '() "prettytest.ss")) 440 )) 441 (error? (open-output-file "testfile.ss" '(replace append))) 442 (error? (open-output-file "testfile.ss" '(append truncate))) 443 ; test workaround for bogus gzclose error return for empty input files 444 (and 445 (eqv? (with-output-to-file "testfile.ss" void 'replace) (void)) 446 (eof-object? (with-input-from-file "testfile.ss" read 'compressed))) 447 ) 448 449(mat read-comment 450 (equal? '; this is the first comment 451 (a ; second comment 452 #;(third ; comment in comment 453 comment #;(comment #1=e in 454 . #;(comment in comment in comment) 455 comment)) b ; fourth comment 456 c #| fifth comment #| more 457 nesting here |# |# d 458 ; sixth and final comment 459 #1#) 460 '(a b c d e)) 461 (equal? (read (open-input-string "; this is the first comment 462 (a ; second comment 463 #;(third ; comment in comment 464 comment #;(comment #1=e in 465 . #;(comment in comment in comment) 466 comment)) b ; fourth comment 467 c #| fifth comment #| more 468 nesting here |# |# d 469 ; sixth and final comment 470 #1#)")) 471 '(a b c d e)) 472 (equal? (read (open-input-string "(#|##|# |#|#1 473 #||#2 474 #|||#3 475 #|#||#|#4 476 #|| hello ||#5 477 #| ; rats |#)")) 478 '(1 2 3 4 5)) 479 ) 480 481(mat read-graph 482 (begin 483 (define read-test-graph 484 (case-lambda 485 [(s) (read-test-graph s s)] 486 [(s1 s2) 487 (string=? 488 (parameterize ((print-graph #t)) 489 (format "~s" (read (open-input-string s1)))) 490 s2)])) 491 #t) 492 (error? ; verify that the error message is NOT "invalid memory reference" 493 (let ((ip (open-input-string "(cons 0 #0#)"))) 494 ((#%$make-read ip #t #f) #t))) 495 (let () 496 (define-record foo ((immutable x) (immutable y))) 497 (record-reader 'foo (record-rtd (make-foo 3 4))) 498 (and 499 (read-test-graph "#0=#[foo (#0#) 0]") 500 (read-test-graph "#0=(#[foo #0# 0])") 501 (read-test-graph "#[foo #0=(a b c) #0#]"))) 502 (error? (read-test-graph "#0=#[foo #0# #0#]")) 503 (read-test-graph "#(123 #[foo #0=(a b c) #0#])") 504 (read-test-graph "#(#0=#[foo #1=(a b c) #1#] 0 #0#)") 505 (read-test-graph "#(#1# 0 #1=#[foo #0=(a b c) #0#])" 506 "#(#0=#[foo #1=(a b c) #1#] 0 #0#)") 507 (read-test-graph "#(123 #0=(#0#))") 508 (read-test-graph "#(123 #0=(#0#))") 509 (let () 510 (define-record r1 ((mutable a) (immutable b))) 511 (define-record r2 ((immutable a))) 512 (let* ((x2 (make-r2 (make-r1 '* '(a b c)))) (x1 (r2-a x2))) 513 (set-r1-a! x1 x2) 514 (record-reader 'r1 (record-rtd (make-r1 3 4))) 515 (record-reader 'r2 (record-rtd (make-r2 3))) 516 (read-test-graph 517 (parameterize ((print-graph #t)) 518 (format "~s" (list (r1-b x1) x1)))))) 519 (read-test-graph "(#0=(a b c) #1=#[r1 #[r2 #1#] #0#])") 520 ) 521 522(mat block-io 523 ; test block-write and build testfile.ss for the following test 524 (let ([p (open-output-file "testfile.ss" 'truncate)]) 525 (block-write p "hi there") 526 (display " mom" p) 527 (block-write p ", how are you?xxxx" (string-length ", how are you?")) 528 (newline p) 529 (let ([s (make-string 100 #\X)]) 530 (string-set! s 99 #\newline) 531 (let ([s (apply string-append (make-list 10 s))]) 532 (let ([s (apply string-append (make-list 10 s))]) 533 (block-write p s) 534 (block-write p s 5000)))) 535 (close-output-port p) 536 #t) 537 ; test block-read 538 (let ([random-read-up 539 (lambda (p n) 540 (let f ([n n] [ls '()]) 541 (if (fx= n 0) 542 (apply string-append (reverse ls)) 543 (if (fxodd? n) 544 (f (- n 1) (cons (string (read-char p)) ls)) 545 (let ([s (make-string (random (fx+ n 1)))]) 546 (let ([i (if (fx= (random 2) 0) 547 (block-read p s) 548 (block-read p s (string-length s)))]) 549 (f (- n i) (cons (substring s 0 i) ls))))))))]) 550 (let ([s (make-string 100 #\X)]) 551 (string-set! s 99 #\newline) 552 (let ([s (apply string-append (make-list 10 s))]) 553 (let ([s (apply string-append (make-list 10 s))]) 554 (let ([s (string-append "hi there mom, how are you?" 555 (string #\newline) 556 s 557 (substring s 0 5000))]) 558 (let ([p (open-input-file "testfile.ss")]) 559 (let ([t (random-read-up p (string-length s))]) 560 (and (eof-object? (read-char p)) 561 (string=? t s) 562 (eqv? (close-input-port p) (void)))))))))) 563 ; test for bug: block-read complained when handler returned eof 564 (eof-object? 565 (let ((p (make-input-port (lambda args #!eof) ""))) 566 (block-read p (make-string 100)))) 567) 568 569(mat file-length-and-file-position 570 (procedure? file-length) 571 (procedure? file-position) 572 (let ([s "hi there"]) 573 (let ([n (string-length s)] 574 [p (open-output-file "testfile.ss" 'replace)]) 575 (and (eqv? (file-length p) 0) 576 (begin (display s p) 577 (= (file-position p) (file-length p) n)) 578 (begin (display #\space p) 579 (= (file-position p) (file-length p) (+ n 1))) 580 (eqv? (file-position p 1) (void)) 581 (write-char #\o p) 582 (eqv? (file-position p 2000) (void)) 583 (begin (display s p) 584 (= (file-length p) (file-position p) (+ 2000 n))) 585 (eqv? (close-output-port p) (void))))) 586;;; no error is reported, which isn't serious 587; (error? (file-position (open-input-file "testfile.ss") 10000)) 588 (error? 589 (let ((p (open-input-file "testfile.ss"))) 590 (dynamic-wind 591 void 592 (lambda () (file-position p -1)) 593 (lambda () (close-input-port p))))) 594 (guard (c [(i/o-invalid-position-error? c)]) 595 (let ([p (open-input-file "testfile.ss")]) 596 (dynamic-wind 597 void 598 (lambda () 599 (file-position p (if (fixnum? (expt 2 32)) (- (expt 2 63) 1) (- (expt 2 31) 1))) 600 #t) 601 (lambda () (close-input-port p))))) 602 (error? 603 (let ([p (open-input-file "testfile.ss")]) 604 (dynamic-wind 605 void 606 (lambda () (file-position p (expt 2 64))) 607 (lambda () (close-input-port p))))) 608 (error? (file-position 1)) 609 (error? (file-length 1)) 610 (let ([s "hi there"]) 611 (let ([n (string-length s)] [p (open-input-file "testfile.ss")]) 612 (and (eqv? (file-length p) (+ 2000 n)) 613 (eq? (read p) 'ho) 614 (eq? (read p) 'there) 615 (eqv? (file-position p) n) 616 (eqv? (file-position p 2000) (void)) 617 (eq? (read p) 'hi) 618 (eq? (read p) 'there) 619 (= (file-position p) (file-length p) (+ 2000 n)) 620 (eqv? (close-input-port p) (void))))) 621 ) 622 623(mat string-port-file-position 624 (let ([ip (open-input-string "hit me")]) 625 (and (eq? (read ip) 'hit) 626 (eq? (file-position ip) 3) 627 (begin 628 (file-position ip 1) 629 (eq? (read ip) 'it)) 630 (begin 631 (file-position ip 6) 632 (eof-object? (read ip))) 633 (begin 634 (file-position ip 0) 635 (eq? (read ip) 'hit)))) 636 (error? (file-position (open-input-string "hi") 3)) 637 (error? (file-position (open-input-string "hi") -1)) 638 (let () 639 (define f 640 (lambda (n) 641 (let ([op (open-output-string)]) 642 (and (begin 643 (write 'ab op) 644 (eq? (file-position op) 2)) 645 (begin 646 (file-position op 4) 647 (write 'ef op) 648 (eq? (file-position op) 6)) 649 (begin 650 (file-position op 2) 651 (write 'cd op) 652 (eq? (file-position op) 4)) 653 (begin 654 (set-port-length! op n) 655 (get-output-string op)))))) 656 (and (equal? (f 6) "abcdef") 657 (equal? (f 4) "abcd") 658 (equal? (f 2) "ab") 659 (equal? (f 0) "") 660 (equal? (f 5) "abcde") 661 (let ((s (f 2000))) 662 (and s (= (string-length s) 2000))))) 663 (error? (file-position (open-output-string) -1)) 664 ) 665 666(mat fresh-line 667 (procedure? fresh-line) 668 (error? (fresh-line 3)) 669 (error? (fresh-line (open-input-string "hello"))) 670 (equal? 671 (with-output-to-string 672 (lambda () 673 (fresh-line) 674 (fresh-line) 675 (display "hello") 676 (fresh-line) 677 (fresh-line))) 678 "hello\n") 679 (begin 680 (with-output-to-file "testfile.ss" 681 (lambda () 682 (fresh-line) 683 (fresh-line) 684 (display "hello") 685 (fresh-line) 686 (fresh-line)) 687 'replace) 688 #t) 689 (call-with-input-file "testfile.ss" 690 (lambda (p) 691 (let ([s (make-string 100)]) 692 (and 693 (= (block-read p s (string-length s)) 6) 694 (string=? (substring s 0 6) "hello\n") 695 (eof-object? (read-char p)))))) 696 (begin 697 (with-output-to-file "testfile.ss" 698 (lambda () 699 (write-char #\a) 700 (fresh-line) 701 (flush-output-port) 702 (set-port-bol! (current-output-port) #f) 703 (fresh-line) 704 (write-char #\b) 705 (flush-output-port) 706 (set-port-bol! (current-output-port) #t) 707 (fresh-line) 708 (fresh-line) 709 (write-char #\c) 710 (fresh-line) 711 (fresh-line)) 712 'replace) 713 #t) 714 (call-with-input-file "testfile.ss" 715 (lambda (p) 716 (let ([s (make-string 100)]) 717 (and 718 (= (block-read p s (string-length s)) 6) 719 (string=? (substring s 0 6) "a\n\nbc\n") 720 (eof-object? (read-char p)))))) 721 ) 722 723(mat char-ready? 724 (procedure? char-ready?) 725 (let ([x (open-input-string "a")]) 726 (and (char-ready? x) 727 (eqv? (read-char x) #\a) 728 (char-ready? x) 729 (eof-object? (read-char x)))) 730 (parameterize ([current-input-port (open-input-string "a")]) 731 (and (char-ready?) 732 (eqv? (read-char) #\a) 733 (char-ready?) 734 (eof-object? (read-char)))) 735 ) 736 737(mat clear-input-port ; test interactively 738 (procedure? clear-input-port) 739 ) 740 741;;; pretty-equal? is like equal? except that it considers gensyms 742;;; with equal print names to be equal and any two nans to be equal. 743(define pretty-equal? 744 (rec equal? 745 (lambda (x y) ; mostly snarfed from 5_1.ss 746 (or (cond 747 [(eq? x y) #t] 748 [(pair? x) 749 (and (pair? y) 750 (equal? (car x) (car y)) 751 (equal? (cdr x) (cdr y)))] 752 [(symbol? x) 753 (and (gensym? x) 754 (gensym? y) 755 (string=? (symbol->string x) (symbol->string y)))] 756 [(or (null? x) (null? y)) #f] 757 [(or (char? x) (char? y)) #f] 758 [(flonum? x) 759 (and (flonum? y) 760 (or (let ([nan? (lambda (x) (not (fl= x x)))]) 761 (and (nan? x) (nan? y))) 762 (fl= x y)))] 763 [(number? x) 764 (and (number? y) 765 (if (exact? x) 766 (and (exact? y) (= x y)) 767 (and (equal? (real-part x) (real-part y)) 768 (equal? (imag-part x) (imag-part y)))))] 769 [(string? x) (and (string? y) (string=? x y))] 770 [(box? x) (and (box? y) (equal? (unbox x) (unbox y)))] 771 [(vector? x) 772 (and (vector? y) 773 (= (vector-length x) (vector-length y)) 774 (let f ([i (- (vector-length x) 1)]) 775 (or (< i 0) 776 (and (equal? (vector-ref x i) (vector-ref y i)) 777 (f (1- i))))))] 778 [(fxvector? x) 779 (and (fxvector? y) 780 (= (fxvector-length x) (fxvector-length y)) 781 (let f ([i (- (fxvector-length x) 1)]) 782 (or (< i 0) 783 (and (fx= (fxvector-ref x i) (fxvector-ref y i)) 784 (f (1- i))))))] 785 [(bytevector? x) 786 (and (bytevector? y) 787 (bytevector=? x y))] 788 [else #f]) 789 (parameterize ([print-length 6] [print-level 3]) 790 (display "----------------------\n") 791 (pretty-print x) 792 (pretty-print '=/=) 793 (pretty-print y) 794 (display "----------------------\n") 795 #f))))) 796 797(mat pretty-print 798 (let ([pretty-copy 799 (lambda (ifn ofn) 800 (let ([ip (open-input-file ifn)] 801 [op (open-output-file ofn 'replace)]) 802 (dynamic-wind 803 (lambda () #f) 804 (rec loop 805 (lambda () 806 (let ([x (read ip)]) 807 (or (eof-object? x) 808 (parameterize ([print-unicode #f]) 809 (pretty-print x op) 810 (newline op) 811 (loop)))))) 812 (lambda () 813 (close-input-port ip) 814 (close-output-port op)))))]) 815 (pretty-copy "prettytest.ss" "testfile.ss")) 816 (let ([p1 (open-input-file "prettytest.ss")] 817 [p2 (open-input-file "testfile.ss")]) 818 (dynamic-wind 819 (lambda () #f) 820 (rec loop 821 (lambda () 822 (let ([x1 (read p1)] [x2 (read p2)]) 823 (unless (pretty-equal? x1 x2) 824 (errorf 'pretty-equal "~s is not equal to ~s" x1 x2)) 825 (or (eof-object? x1) (loop))))) 826 (lambda () 827 (close-input-port p1) 828 (close-input-port p2)))) 829 (error? (pretty-format)) 830 (error? (pretty-format 'foo 'x 'x)) 831 (error? (pretty-format 3 'x)) 832 (error? (pretty-format 'foo '(bad 0 ... ... 0 format))) 833 (list? (pretty-format 'let)) 834 (let ([x (pretty-format 'let)]) 835 (pretty-format 'let x) 836 (equal? x (pretty-format 'let))) 837 (string=? 838 (parameterize ([pretty-standard-indent 2] [pretty-one-line-limit 1]) 839 (pretty-format 'frob '(frob (x 1 ...) 3 (x #f ...) 4 (x y 3 ...) ...)) 840 (with-output-to-string 841 (lambda () 842 (pretty-print '(frob (alpha b c d) 843 (peter o n m) 844 (zero 1 2 3) 845 (nine 8 7 6)))))) 846 "(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") 847 (eqv? (begin (pretty-format 'frob #f) (pretty-format 'frob)) #f) 848 (equal? 849 (with-output-to-string 850 (lambda () 851 (pretty-print ''#'#`#,#,@,,@`(a b c)))) 852 "'#'#`#,#,@,,@`(a b c)\n") 853 ) 854 855(mat write 856 (let ([unpretty-copy 857 (lambda (ifn ofn) 858 (let ([ip (open-input-file ifn)] 859 [op (open-output-file ofn 'replace)]) 860 (dynamic-wind 861 (lambda () #f) 862 (rec loop 863 (lambda () 864 (let ([x (read ip)]) 865 (or (eof-object? x) 866 (parameterize ([print-unicode #f]) 867 (write x op) 868 (newline op) 869 (loop)))))) 870 (lambda () 871 (close-input-port ip) 872 (close-output-port op)))))]) 873 (unpretty-copy "prettytest.ss" "testfile.ss")) 874 (let ([p1 (open-input-file "prettytest.ss")] 875 [p2 (open-input-file "testfile.ss")]) 876 (dynamic-wind 877 (lambda () #f) 878 (rec loop 879 (lambda () 880 (let ([x1 (read p1)] [x2 (read p2)]) 881 (unless (pretty-equal? x1 x2) 882 (errorf 'pretty-equal "~s is not equal to ~s" x1 x2)) 883 (or (eof-object? x1) (loop))))) 884 (lambda () 885 (close-input-port p1) 886 (close-input-port p2)))) 887 ) 888 889(mat fasl 890 (error? 891 (separate-eval '(let ([op (open-file-output-port "testfile.ss" (file-options compressed replace))]) 892 (fasl-write 3 op)))) 893 (error? 894 (separate-eval '(let ([ip (open-file-input-port "testfile.ss" (file-options compressed))]) 895 (fasl-read ip)))) 896 (equal? 897 (separate-eval '(with-exception-handler 898 (lambda (c) (unless (warning? c) (raise-continuable c))) 899 (lambda () 900 (let ([op (open-file-output-port "testfile.ss" (file-options compressed replace))]) 901 (fasl-write 3 op))))) 902 "") 903 (equal? 904 (separate-eval `(with-exception-handler 905 (lambda (c) (unless (warning? c) (raise-continuable c))) 906 (lambda () 907 (let ([ip (open-file-input-port "testfile.ss" (file-options compressed))]) 908 (fasl-read ip))))) 909 "3\n") 910 (pretty-equal? 911 (begin 912 (call-with-port 913 (open-file-output-port "testfile.ss" (file-options replace)) 914 (lambda (p) (fasl-write +nan.0 p))) 915 (call-with-port (open-file-input-port "testfile.ss") fasl-read)) 916 (/ 0.0 0.0)) 917 (let ([ls (with-input-from-file "prettytest.ss" 918 (rec f 919 (lambda () 920 (let ([x (read)]) 921 (if (eof-object? x) '() (cons x (f)))))))]) 922 (define-record frob (x1 (uptr x2) (fixnum x3) (float x4) (double x5) (wchar_t x6) (integer-64 x7) (char x8) (unsigned-64 x9))) 923 (let ([x (make-frob '#(#&3+4i 3.456+723i 3/4) 7500000 (most-negative-fixnum) +nan.0 3.1415 #\x3d0 924 (- (expt 2 63) 5) #\$ (- (expt 2 64) 5))]) 925 (define put-stuff 926 (lambda (p) 927 (fasl-write (cons x x) p) 928 (fasl-write (list +nan.0 +inf.0 -inf.0 -0.0) p) 929 (for-each (lambda (x) (fasl-write x p)) ls))) 930 (define (get-stuff fasl-read) 931 (lambda (p) 932 (let ([y (fasl-read p)]) 933 (and (equal? ($record->vector (car y)) ($record->vector x)) 934 (eq? (cdr y) (car y)) 935 (pretty-equal? (fasl-read p) (list +nan.0 +inf.0 -inf.0 -0.0)) 936 (let loop ([ls ls]) 937 (let ([x1 (fasl-read p)] [x2 (if (null? ls) #!eof (car ls))]) 938 (unless (pretty-equal? x1 x2) 939 (errorf #f "~s is not equal to ~s" x1 x2)) 940 (or (eof-object? x1) (loop (cdr ls))))))))) 941 (call-with-port 942 (open-file-output-port "testfile.ss" (file-options replace)) 943 put-stuff) 944 (and 945 (call-with-port 946 (open-file-input-port "testfile.ss") 947 (get-stuff fasl-read)) 948 (call-with-port 949 (open-file-input-port "testfile.ss" (file-options #;compressed)) 950 (get-stuff fasl-read)) 951 (call-with-port 952 (open-file-input-port "testfile.ss" (file-options #;compressed)) 953 (get-stuff (lambda (p) 954 (when (eof-object? (lookahead-u8 p)) (printf "done\n")) 955 (fasl-read p)))) 956 (begin 957 (call-with-port 958 (open-file-output-port "testfile.ss" (file-options compressed replace)) 959 put-stuff) 960 (call-with-port 961 (open-file-input-port "testfile.ss" (file-options compressed)) 962 (get-stuff fasl-read))) 963 (call-with-port 964 (open-bytevector-input-port 965 (call-with-bytevector-output-port put-stuff)) 966 (get-stuff fasl-read))))) 967 (eqv? (fasl-file "prettytest.ss" "testfile.ss") (void)) 968 (let ([ls (with-input-from-file "prettytest.ss" 969 (rec f 970 (lambda () 971 (let ([x (read)]) 972 (if (eof-object? x) '() (cons x (f)))))))]) 973 (call-with-port 974 (open-file-input-port "testfile.ss") 975 (lambda (p) 976 (let loop ([ls ls]) 977 (let ([x1 (fasl-read p)] [x2 (if (null? ls) #!eof (car ls))]) 978 (unless (pretty-equal? x1 x2) 979 (errorf #f "~s is not equal to ~s" x1 x2)) 980 (or (eof-object? x1) (loop (cdr ls)))))))) 981 (equal? 982 (with-interrupts-disabled 983 (let ([ls (cons (weak-cons 'a 'b) (weak-cons 'c (cons 'd (weak-cons 'e #f))))]) 984 (call-with-port 985 (open-file-output-port "testfile.ss" (file-options replace)) 986 (lambda (p) (fasl-write ls p)))) 987 (let ([ls (call-with-port (open-file-input-port "testfile.ss") fasl-read)]) 988 (list 989 (equal? ls '((a . b) c d e . #f)) 990 (weak-pair? ls) 991 (weak-pair? (car ls)) 992 (weak-pair? (cdr ls)) 993 (weak-pair? (cddr ls)) 994 (weak-pair? (cdddr ls))))) 995 '(#t #f #t #t #f #t)) 996) 997 998(mat clear-output-port ; test interactively 999 (procedure? clear-output-port) 1000 ) 1001 1002(mat flush-output-port ; test interactively 1003 (procedure? flush-output-port) 1004 ) 1005 1006;;; section 6-3: 1007 1008(mat format 1009 (equal? (format "abcde") "abcde") 1010 (equal? (format "~s ~a ~c ~~ ~%" "hi" "there" #\X) 1011 (string-append "\"hi\" there X ~ " (string #\newline))) 1012 (equal? (format "~s" car) "#<procedure car>") 1013 (equal? (format "~s" (lambda () #f)) "#<procedure>") 1014 ) 1015 1016(mat printf 1017 (let ([p (open-output-string)]) 1018 (parameterize ([current-output-port p]) 1019 (printf "~s:~s" 3 4)) 1020 (equal? (get-output-string p) "3:4")) 1021 ) 1022 1023(mat fprintf 1024 (let ([p (open-output-string)]) 1025 (fprintf p "~s.~s:~s" 'abc 345 "xyz") 1026 (equal? (get-output-string p) "abc.345:\"xyz\"")) 1027 ) 1028 1029(mat cp1in-verify-format-warnings 1030 (warning? (parameterize ([#%$suppress-primitive-inlining #f]) 1031 (eval '(lambda () (import scheme) (format "~a~~~s" 5))))) 1032 (warning? (parameterize ([#%$suppress-primitive-inlining #f]) 1033 (eval '(lambda () (import scheme) (format "~a~a~a~s" 1 2 3 4 5 6))))) 1034 (warning? (parameterize ([#%$suppress-primitive-inlining #f]) 1035 (eval '(mat/cf (lambda () (import scheme) (format "~a~~~s" 5)))))) 1036 (warning? (parameterize ([#%$suppress-primitive-inlining #f]) 1037 (eval '(mat/cf (lambda () (import scheme) (format "~a~a~a~s" 1 2 3 4 5 6)))))) 1038 1039 (warning? (parameterize ([#%$suppress-primitive-inlining #f]) 1040 (eval '(lambda () (import scheme) (printf "abc~s"))))) 1041 (warning? (parameterize ([#%$suppress-primitive-inlining #f]) 1042 (eval '(lambda () (import scheme) (printf "~%~abc~adef~ag~s~~~%" 1 2 3 4 5))))) 1043 (warning? (parameterize ([#%$suppress-primitive-inlining #f]) 1044 (eval '(mat/cf (lambda () (import scheme) (printf "abc~s")))))) 1045 (warning? (parameterize ([#%$suppress-primitive-inlining #f]) 1046 (eval '(mat/cf (lambda () (import scheme) (printf "~%~abc~adef~ag~s~~~%" 1 2 3 4 5)))))) 1047 1048 (warning? (parameterize ([#%$suppress-primitive-inlining #f]) 1049 (eval '(lambda (p) (import scheme) (fprintf p "abc~s"))))) 1050 (warning? (parameterize ([#%$suppress-primitive-inlining #f]) 1051 (eval '(lambda (p) (import scheme) (fprintf p "~%~abc~adef~ag~s~~~%" 1 2 3 4 5))))) 1052 (warning? (parameterize ([#%$suppress-primitive-inlining #f]) 1053 (eval '(mat/cf (lambda (p) (import scheme) (fprintf p "abc~s")))))) 1054 (warning? (parameterize ([#%$suppress-primitive-inlining #f]) 1055 (eval '(mat/cf (lambda (p) (import scheme) (fprintf p "~%~abc~adef~ag~s~~~%" 1 2 3 4 5)))))) 1056) 1057 1058(mat print-parameters 1059 (equal? (parameterize ([print-level 3]) 1060 (format "~s" (let ([x (list 'a)]) (set-car! x x) x))) 1061 "((((...))))") 1062 (equal? (parameterize ([print-length 3]) 1063 (format "~s" (let ([x (list 'a)]) (set-cdr! x x) x))) 1064 "(a a a ...)") 1065 (equal? (parameterize ([print-graph #t]) 1066 (format "~s" (let ([x (list 'a)]) (set-car! x x) x))) 1067 "#0=(#0#)") 1068 (equal? (parameterize ([print-graph #t]) 1069 (format "~s" (let ([x (list 'a)]) (set-cdr! x x) x))) 1070 "#0=(a . #0#)") 1071 (equal? (parameterize ([print-graph #t]) 1072 (format "~s" (let ([x (list 'a)] [y (list 'b)]) 1073 (list x y y x)))) 1074 "(#0=(a) #1=(b) #1# #0#)") 1075 (equal? (parameterize ([print-graph #t]) 1076 (format "~s" (let ([x (list 'a)] [y (list 'b)]) 1077 (vector x y y x)))) 1078 "#(#0=(a) #1=(b) #1# #0#)") 1079 (equal? (parameterize ([print-graph #t]) 1080 (format "~s" '(#2# #2=#{a b}))) 1081 "(#0=#{a b} #0#)") 1082 (error? (guard (c [(and (warning? c) (format-condition? c)) 1083 (apply errorf (condition-who c) (condition-message c) (condition-irritants c))]) 1084 (format "~s" 1085 (let ([x (list '*)]) 1086 (set-car! x x) 1087 (set-cdr! x x) 1088 x)))) 1089 (equal? (parameterize ([print-vector-length #f]) 1090 (format "~s ~s" '#5(1 2 3) '#8vfx(5 7 9 8 8 9 -1))) 1091 "#(1 2 3 3 3) #vfx(5 7 9 8 8 9 -1 -1)") 1092 (equal? (parameterize ([print-vector-length #t]) 1093 (format "~s ~s" '#(1 2 3 3 3) '#vfx(5 7 9 8 8 9 -1 -1))) 1094 "#5(1 2 3) #8vfx(5 7 9 8 8 9 -1)") 1095 (equal? (parameterize ([print-vector-length #f]) 1096 (format "~a ~a" '#5(1 2 3) '#8vfx(5 7 9 8 8 9 -1))) 1097 "#(1 2 3 3 3) #vfx(5 7 9 8 8 9 -1 -1)") 1098 (equal? (parameterize ([print-vector-length #t]) 1099 (format "~a ~a" '#(1 2 3 3 3) '#vfx(5 7 9 8 8 9 -1 -1))) 1100 "#(1 2 3 3 3) #vfx(5 7 9 8 8 9 -1 -1)") 1101 (equal? (parameterize ([print-vector-length #f]) 1102 (with-output-to-string 1103 (lambda () 1104 (pretty-print '#5(1 2 3)) 1105 (pretty-print '#8vfx(5 7 9 8 8 9 -1))))) 1106 "#(1 2 3 3 3)\n#vfx(5 7 9 8 8 9 -1 -1)\n") 1107 (equal? (parameterize ([print-vector-length #t]) 1108 (with-output-to-string 1109 (lambda () 1110 (pretty-print '#(1 2 3 3 3)) 1111 (pretty-print '#vfx(5 7 9 8 8 9 -1 -1))))) 1112 "#5(1 2 3)\n#8vfx(5 7 9 8 8 9 -1)\n") 1113 (equal? (parameterize ([print-extended-identifiers #f]) 1114 (with-output-to-string 1115 (lambda () 1116 (for-each pretty-print '(1+ +++ .. |12| xyz aBc |-155| |.5e7| |.5e|))))) 1117 "\\x31;+\n\\x2B;++\n\\x2E;.\n\\x31;2\nxyz\naBc\n\\x2D;155\n\\x2E;5e7\n\\x2E;5e\n") 1118 (equal? (parameterize ([print-extended-identifiers #t]) 1119 (with-output-to-string 1120 (lambda () 1121 (for-each pretty-print '(1+ +++ .. |12| xyz aBc |-155| |.5e7| |.5e|))))) 1122 "1+\n+++\n..\n\\x31;2\nxyz\naBc\n\\x2D;155\n\\x2E;5e7\n.5e\n") 1123 (equal? (parameterize ([print-gensym #f]) 1124 (format "~s" '(#3# #3=#{g0 fool}))) 1125 "(g0 g0)") 1126 (equal? (parameterize ([print-graph #t] [print-gensym #f]) 1127 (format "~s" '(#4# #4=#{g0 fool}))) 1128 "(#0=g0 #0#)") 1129 (equal? (parameterize ([print-gensym 'pretty]) 1130 (format "~s" '(#5# #5=#{g0 fool}))) 1131 "(#:g0 #:g0)") 1132 (equal? (parameterize ([print-graph #t] [print-gensym 'pretty]) 1133 (format "~s" '(#6# #6=#{g0 fool}))) 1134 "(#0=#:g0 #0#)") 1135 (equal? (parameterize ([print-gensym 'pretty]) 1136 (format "~s" '(#7# #7=#:g0))) 1137 "(#:g0 #:g0)") 1138 (let ([g (gensym "x")]) 1139 (parameterize ([print-gensym 'pretty/suffix]) 1140 (equal? (format "~s" g) (format "~s" g)))) 1141 (do ([i 100 (fx- i 1)]) 1142 ((fx= i 0) #t) 1143 (let ([g (gensym "x")]) 1144 (unless (< (string-length (parameterize ([print-gensym 'pretty/suffix]) 1145 (format "~s" g))) 1146 (string-length (parameterize ([print-gensym #t]) 1147 (format "~s" g)))) 1148 (error #f "failed")))) 1149 (let ([g (gensym "x")]) 1150 (let ([x (with-input-from-string 1151 (parameterize ([print-gensym 'pretty/suffix]) 1152 (format "~s" g)) 1153 read)]) 1154 (and (symbol? x) (not (gensym? x))))) 1155 (equal? (parameterize ([print-gensym 'pretty/suffix]) 1156 (format "~s" '#{g0 cfdhkxfnlo6opm0x-c})) 1157 "g0.cfdhkxfnlo6opm0x-c") 1158 (equal? (parameterize ([print-graph #t] [print-gensym 'pretty]) 1159 (format "~s" '(#8# #8=#:g0))) 1160 "(#0=#:g0 #0#)") 1161 (equal? (parameterize ([print-brackets #t]) 1162 (let ([p (open-output-string)]) 1163 (pretty-print '(let ((x 3)) x) p) 1164 (get-output-string p))) 1165 (format "~a~%" "(let ([x 3]) x)")) 1166 (equal? (parameterize ([print-brackets #f]) 1167 (let ([p (open-output-string)]) 1168 (pretty-print '(let ((x 3)) x) p) 1169 (get-output-string p))) 1170 (format "~a~%" "(let ((x 3)) x)")) 1171 (equal? (parameterize ([case-sensitive #t]) 1172 (format "~s" (string->symbol "AbcDEfg"))) 1173 "AbcDEfg") 1174 (equal? (format "~s" (read (open-input-string "abCdEfG"))) 1175 "abCdEfG") 1176 (equal? (parameterize ([case-sensitive #f]) 1177 (format "~s" (read (open-input-string "abCdEfG")))) 1178 "abcdefg") 1179 (equal? (parameterize ([print-radix 36]) 1180 (format "~s" 35)) 1181 "#36rZ") 1182 (equal? (parameterize ([print-radix 36]) 1183 (format "~a" 35)) 1184 "Z") 1185) 1186 1187(mat general-port 1188 (<= (port-input-index (console-input-port)) 1189 (port-input-size (console-input-port)) 1190 (string-length (port-input-buffer (console-input-port)))) 1191 (<= (port-input-count (console-input-port)) 1192 (string-length (port-input-buffer (console-input-port)))) 1193 (<= (port-output-index (console-output-port)) 1194 (port-output-size (console-output-port)) 1195 (string-length (port-output-buffer (console-output-port)))) 1196 (<= (port-output-count (console-output-port)) 1197 (string-length (port-output-buffer (console-output-port)))) 1198 (equal? 1199 (let ([sip (open-string-input-port "hello")]) 1200 (let ([n1 (port-input-count sip)]) 1201 (read-char sip) 1202 (list n1 (port-input-count sip)))) 1203 '(5 4)) 1204 (equal? 1205 (let ([op (make-output-port (lambda args (error #f "oops")) (make-string 10))]) 1206 (let ([n1 (port-output-count op)]) 1207 (display "hey!" op) 1208 (list n1 (port-output-count op)))) 1209 '(10 6)) 1210 (let () 1211 (define make-two-way-port 1212 ; no local buffering 1213 ; close-port passed through 1214 (lambda (ip op) 1215 (define handler 1216 (lambda (msg . args) 1217 (record-case (cons msg args) 1218 [block-read (p s n) (block-read ip s n)] 1219 [block-write (p s n) (block-write op s n)] 1220 [char-ready? (p) (char-ready? ip)] 1221 [clear-input-port (p) (clear-input-port ip)] 1222 [clear-output-port (p) (clear-output-port op)] 1223 [close-port (p) 1224 (close-port ip) 1225 (close-port op) 1226 (mark-port-closed! p)] 1227; [file-length (p) #f] 1228 [file-position (p . pos) 1229 (if (null? pos) 1230 (most-negative-fixnum) 1231 (errorf 'two-way-port "cannot reposition"))] 1232 [flush-output-port (p) (flush-output-port op)] 1233 [peek-char (p) (peek-char ip)] 1234 [port-name (p) "two-way port"] 1235 [read-char (p) (read-char ip)] 1236 [unread-char (c p) (unread-char c ip)] 1237 [write-char (c p) (write-char c op)] 1238 [else (errorf 'two-way-port "operation ~s not handled" 1239 msg)]))) 1240 (make-input/output-port handler "" ""))) 1241 (let ([sip (open-input-string "far out")] 1242 [sop (open-output-string)]) 1243 (let ([p1 (make-two-way-port sip sop)]) 1244 (and (port? p1) 1245 (begin (write (read p1) p1) 1246 (string=? (get-output-string sop) "far")) 1247 (char-ready? p1) 1248 (char=? (read-char p1) #\space) 1249 (char=? (read-char p1) #\o) 1250 (begin (unread-char #\o p1) 1251 (char=? (read-char p1) #\o)) 1252 ; can't count on clear-output-port doing anything for 1253 ; string output ports, so next two checks are bogus 1254 #;(begin (write-char #\a p1) 1255 (clear-output-port p1) 1256 (string=? (get-output-string sop) "")) 1257 (begin 1258 (file-position sip (file-length sip)) 1259 (char-ready? p1)) 1260 (eof-object? (peek-char p1)) 1261 ; make sure these don't error out 1262 (eq? (clear-input-port p1) (void)) 1263 (eq? (clear-output-port p1) (void)) 1264 (begin (close-port p1) (port-closed? p1)) 1265 (port-closed? sip) 1266 (port-closed? sop))))) 1267 (let () 1268 (define make-broadcast-port 1269 ; local buffering 1270 ; closed-port not passed through 1271 ; critical sections used where necessary to protect against interrupts 1272 ; uses block-write to dump buffers to subordinate ports 1273 ; check cltl2 to see what it says about local buffering, 1274 ; and about passing through flush, clear, and close 1275 ; size set so that buffer always has room for character to be written, 1276 ; allowing buffer to be flushed as soon as it becomes full 1277 (lambda ports 1278 (define handler 1279 (lambda (msg . args) 1280 (record-case (cons msg args) 1281; [block-read (p s n) #f] 1282 [block-write (p s n) 1283 (unless (null? ports) 1284 (with-interrupts-disabled 1285 (flush-output-port p) 1286 (for-each (lambda (p) (block-write p s n)) 1287 ports)))] 1288; [char-ready? (p) (char-ready? ip)] 1289; [clear-input-port (p) (clear-input-port ip)] 1290 [clear-output-port (p) (set-port-output-index! p 0)] 1291 [close-port (p) 1292 (set-port-output-size! p 0) 1293 (mark-port-closed! p)] 1294; [file-length (p) #f] 1295 [file-position (p . pos) 1296 (if (null? pos) 1297 (most-negative-fixnum) 1298 (errorf 'broadcast-port "cannot reposition"))] 1299 [flush-output-port (p) 1300 (with-interrupts-disabled 1301 (unless (null? ports) 1302 (let ([b (port-output-buffer p)] 1303 [i (port-output-index p)]) 1304 (for-each (lambda (p) (block-write p b i)) 1305 ports))) 1306 (set-port-output-index! p 0))] 1307; [peek-char (p) (peek-char ip)] 1308 [port-name (p) "broadcast port"] 1309; [read-char (p) (read-char ip)] 1310; [unread-char (c p) (unread-char c ip)] 1311 [write-char (c p) 1312 (with-interrupts-disabled 1313 (unless (null? ports) 1314 (let ([b (port-output-buffer p)] 1315 [i (port-output-index p)]) 1316 ; could check here to be sure that we really need 1317 ; to flush 1318 (string-set! b i c) 1319 (for-each (lambda (p) 1320 (block-write p b (fx+ i 1))) 1321 ports))) 1322 (set-port-output-index! p 0))] 1323 [else (errorf 'broadcast-port "operation ~s not handled" 1324 msg)]))) 1325 (let ([len 1024]) 1326 (let ([p (make-output-port handler (make-string len))]) 1327 (set-port-output-size! p (fx- len 1)) 1328 p)))) 1329 (let ([p (make-broadcast-port)]) 1330 (and (port? p) 1331 (let ([x (make-string 1000 #\a)]) 1332 (let loop ([i 1000]) 1333 (if (fx= i 0) 1334 (fx<= (port-output-index p) 1335 (port-output-size p) 1336 (string-length (port-output-buffer p))) 1337 (begin (display x p) 1338 (loop (fx- i 1)))))) 1339 (begin (close-port p) (port-closed? p)))) 1340 (let ([sop (open-output-string)]) 1341 (let ([p (make-broadcast-port sop sop)]) 1342 (and (port? p) 1343 (let ([x "abcde"]) 1344 (display x p) 1345 (and (string=? (get-output-string sop) "") 1346 (begin (flush-output-port p) 1347 (string=? (get-output-string sop) 1348 (string-append x x))))) 1349 (begin (close-output-port p) (port-closed? p)))))) 1350 1351 (let () 1352 (define make-transcript-port 1353 ; local buffering; run into problems with unread-char and 1354 ; clear-output-port otherwise 1355 ; close-port passed through to tp only 1356 (lambda (ip op tp) 1357 (define handler 1358 (lambda (msg . args) 1359 (record-case (cons msg args) 1360 [block-read (p str cnt) 1361 (with-interrupts-disabled 1362 (let ([b (port-input-buffer p)] 1363 [i (port-input-index p)] 1364 [s (port-input-size p)]) 1365 (if (< i s) 1366 (let ([cnt (fxmin cnt (fx- s i))]) 1367 (do ([i i (fx+ i 1)] 1368 [j 0 (fx+ j 1)]) 1369 ((fx= j cnt) 1370 (set-port-input-index! p i) 1371 cnt) 1372 (string-set! str j (string-ref b i)))) 1373 (let ([cnt (block-read ip str cnt)]) 1374 (unless (eof-object? cnt) 1375 (block-write tp str cnt)) 1376 cnt))))] 1377 [char-ready? (p) 1378 (or (< (port-input-index p) (port-input-size p)) 1379 (char-ready? ip))] 1380 [clear-input-port (p) 1381 ; set size to zero rather than index to size 1382 ; in order to invalidate unread-char 1383 (set-port-input-size! p 0)] 1384 [clear-output-port (p) (set-port-output-index! p 0)] 1385 [close-port (p) 1386 (flush-output-port p) 1387 (close-port tp) 1388 (set-port-output-size! p 0) 1389 (set-port-input-size! p 0) 1390 (mark-port-closed! p)] 1391; [file-length (p) #f] 1392 [file-position (p . pos) 1393 (if (null? pos) 1394 (most-negative-fixnum) 1395 (errorf 'transcript-port "cannot reposition"))] 1396 [flush-output-port (p) 1397 (with-interrupts-disabled 1398 (let ([b (port-output-buffer p)] 1399 [i (port-output-index p)]) 1400 (block-write op b i) 1401 (block-write tp b i) 1402 (set-port-output-index! p 0) 1403 (flush-output-port op) 1404 (flush-output-port tp)))] 1405 [peek-char (p) 1406 (with-interrupts-disabled 1407 (let ([b (port-input-buffer p)] 1408 [i (port-input-index p)] 1409 [s (port-input-size p)]) 1410 (if (fx< i s) 1411 (string-ref b i) 1412 (begin (flush-output-port p) 1413 (let ([s (block-read ip b)]) 1414 (if (eof-object? s) 1415 s 1416 (begin (block-write tp b s) 1417 (set-port-input-size! p s) 1418 (string-ref b 0))))))))] 1419 [port-name (p) "transcript"] 1420 [read-char (p) 1421 (with-interrupts-disabled 1422 (let ([c (peek-char p)]) 1423 (unless (eof-object? c) 1424 (set-port-input-index! p 1425 (fx+ (port-input-index p) 1))) 1426 c))] 1427 [unread-char (c p) 1428 (with-interrupts-disabled 1429 (let ([b (port-input-buffer p)] 1430 [i (port-input-index p)] 1431 [s (port-input-size p)]) 1432 (when (fx= i 0) 1433 (errorf 'unread-char 1434 "tried to unread too far on ~s" 1435 p)) 1436 (set-port-input-index! p (fx- i 1)) 1437 ; following could be skipped; supposed to be 1438 ; same character 1439 (string-set! b (fx- i 1) c)))] 1440 [write-char (c p) 1441 (with-interrupts-disabled 1442 (let ([b (port-output-buffer p)] 1443 [i (port-output-index p)] 1444 [s (port-output-size p)]) 1445 (string-set! b i c) 1446 ; could check here to be sure that we really need 1447 ; to flush 1448 (block-write op b (fx+ i 1)) 1449 (block-write tp b (fx+ i 1)) 1450 (set-port-output-index! p 0)))] 1451 [block-write (p str cnt) 1452 (with-interrupts-disabled 1453 (let ([b (port-output-buffer p)] 1454 [i (port-output-index p)]) 1455 ; flush buffered data 1456 (when (fx> i 0) 1457 (block-write op b i) 1458 (block-write tp b i)) 1459 ; write new data 1460 (block-write op str cnt) 1461 (block-write tp str cnt) 1462 (set-port-output-index! p 0)))] 1463 [else (errorf 'transcript-port "operation ~s not handled" 1464 msg)]))) 1465 (let ([ib (make-string 100)] [ob (make-string 100)]) 1466 (let ([p (make-input/output-port handler ib ob)]) 1467 (if (char-ready? ip) 1468 ; kludge so that old input doesn't show up after later 1469 ; output (e.g., input newline after output prompt) 1470 (let ((n (block-read ip ib (string-length ib)))) 1471 (if (eof-object? n) 1472 (set-port-input-size! p 0) 1473 (set-port-input-size! p n))) 1474 (set-port-input-size! p 0)) 1475 (set-port-output-size! p (fx- (string-length ob) 1)) 1476 p)))) 1477; (define-record tp-frame (cip cop tp)) 1478; (define tp-stack '()) 1479; (define transcript-on 1480; (lambda (fn) 1481; (with-interrupts-disabled 1482; (let ((cip (console-input-port)) 1483; (cop (console-output-port))) 1484; (let ((tp (make-transcript-port cip cop 1485; (open-output-file fn 'replace)))) 1486; (set! tp-stack (cons (make-tp-frame cip cop tp) tp-stack)) 1487; (console-output-port tp) 1488; (console-input-port tp) 1489; (when (eq? (current-input-port) cip) 1490; (current-input-port tp)) 1491; (when (eq? (current-output-port) cop) 1492; (current-output-port tp))))))) 1493; (define transcript-off 1494; (lambda () 1495; (with-interrupts-disabled 1496; (when (null? tp-stack) (errorf 'transcript-off "no transcript running")) 1497; (let ((frame (car tp-stack))) 1498; (let ((cip (tp-frame-cip frame)) 1499; (cop (tp-frame-cop frame)) 1500; (tp (tp-frame-tp frame))) 1501; (console-input-port cip) 1502; (console-output-port cop) 1503; (when (eq? (current-input-port) tp) (current-input-port cip)) 1504; (when (eq? (current-output-port) tp) (current-output-port cop)) 1505; (set! tp-stack (cdr tp-stack)) 1506; (close-port tp)))))) 1507 (let ([ip (open-input-string (format "2"))] 1508 [op (open-output-string)] 1509 [tp (open-output-string)]) 1510 (let ([p (make-transcript-port ip op tp)]) 1511 (and (begin (display "1" p) (eq? (read p) 2)) 1512 (begin (display "3" p) 1513 (flush-output-port p) 1514 (and (string=? (get-output-string op) "13") 1515 ; 2 doesn't show up since we scan past available 1516 ; input (see "kludge" above) 1517 (string=? (get-output-string tp) "13"))) 1518 (begin (close-port p) 1519 (and (port-closed? p) (port-closed? tp))))))) 1520 ) 1521 1522(mat port-handler 1523 (begin (set! ph (port-handler (current-output-port))) 1524 (procedure? ph)) 1525 (string? (ph 'port-name (current-output-port))) 1526 (error? (ph)) 1527 (error? (ph 'foo)) 1528 (error? (ph 'foo (current-output-port))) 1529 (error? (ph 'read-char)) 1530 (error? (ph 'write-char)) 1531 (error? (ph 'write-char 3)) 1532 (error? (ph 'write-char (current-input-port))) 1533 (error? (ph 'write-char 'a (current-output-port))) 1534 (error? (ph 'write-char #\a 'a)) 1535 (error? (ph 'write-char #\a (open-input-string "hello"))) 1536 (error? (ph 'write-char #\a (current-output-port) 'a)) 1537 (boolean? (ph 'char-ready? (current-input-port))) 1538 ) 1539 1540(mat char-name 1541 (eqv? (char-name 'space) #\space) 1542 (eqv? (char-name #\space) 'space) 1543 (eqv? (char-name 'tab) #\tab) 1544 (eqv? (char-name #\tab) 'tab) 1545 (eqv? (char-name 'return) #\return) 1546 (eqv? (char-name #\return) 'return) 1547 (eqv? (char-name 'page) #\page) 1548 (eqv? (char-name #\page) 'page) 1549 (eqv? (char-name 'linefeed) #\linefeed) 1550 (eqv? (char-name #\linefeed) 'newline) 1551 (eqv? (char-name 'newline) #\newline) 1552 (eqv? (char-name #\newline) 'newline) 1553 (eqv? (char-name #\backspace) 'backspace) 1554 (eqv? (char-name 'backspace) #\backspace) 1555 (eqv? (char-name #\rubout) 'delete) 1556 (eqv? (char-name 'rubout) #\rubout) 1557 (eqv? (char-name #\nul) 'nul) 1558 (eqv? (char-name 'nul) #\nul) 1559 (eqv? (char-name 'foo) #f) 1560 (eqv? (char-name 'delete) #\delete) 1561 (eqv? (char-name #\delete) 'delete) 1562 (eqv? (char-name 'vtab) #\vtab) 1563 (eqv? (char-name #\vtab) 'vtab) 1564 (eqv? (char-name 'alarm) #\alarm) 1565 (eqv? (char-name #\alarm) 'alarm) 1566 (eqv? (char-name 'esc) #\esc) 1567 (eqv? (char-name #\esc) 'esc) 1568 (error? (read (open-input-string "#\\foo"))) 1569 (and (eqv? (char-name 'foo #\003) (void)) 1570 (eqv? (char-name 'foo) #\003) 1571 (eqv? (char-name #\003) 'foo) 1572 (eqv? (read (open-input-string "#\\foo")) #\003)) 1573 (equal? 1574 (begin 1575 (char-name 'foo #f) 1576 (list (char-name 'foo) (char-name #\003))) 1577 '(#f #f)) 1578 (error? (read (open-input-string "#\\new\\line"))) 1579 (error? (read (open-input-string "#\\new\\x6c;ine"))) 1580 ) 1581 1582(mat string-escapes 1583 (eqv? (string-ref "ab\b" 2) #\backspace) 1584 (eqv? (string-ref "\n" 0) #\newline) 1585 (eqv? (string-ref "a\fb" 1) #\page) 1586 (eqv? (string-ref "ab\r" 2) #\return) 1587 (eqv? (string-ref "\t" 0) #\tab) 1588 (eqv? (string-ref "\a\v" 0) #\bel) 1589 (eqv? (string-ref "\a\v" 1) #\vt) 1590 (eqv? (string-ref "\000" 0) #\nul) 1591 (eqv? (string-ref "\x00;" 0) #\nul) 1592 (eqv? (string-ref "a\x20;b" 1) #\space) 1593 (eqv? (string-ref "\\\"\'" 0) #\\) 1594 (eqv? (string-ref "\\\"\'" 1) #\") 1595 (eqv? (string-ref "\\\"\'" 2) #\') 1596 (= (char->integer (string-ref "a\012" 1)) #o12 10) 1597 (= (char->integer (string-ref "a\015" 1)) #o15 13) 1598 (= (char->integer (string-ref "a\177" 1)) #o177 127) 1599 (= (char->integer (string-ref "a\377" 1)) #o377 255) 1600 (error? (read (open-input-string "\"ab\\\""))) 1601 (error? (read (open-input-string "\"ab\\0\""))) 1602 (error? (read (open-input-string "\"ab\\01\""))) 1603 (error? (read (open-input-string "\"ab\\*\""))) 1604 (error? (read (open-input-string "\"ab\\x\""))) 1605 (error? (read (open-input-string "\"ab\\x*\""))) 1606 (error? (read (open-input-string "\"ab\\xg\""))) 1607 (equal? (format "~s" "\bab\nc\f\rd\t\v\a") "\"\\bab\\nc\\f\\rd\\t\\v\\a\"") 1608 ) 1609 1610(mat read-token 1611 (let ([ip (open-input-string "(cons 33 #;hello \"rot\")")]) 1612 (and (let-values ([vals (read-token ip)]) 1613 (equal? vals '(lparen #f 0 1))) 1614 (let-values ([vals (read-token ip)]) 1615 (equal? vals '(atomic cons 1 5))) 1616 (let-values ([vals (read-token ip)]) 1617 (equal? vals '(atomic 33 6 8))) 1618 (let-values ([vals (read-token ip)]) 1619 (equal? vals '(quote datum-comment 9 11))) 1620 (let-values ([vals (read-token ip)]) 1621 (equal? vals '(atomic hello 11 16))) 1622 (let-values ([vals (read-token ip)]) 1623 (equal? vals '(atomic "rot" 17 22))) 1624 (let-values ([vals (read-token ip)]) 1625 (equal? vals '(rparen #f 22 23))))) 1626 (let () 1627 (define with-input-from-string 1628 (lambda (s p) 1629 (parameterize ([current-input-port (open-input-string s)]) 1630 (p)))) 1631 (with-input-from-string "\n#17#\n" 1632 (lambda () 1633 (let-values ([vals (read-token)]) 1634 (equal? vals '(insert 17 1 5)))))) 1635 (let () 1636 (with-output-to-file "testfile.ss" 1637 (lambda () (display "\n#eat\n")) 1638 'replace) 1639 #t) 1640 (error? 1641 (let* ([ip (open-file-input-port "testfile.ss")] 1642 [sfd (make-source-file-descriptor "testfile.ss" ip #t)] 1643 [ip (transcoded-port ip (native-transcoder))]) 1644 (dynamic-wind 1645 void 1646 (lambda () (read-token ip sfd 0)) 1647 (lambda () (close-input-port ip))))) 1648 (let () 1649 (with-output-to-file "testfile.ss" 1650 (lambda () (display "\neat\n")) 1651 'replace) 1652 #t) 1653 (equal? 1654 (let-values ([vals (let* ([ip (open-file-input-port "testfile.ss")] 1655 [sfd (make-source-file-descriptor "testfile.ss" ip #t)] 1656 [ip (transcoded-port ip (native-transcoder))]) 1657 (dynamic-wind 1658 void 1659 (lambda () (read-token ip sfd 0)) 1660 (lambda () (close-input-port ip))))]) 1661 vals) 1662 '(atomic eat 1 4)) 1663 ) 1664 1665(define read-test 1666 (lambda (s) 1667 (with-output-to-file "testfile.ss" 1668 (lambda () (display s)) 1669 'replace) 1670 (load "testfile.ss" values) 1671 #t)) 1672(define load-test 1673 (lambda (s) 1674 (with-output-to-file "testfile.ss" 1675 (lambda () (display s)) 1676 'replace) 1677 (load "testfile.ss") 1678 #t)) 1679(define compile-test 1680 (lambda (s) 1681 (with-output-to-file "testfile.ss" 1682 (lambda () (display s)) 1683 'replace) 1684 (compile-file "testfile.ss") 1685 (load "testfile.so") 1686 #t)) 1687 1688(define-syntax xmat 1689 (syntax-rules () 1690 [(_ string ...) 1691 (begin 1692 (mat read-test (error? (read-test string)) ...) 1693 (mat load-test (error? (load-test string)) ...) 1694 (mat compile-test (error? (compile-test string)) ...))])) 1695 1696(begin (define-record f800 (a b)) (record-reader "zinjanthropus" (type-descriptor f800))) 1697(begin (define-record $acyclic ((immutable notme))) (record-reader '$acyclic (type-descriptor $acyclic))) 1698 1699(xmat 1700 "; 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#@\x2;\x4;\x0;\x0;\x0;5.9b\x0;\x4;\x0;\x0;\x0;\x2;\x1;\x0;\x0;\x0;a\x2;\x1;\x0;\x0;\x0;b\x2;\x1;\x0;\x0;\x0;c\x2;\x1;\x0;\x0;\x0;d\f&\x0;\x0;\x0;\n" 1701 ) 1702 1703(xmat 1704 "; Test error \"bracketed list terminated by close parenthesis\"\n\n(define nil '[))\n\n" 1705 "; Test error \"bracketed list terminated by close parenthesis\"\n\n(cond [(foobar) 'baz) [else 'ok])\n\n" 1706 "; Test error \"bracketed list terminated by close parenthesis\"\n\n(define pair '[a . b))\n\n" 1707 "; Test error \"duplicate mark #~s= seen\"\n\n(#327=(a b c #327=d) #327#)\n\n" 1708 "; Test error \"expected close brace terminating gensym syntax\"\n\n(define #{foo |bar|\n (lambda (zap doodle)\n zap))\n\n" 1709 "; Test error \"expected close brace terminating gensym syntax\"\n\n(define foo\n (lambda (#{foo |bar| none)\n 'quack))\n\n" 1710 "; Test error \"expected one item after dot (.)\"\n\n(define foo\n (lambda (a b . )\n 'zapp))\n\n" 1711 "; Test error \"expected one item after dot (.)\"\n\n(define foo\n (lambda [a b . ]\n 'zapp))\n\n" 1712 "; Test error \"invalid character #\\\\~a~a~a\"\n\n(memv #\\401 (string->list \"abcd\"))\n\n" 1713 "; Test error \"invalid character #\\\\~a~a\"\n\n(make-list 25 (make-string 100 #\\37d))\n" 1714 "; Test error \"invalid character name\"\n\n(memv #\\bugsbunny (string->list \"looneytunes\"))\n" 1715 "; Test error \"invalid character name\"\n\n(memv #\\new (string->list \"deal\"))\n" 1716 "; Test error \"invalid character name\"\n\n(memv #\\Space (string->list \"no deal\"))\n" 1717 "; Test error \"invalid character name\"\n\n(memv #\\SPACE (string->list \"no deal\"))\n" 1718 "; Test error \"invalid number syntax\"\n\n(list #e23q3 'a 'b 'c)\n\n" 1719 "; Test error \"invalid number syntax\"\n\n(list #e3_4i 'a 'b 'c)\n\n" 1720 "; Test error \"invalid number syntax\"\n\n(list #e3+)" 1721 "; Test error \"invalid number syntax\"\n\n(sqrt #36r1+1i)\n\n" 1722 "; Test error \"invalid number syntax\"\n\n(sqrt #36r1+i)\n\n" 1723 "; Test error \"invalid number syntax\"\n\n(sqrt #36r1+1i)\n\n" 1724 "; Test error \"invalid number syntax\"\n\n(sqrt #36r1+i)\n\n" 1725 "; Test error \"cannot represent\"\n\n(sqrt 1/0)\n\n" 1726 "; Test error \"cannot represent\"\n\n(sqrt 1/0)\n\n" 1727 "; Test error \"cannot represent\"\n\n(sqrt 1#/0)\n\n" 1728 "; Test error \"cannot represent\"\n\n(sqrt 1##/0)\n\n" 1729 "; Test error \"cannot represent\"\n\n(sqrt #e1/0#)\n\n" 1730 "; Test error \"cannot represent\"\n\n(sqrt #e1/0###)\n\n" 1731 "; Test error \"cannot represent\"\n\n(sqrt #e1/0###)\n\n" 1732 "; Test error \"cannot represent\"\n\n(sqrt #e1/0###)\n\n" 1733 "; Test error \"cannot represent\"\n\n(sqrt #e1/0###)\n\n" 1734 "; Test error \"cannot represent\"\n\n(sqrt #e+inf.0)\n\n" 1735 "; Test error \"cannot represent\"\n\n(sqrt #e-inf.0)\n\n" 1736 "; Test error \"cannot represent\"\n\n(sqrt #e+nan.0)\n\n" 1737 "; Test error \"cannot represent\"\n\n(sqrt #e0/0e20)\n\n" 1738 "; Test error \"cannot represent\"\n\n(sqrt #e1@1)\n\n" 1739 "; Test error \"invalid number syntax\"\n\n(sqrt #e+nan.5)\n\n" 1740 "; Test error \"invalid sharp-sign prefix #~c\"\n\n(if #T #N #T)\n" 1741 "; Test error \"invalid sharp-sign prefix ~a~a\"\n\n(if (optimize-til-it-hurts?) (#7%super-fast+ 1 2) (+ 1 2))\n" 1742 "; Test error \"invalid sharp-sign prefix ~a~a\"\n\n(when #2_3_4 'huh?)\n" 1743 "; Test error \"invalid string character \\\\~c~c~c\"\n\n (define s \"james stock \\707!\")\n" 1744 "; Test error \"invalid string character \\\\~c~c\"\n\n\"=tofu\\07gnorefsefawd2slivne\"\n\n" 1745 "; Test error \"invalid string character \\\\~c\"\n\n\"I need \\3d glasses\"\n" 1746 "; Test error \"invalid string character\"\n\n(pretty-print \"this is \\xa fine mess\")\n" 1747 "; Test error \"invalid string character\"\n\n(pretty-print \"this is \\x\")\n" 1748 "; Test error \"invalid string character\"\n\n(pretty-print \"this is \\xGreat news!\")\n" 1749 "; Test error \"invalid string character \\\\~c\"\n\n\"status \\quo\"\n" 1750 "; Test error \"invalid syntax #!~s\"\n\n(when #!whuppo! 1 2 3)\n\n" 1751 "; Test error \"invalid syntax #!~s\"\n\n(when #!eo 1 2 3)\n\n" 1752 "; Test error \"invalid syntax #v~s\"\n\n(list #vxx())\n" 1753 "; Test error \"invalid syntax #~v,'0dv~s\"\n\n(list #073vxx())\n" 1754 "; Test error \"invalid syntax #v~s\"\n\n(list #vf())\n" 1755 "; Test error \"invalid syntax #~v,'0dv~s\"\n\n(list #073vf())\n" 1756 "; Test error \"invalid syntax #v~s\"\n\n(list #vfx[])\n" 1757 "; Test error \"invalid syntax #~v,'0dv~s\"\n\n(list #073vfx[])\n" 1758 "; Test error \"invalid vector length\"\n\n(vector-length #999999999999999999999999999999(a b c))\n\n" 1759 "; Test error \"invalid fxvector length\"\n\n(fxvector-length #999999999999999999999999999999vfx(1 2 3))\n\n" 1760 "; Test error \"invalid bytevector length\"\n\n(bytevector-length #999999999999999999999999999999vu8(1 2 3))\n\n" 1761 "; 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))" 1762 "; Test error \"more than one item found after dot (.)\"\n\n(define foo\n (lambda (able baker . charlie delta epsilon)\n 'wow))\n\n" 1763 "; Test error \"more than one item found after dot (.)\"\n\n(define foo\n (lambda [able baker . charlie delta epsilon]\n 'wow))\n\n" 1764 "; Test error \"non-symbol found after #[\"\n\n(pretty-print '#[(a \"b c\" #\\d) 1 2 3])\n" 1765 "; Test error \"outdated object file format\"\n\n\"What is\" #3q\n'(1 2 3)\n\n" 1766 "; Test error \"parenthesized list terminated by close bracket\"\n\n(define nil '(])\n\n" 1767 "; Test error \"parenthesized list terminated by close bracket\"\n\n(cond [(foobar) 'baz] (else 'ok])\n\n" 1768 "; Test error \"parenthesized list terminated by close bracket\"\n\n(define pair '(a . b])\n\n" 1769 "; Test error \"too many vector elements supplied\"\n\n(pretty-print '#3(one two three four five six seven))\n" 1770 "; Test error \"non-fixnum found in fxvector\"\n\n(pretty-print '#vfx(1 2.0 3 4))\n" 1771 "; Test error \"non-fixnum found in fxvector\"\n\n(pretty-print '#3vfx(1 2.0 3 4))\n" 1772 "; Test error \"too many fxvector elements supplied\"\n\n(pretty-print '#3vfx(1 2 3 4))\n" 1773 "; Test error \"invalid value 2.0 found in bytevector\"\n\n(pretty-print '#vu8(1 2.0 3 4))\n" 1774 "; Test error \"invalid value -1 found in bytevector\"\n\n(pretty-print '#3vu8(1 -1 3 4))\n" 1775 "; Test error \"too many bytevector elements supplied\"\n\n(pretty-print '#3vu8(1 2 3 4))\n" 1776 "; Test error \"too few fields supplied for record ~s\"\n\n(define x '#[zinjanthropus 3])" 1777 "; Test error \"too many fields supplied for record ~s\"\n\n(define x '#[zinjanthropus 3 4 5])" 1778 "; Test error \"unexpected close bracket\"\n\n1 2 3 ]\n" 1779 "; Test error \"unexpected close parenthesis\"\n\n(define x 3))\n" 1780 "; Test error \"unexpected dot\"\n\n(lambda (x . . y) x)\n\n" 1781 "; Test error \"unexpected dot\"\n\n(lambda ( . y) y)\n\n" 1782 "; Test error \"unexpected dot\"\n\n(define x '(a . b . c))\n" 1783 "; Test error \"unexpected dot\"\n\n(define x '[a . b . c])\n" 1784 "; 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" 1785 "; Test error \"unexpected end-of-file reading block comment\"\n(pretty-print\n #| foo\n #" 1786 "; Test error \"unexpected end-of-file reading block comment\"\n(pretty-print\n #| foo\n |" 1787 "; Test error \"unexpected end-of-file reading box\"\n\n #& ; box is empty!\n" 1788 "; Test error \"unexpected end-of-file reading bracketed list\" (before first element)\n\n(lambda (x y z)\n (cond\n [\n\n " 1789 "; 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" 1790 "; Test error \"unexpected end-of-file reading bracketed list\" (after dot)\n\n(car '[a b . c\n\n" 1791 "; Test error \"unexpected end-of-file reading bracketed list\" (after element after dot)\n\n(car '[a b . c\n\n" 1792 "; Test error \"unexpected end-of-file reading character\"\n#\\" 1793 "; Test error \"unexpected end-of-file reading character\"\n#\\new" 1794 "; Test error \"unexpected end-of-file reading character\"\n#\\02" 1795 "; Test error \"unexpected end-of-file reading expression comment\"\n\n(define oops '#; ; that's all I've got!\n" 1796 "; Test error \"unexpected end-of-file reading gensym\"\n(pretty-print '#{" 1797 "; Test error \"unexpected end-of-file reading gensym\"\n(pretty-print '#{foo" 1798 "; Test error \"unexpected end-of-file reading gensym\"\n(pretty-print '#{foo |bar|" 1799 "; Test error \"unexpected end-of-file reading graph mark\"\n(define x '#1=\n" 1800 "; Test error \"unexpected end-of-file reading hash-bang syntax\"\n\n(list #!eo" 1801 "; Test error \"unexpected end-of-file reading #v syntax\"\n\"would this be cool?\" #v" 1802 "; Test error \"unexpected end-of-file reading #~v,'0dv syntax\"\n\"would this be cool?\" #01v" 1803 "; Test error \"unexpected end-of-file reading #v syntax\"\n\"would this be cool?\" #vf" 1804 "; Test error \"unexpected end-of-file reading #~v,'0dv syntax\"\n\"would this be cool?\" #01vf" 1805 "; Test error \"unexpected end-of-file reading #v syntax\"\n\"would this be cool?\" #vfx" 1806 "; Test error \"unexpected end-of-file reading #~v,'0dv syntax\"\n\"would this be cool?\" #01vfx" 1807 "; Test error \"unexpected end-of-file reading list\" (before first element) \n\n (\n\n " 1808 "; 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" 1809 "; Test error \"unexpected end-of-file reading list\" (after dot)\n\n(car '(a b . \n\n" 1810 "; Test error \"unexpected end-of-file reading list\" (after element after dot)\n\n(car '(a b . c\n\n" 1811 "; Test error \"unexpected end-of-file reading # prefix\"\n\"would this be cool?\" #" 1812 "; Test error \"unexpected end-of-file reading # prefix\"\n\"would this be cool?\" #35" 1813 "; Test error \"unexpected end-of-file reading number\"\n\n(list #e3+" 1814 "; Test error \"unexpected end-of-file reading quote\"\n(define fido ' \n\n\n" 1815 "; Test error \"unexpected end-of-file reading quasiquote\"\n(define e ` \n" 1816 "; Test error \"unexpected end-of-file reading unquote\"\n(define e `(+ ,(* 2 3) , \n\n" 1817 "; Test error \"unexpected end-of-file reading unquote-splicing\"\n(define r (list 1 2 3))\n(set! r `(0 ,@ \n\n" 1818 "; Test error \"unexpected end-of-file reading quasisyntax\"\n(define e #` \n" 1819 "; Test error \"unexpected end-of-file reading unsyntax\"\n(define e #`(+ #,(* 2 3) #, \n\n" 1820 "; Test error \"unexpected end-of-file reading unsyntax-splicing\"\n(define r (list 1 2 3))\n(set! r #`(0 #,@ \n\n" 1821 "; Test error \"unexpected end-of-file reading record\"\n\n(define oops '#[ \n\n" 1822 "; Test error \"unexpected end-of-file reading record\"\n\n(define oops '#[$acyclic \n\n" 1823 "; Test error \"unexpected end-of-file reading string\"\n\n(printf \"This is \\\"not\\\" what I meant)\n\n" 1824 "; Test error \"unexpected end-of-file reading string\"\n\n(define s \"hello \\" 1825 "; Test error \"unexpected end-of-file reading string\"\n\n(define s \"hello \\0" 1826 "; Test error \"unexpected end-of-file reading string\"\n\n(define s \"hello \\03" 1827 "; Test error \"unexpected end-of-file reading string\"\n\n(define s \"hello \\x" 1828 "; Test error \"unexpected end-of-file reading string\"\n\n(define s \"hello \\x2" 1829 "; Test error \"unexpected end-of-file reading string\"\n\n(list \"abc\\x3c3" 1830 "; Test error \"invalid code point value 2097152 in string hex escape\"\n\n(list \"abc\\x200000;\")" 1831 "; Test error \"invalid character q in string hex escape\"\n\n(list \"abc\\xq;\")" 1832 "; Test error \"invalid character \" in string hex escape\"\n\n(list \"abc\\x\")" 1833 "; Test error \"unexpected end-of-file reading symbol\"\n\n(list 'abc\\" 1834 "; Test error \"unexpected end-of-file reading symbol\"\n\n(cons '|froma\\|gerie\\ %dq|jl&" 1835 "; Test error \"unexpected end-of-file reading symbol\"\n(pretty-print\n #| foo\n #| bar |#\n |#\n|# #| oops |#" 1836 "; Test error \"unexpected end-of-file reading symbol\"\n\n(list 'abc\\x" 1837 "; Test error \"unexpected end-of-file reading symbol\"\n\n(list 'abc\\x3c3" 1838 "; Test error \"invalid code point value 2097152 in symbol hex escape\"\n\n(list 'abc\\x200000;)" 1839 "; Test error \"invalid character q in symbol hex escape\"\n\n(list 'abc\\xq;)" 1840 "; Test error \"unexpected end-of-file reading vector\"\n\n (define v '#(a b \n" 1841 "; Test error \"unexpected end-of-file reading vector\"\n\n (define v '#35(a b \n" 1842 "; Test error \"unexpected end-of-file reading fxvector\"\n\n (define v '#vfx(0 1 \n" 1843 "; Test error \"unexpected end-of-file reading fxvector\"\n\n (define v '#35vfx(0 1 \n" 1844 "; Test error \"unexpected end-of-file reading bytevector\"\n\n (define v '#vu8(0 1 \n" 1845 "; Test error \"unexpected end-of-file reading bytevector\"\n\n (define v '#35vu8(0 1 \n" 1846 "; Test error \"unrecognized record name ~s\"\n#[zsunekunvliwndwalv 1 2 3 4]" 1847 "; Test error \"unresolvable cycle\"\n\n(define oops '#1=#[$acyclic #1#])\n" 1848 "; Test error \"open brace syntax not allowed in #!r6rs mode\"\n\n#!r6rs '{\n" 1849 "; Test error \"close brace syntax not allowed in #!r6rs mode\"\n\n#!r6rs '}\n" 1850 "; Test error \"#[...] record syntax not allowed in #!r6rs mode\"\n\n#!r6rs '#[abc]\n" 1851 "; Test error \"#{...} gensym syntax not allowed in #!r6rs mode\"\n\n#!r6rs '#{abc def}\n" 1852 "; Test error \"#& box syntax not allowed in #!r6rs mode\"\n\n#!r6rs '#&box\n" 1853 "; Test error \"#% primitive syntax not allowed in #!r6rs mode\"\n\n#!r6rs #%car\n" 1854 "; Test error \"#: gensym syntax not allowed in #!r6rs mode\"\n\n#!r6rs #:g0\n" 1855 "; Test error \"#<n>(...) vector syntax not allowed in #!r6rs mode\"\n\n#!r6rs '#3(a b c)\n" 1856 "; Test error \"#<n>r number syntax not allowed in #!r6rs mode\"\n\n#!r6rs '#3r1201\n" 1857 "; Test error \"#<n># insert syntax not allowed in #!r6rs mode\"\n\n#!r6rs '#3#\n" 1858 "; Test error \"#<n>= mark syntax not allowed in #!r6rs mode\"\n\n#!r6rs '#3=\n" 1859 "; Test error \"#<n>% primitive syntax not allowed in #!r6rs mode\"\n\n#!r6rs #3%car\n" 1860 "; Test error \"octal character syntax not allowed in #!r6rs mode\"\n\n#!r6rs #\\010\n" 1861 "; Test error \"invalid delimiter 1 for character\"\n\n#\\0001\n" 1862 "; Test error \"delimiter { is not allowed in #!r6rs mode\"\n\n#!r6rs #\\0{\n" 1863 "; Test error \"#!eof syntax not allowed in #!r6rs mode\"\n\n#!r6rs #!eof\n" 1864 "; Test error \"#!bwp syntax not allowed in #!r6rs mode\"\n\n#!r6rs #!bwp\n" 1865 "; Test error \"#vfx(...) fxvector syntax not allowed in #!r6rs mode\"\n\n#!r6rs '#vfx(1 2 3)\n" 1866 "; Test error \"#<n>vfx(...) fxvector syntax not allowed in #!r6rs mode\"\n\n#!r6rs '#3vfx(1 2 3)\n" 1867 "; Test error \"#<n>vu8(...) fxvector syntax not allowed in #!r6rs mode\"\n\n#!r6rs '#3vu8(1 2 3)\n" 1868 "; Test error \"octal string-character syntax not allowed in #!r6rs mode\"\n\n#!r6rs \"a\\010b\"\n" 1869 "; Test error \"back-slash symbol escape syntax not allowed in #!r6rs mode\"\n\n#!r6rs ab\\ cd\n" 1870 "; Test error \"|...| symbol escape syntax not allowed in #!r6rs mode\"\n\n#!r6rs |ab cd|\n" 1871 "; Test error \"@abc symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs @abc\n" 1872 "; Test error \"123a symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs 123a\n" 1873 "; Test error \"123# number syntax not allowed in #!r6rs mode\"\n\n#!r6rs 123#\n" 1874 "; Test error \"#x1/2e2 number syntax not allowed in #!r6rs mode\"\n\n#!r6rs 1/2e2\n" 1875 "; Test error \"#x.3 number syntax not allowed in #!r6rs mode\"\n\n#!r6rs #x.3\n" 1876 1877 ; following tests adapted from the read0 benchmark distributed by Will 1878 ; Clinger, which as of 08/08/2009 appears to be in the public domain, 1879 ; with no license, copyright notice, author name, or date. 1880 "; Test error \"\x488; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x488;\n" 1881 "; Test error \"@ symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs @\n" 1882 "; Test error \"@b symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs @b\n" 1883 "; Test error \"@ symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs @\n" 1884 "; Test error \"\x488; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x488;\n" 1885 "; Test error \"\x489; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x489;\n" 1886 "; Test error \"\x660; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x660;\n" 1887 "; Test error \"\x661; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x661;\n" 1888 "; Test error \"\x662; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x662;\n" 1889 "; Test error \"\x663; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x663;\n" 1890 "; Test error \"\x664; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x664;\n" 1891 "; Test error \"\x665; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x665;\n" 1892 "; Test error \"\x666; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x666;\n" 1893 "; Test error \"\x667; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x667;\n" 1894 "; Test error \"\x668; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x668;\n" 1895 "; Test error \"\x669; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x669;\n" 1896 #;"; Test error \"\x6DE; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x6DE;\n" ; switched from Me to So in Unicode 7.0 1897 "; Test error \"\x6F0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x6F0;\n" 1898 "; Test error \"\x6F1; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x6F1;\n" 1899 "; Test error \"\x6F2; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x6F2;\n" 1900 "; Test error \"\x6F3; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x6F3;\n" 1901 "; Test error \"\x6F4; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x6F4;\n" 1902 "; Test error \"\x6F5; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x6F5;\n" 1903 "; Test error \"\x6F6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x6F6;\n" 1904 "; Test error \"\x6F7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x6F7;\n" 1905 "; Test error \"\x6F8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x6F8;\n" 1906 "; Test error \"\x6F9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x6F9;\n" 1907 "; Test error \"\x7C0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x7C0;\n" 1908 "; Test error \"\x7C1; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x7C1;\n" 1909 "; Test error \"\x7C2; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x7C2;\n" 1910 "; Test error \"\x7C3; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x7C3;\n" 1911 "; Test error \"\x7C4; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x7C4;\n" 1912 "; Test error \"\x7C5; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x7C5;\n" 1913 "; Test error \"\x7C6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x7C6;\n" 1914 "; Test error \"\x7C7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x7C7;\n" 1915 "; Test error \"\x7C8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x7C8;\n" 1916 "; Test error \"\x7C9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x7C9;\n" 1917 "; Test error \"\x903; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x903;\n" 1918 "; Test error \"\x93E; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x93E;\n" 1919 "; Test error \"\x93F; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x93F;\n" 1920 "; Test error \"\x940; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x940;\n" 1921 "; Test error \"\x949; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x949;\n" 1922 "; Test error \"\x94A; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x94A;\n" 1923 "; Test error \"\x94B; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x94B;\n" 1924 "; Test error \"\x94C; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x94C;\n" 1925 "; Test error \"\x966; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x966;\n" 1926 "; Test error \"\x967; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x967;\n" 1927 "; Test error \"\x968; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x968;\n" 1928 "; Test error \"\x969; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x969;\n" 1929 "; Test error \"\x96A; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x96A;\n" 1930 "; Test error \"\x96B; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x96B;\n" 1931 "; Test error \"\x96C; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x96C;\n" 1932 "; Test error \"\x96D; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x96D;\n" 1933 "; Test error \"\x96E; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x96E;\n" 1934 "; Test error \"\x96F; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x96F;\n" 1935 "; Test error \"\x982; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x982;\n" 1936 "; Test error \"\x983; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x983;\n" 1937 "; Test error \"\x9BE; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x9BE;\n" 1938 "; Test error \"\x9BF; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x9BF;\n" 1939 "; Test error \"\x9C0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x9C0;\n" 1940 "; Test error \"\x9C7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x9C7;\n" 1941 "; Test error \"\x9C8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x9C8;\n" 1942 "; Test error \"\x9CB; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x9CB;\n" 1943 "; Test error \"\x9CC; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x9CC;\n" 1944 "; Test error \"\x9D7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x9D7;\n" 1945 "; Test error \"\x9E6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x9E6;\n" 1946 "; Test error \"\x9E7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x9E7;\n" 1947 "; Test error \"\x9E8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x9E8;\n" 1948 "; Test error \"\x9E9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x9E9;\n" 1949 "; Test error \"\x9EA; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x9EA;\n" 1950 "; Test error \"\x9EB; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x9EB;\n" 1951 "; Test error \"\x9EC; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x9EC;\n" 1952 "; Test error \"\x9ED; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x9ED;\n" 1953 "; Test error \"\x9EE; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x9EE;\n" 1954 "; Test error \"\x9EF; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x9EF;\n" 1955 "; Test error \"\xA03; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA03;\n" 1956 "; Test error \"\xA3E; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA3E;\n" 1957 "; Test error \"\xA3F; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA3F;\n" 1958 "; Test error \"\xA40; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA40;\n" 1959 "; Test error \"\xA66; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA66;\n" 1960 "; Test error \"\xA67; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA67;\n" 1961 "; Test error \"\xA68; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA68;\n" 1962 "; Test error \"\xA69; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA69;\n" 1963 "; Test error \"\xA6A; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA6A;\n" 1964 "; Test error \"\xA6B; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA6B;\n" 1965 "; Test error \"\xA6C; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA6C;\n" 1966 "; Test error \"\xA6D; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA6D;\n" 1967 "; Test error \"\xA6E; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA6E;\n" 1968 "; Test error \"\xA6F; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA6F;\n" 1969 "; Test error \"\xA83; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA83;\n" 1970 "; Test error \"\xABE; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xABE;\n" 1971 "; Test error \"\xABF; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xABF;\n" 1972 "; Test error \"\xAC0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAC0;\n" 1973 "; Test error \"\xAC9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAC9;\n" 1974 "; Test error \"\xACB; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xACB;\n" 1975 "; Test error \"\xACC; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xACC;\n" 1976 "; Test error \"\xAE6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAE6;\n" 1977 "; Test error \"\xAE7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAE7;\n" 1978 "; Test error \"\xAE8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAE8;\n" 1979 "; Test error \"\xAE9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAE9;\n" 1980 "; Test error \"\xAEA; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAEA;\n" 1981 "; Test error \"\xAEB; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAEB;\n" 1982 "; Test error \"\xAEC; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAEC;\n" 1983 "; Test error \"\xAED; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAED;\n" 1984 "; Test error \"\xAEE; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAEE;\n" 1985 "; Test error \"\xAEF; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAEF;\n" 1986 "; Test error \"\xB02; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB02;\n" 1987 "; Test error \"\xB03; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB03;\n" 1988 "; Test error \"\xB3E; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB3E;\n" 1989 "; Test error \"\xB40; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB40;\n" 1990 "; Test error \"\xB47; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB47;\n" 1991 "; Test error \"\xB48; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB48;\n" 1992 "; Test error \"\xB4B; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB4B;\n" 1993 "; Test error \"\xB4C; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB4C;\n" 1994 "; Test error \"\xB57; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB57;\n" 1995 "; Test error \"\xB66; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB66;\n" 1996 "; Test error \"\xB67; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB67;\n" 1997 "; Test error \"\xB68; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB68;\n" 1998 "; Test error \"\xB69; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB69;\n" 1999 "; Test error \"\xB6A; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB6A;\n" 2000 "; Test error \"\xB6B; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB6B;\n" 2001 "; Test error \"\xB6C; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB6C;\n" 2002 "; Test error \"\xB6D; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB6D;\n" 2003 "; Test error \"\xB6E; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB6E;\n" 2004 "; Test error \"\xB6F; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xB6F;\n" 2005 "; Test error \"\xBBE; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBBE;\n" 2006 "; Test error \"\xBBF; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBBF;\n" 2007 "; Test error \"\xBC1; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBC1;\n" 2008 "; Test error \"\xBC2; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBC2;\n" 2009 "; Test error \"\xBC6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBC6;\n" 2010 "; Test error \"\xBC7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBC7;\n" 2011 "; Test error \"\xBC8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBC8;\n" 2012 "; Test error \"\xBCA; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBCA;\n" 2013 "; Test error \"\xBCB; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBCB;\n" 2014 "; Test error \"\xBCC; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBCC;\n" 2015 "; Test error \"\xBD7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBD7;\n" 2016 "; Test error \"\xBE6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBE6;\n" 2017 "; Test error \"\xBE7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBE7;\n" 2018 "; Test error \"\xBE8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBE8;\n" 2019 "; Test error \"\xBE9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBE9;\n" 2020 "; Test error \"\xBEA; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBEA;\n" 2021 "; Test error \"\xBEB; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBEB;\n" 2022 "; Test error \"\xBEC; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBEC;\n" 2023 "; Test error \"\xBED; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBED;\n" 2024 "; Test error \"\xBEE; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBEE;\n" 2025 "; Test error \"\xBEF; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xBEF;\n" 2026 "; Test error \"\xC01; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC01;\n" 2027 "; Test error \"\xC02; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC02;\n" 2028 "; Test error \"\xC03; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC03;\n" 2029 "; Test error \"\xC41; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC41;\n" 2030 "; Test error \"\xC42; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC42;\n" 2031 "; Test error \"\xC43; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC43;\n" 2032 "; Test error \"\xC44; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC44;\n" 2033 "; Test error \"\xC66; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC66;\n" 2034 "; Test error \"\xC67; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC67;\n" 2035 "; Test error \"\xC68; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC68;\n" 2036 "; Test error \"\xC69; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC69;\n" 2037 "; Test error \"\xC6A; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC6A;\n" 2038 "; Test error \"\xC6B; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC6B;\n" 2039 "; Test error \"\xC6C; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC6C;\n" 2040 "; Test error \"\xC6D; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC6D;\n" 2041 "; Test error \"\xC6E; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC6E;\n" 2042 "; Test error \"\xC6F; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC6F;\n" 2043 "; Test error \"\xC82; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC82;\n" 2044 "; Test error \"\xC83; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xC83;\n" 2045 "; Test error \"\xCBE; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCBE;\n" 2046 "; Test error \"\xCC0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCC0;\n" 2047 "; Test error \"\xCC1; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCC1;\n" 2048 "; Test error \"\xCC2; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCC2;\n" 2049 "; Test error \"\xCC3; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCC3;\n" 2050 "; Test error \"\xCC4; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCC4;\n" 2051 "; Test error \"\xCC7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCC7;\n" 2052 "; Test error \"\xCC8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCC8;\n" 2053 "; Test error \"\xCCA; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCCA;\n" 2054 "; Test error \"\xCCB; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCCB;\n" 2055 "; Test error \"\xCD5; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCD5;\n" 2056 "; Test error \"\xCD6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCD6;\n" 2057 "; Test error \"\xCE6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCE6;\n" 2058 "; Test error \"\xCE7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCE7;\n" 2059 "; Test error \"\xCE8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCE8;\n" 2060 "; Test error \"\xCE9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCE9;\n" 2061 "; Test error \"\xCEA; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCEA;\n" 2062 "; Test error \"\xCEB; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCEB;\n" 2063 "; Test error \"\xCEC; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCEC;\n" 2064 "; Test error \"\xCED; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCED;\n" 2065 "; Test error \"\xCEE; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCEE;\n" 2066 "; Test error \"\xCEF; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xCEF;\n" 2067 "; Test error \"\xD02; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD02;\n" 2068 "; Test error \"\xD03; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD03;\n" 2069 "; Test error \"\xD3E; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD3E;\n" 2070 "; Test error \"\xD3F; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD3F;\n" 2071 "; Test error \"\xD40; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD40;\n" 2072 "; Test error \"\xD46; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD46;\n" 2073 "; Test error \"\xD47; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD47;\n" 2074 "; Test error \"\xD48; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD48;\n" 2075 "; Test error \"\xD4A; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD4A;\n" 2076 "; Test error \"\xD4B; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD4B;\n" 2077 "; Test error \"\xD4C; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD4C;\n" 2078 "; Test error \"\xD57; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD57;\n" 2079 "; Test error \"\xD66; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD66;\n" 2080 "; Test error \"\xD67; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD67;\n" 2081 "; Test error \"\xD68; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD68;\n" 2082 "; Test error \"\xD69; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD69;\n" 2083 "; Test error \"\xD6A; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD6A;\n" 2084 "; Test error \"\xD6B; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD6B;\n" 2085 "; Test error \"\xD6C; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD6C;\n" 2086 "; Test error \"\xD6D; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD6D;\n" 2087 "; Test error \"\xD6E; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD6E;\n" 2088 "; Test error \"\xD6F; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD6F;\n" 2089 "; Test error \"\xD82; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD82;\n" 2090 "; Test error \"\xD83; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xD83;\n" 2091 "; Test error \"\xDCF; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xDCF;\n" 2092 "; Test error \"\xDD0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xDD0;\n" 2093 "; Test error \"\xDD1; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xDD1;\n" 2094 "; Test error \"\xDD8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xDD8;\n" 2095 "; Test error \"\xDD9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xDD9;\n" 2096 "; Test error \"\xDDA; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xDDA;\n" 2097 "; Test error \"\xDDB; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xDDB;\n" 2098 "; Test error \"\xDDC; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xDDC;\n" 2099 "; Test error \"\xDDD; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xDDD;\n" 2100 "; Test error \"\xDDE; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xDDE;\n" 2101 "; Test error \"\xDDF; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xDDF;\n" 2102 "; Test error \"\xDF2; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xDF2;\n" 2103 "; Test error \"\xDF3; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xDF3;\n" 2104 "; Test error \"\xE50; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xE50;\n" 2105 "; Test error \"\xE51; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xE51;\n" 2106 "; Test error \"\xE52; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xE52;\n" 2107 "; Test error \"\xE53; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xE53;\n" 2108 "; Test error \"\xE54; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xE54;\n" 2109 "; Test error \"\xE55; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xE55;\n" 2110 "; Test error \"\xE56; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xE56;\n" 2111 "; Test error \"\xE57; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xE57;\n" 2112 "; Test error \"\xE58; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xE58;\n" 2113 "; Test error \"\xE59; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xE59;\n" 2114 "; Test error \"\xED0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xED0;\n" 2115 "; Test error \"\xED1; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xED1;\n" 2116 "; Test error \"\xED2; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xED2;\n" 2117 "; Test error \"\xED3; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xED3;\n" 2118 "; Test error \"\xED4; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xED4;\n" 2119 "; Test error \"\xED5; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xED5;\n" 2120 "; Test error \"\xED6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xED6;\n" 2121 "; Test error \"\xED7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xED7;\n" 2122 "; Test error \"\xED8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xED8;\n" 2123 "; Test error \"\xED9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xED9;\n" 2124 "; Test error \"\xF20; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xF20;\n" 2125 "; Test error \"\xF21; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xF21;\n" 2126 "; Test error \"\xF22; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xF22;\n" 2127 "; Test error \"\xF23; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xF23;\n" 2128 "; Test error \"\xF24; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xF24;\n" 2129 "; Test error \"\xF25; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xF25;\n" 2130 "; Test error \"\xF26; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xF26;\n" 2131 "; Test error \"\xF27; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xF27;\n" 2132 "; Test error \"\xF28; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xF28;\n" 2133 "; Test error \"\xF29; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xF29;\n" 2134 "; Test error \"\xF3E; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xF3E;\n" 2135 "; Test error \"\xF3F; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xF3F;\n" 2136 "; Test error \"\xF7F; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xF7F;\n" 2137 "; Test error \"\x102B; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x102B;\n" 2138 "; Test error \"\x102C; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x102C;\n" 2139 "; Test error \"\x1031; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1031;\n" 2140 "; Test error \"\x1038; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1038;\n" 2141 "; Test error \"\x103B; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x103B;\n" 2142 "; Test error \"\x103C; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x103C;\n" 2143 "; Test error \"\x1040; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1040;\n" 2144 "; Test error \"\x1041; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1041;\n" 2145 "; Test error \"\x1042; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1042;\n" 2146 "; Test error \"\x1043; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1043;\n" 2147 "; Test error \"\x1044; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1044;\n" 2148 "; Test error \"\x1045; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1045;\n" 2149 "; Test error \"\x1046; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1046;\n" 2150 "; Test error \"\x1047; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1047;\n" 2151 "; Test error \"\x1048; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1048;\n" 2152 "; Test error \"\x1049; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1049;\n" 2153 "; Test error \"\x1056; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1056;\n" 2154 "; Test error \"\x1057; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1057;\n" 2155 "; Test error \"\x1062; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1062;\n" 2156 "; Test error \"\x1063; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1063;\n" 2157 "; Test error \"\x1064; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1064;\n" 2158 "; Test error \"\x1067; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1067;\n" 2159 "; Test error \"\x1068; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1068;\n" 2160 "; Test error \"\x1069; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1069;\n" 2161 "; Test error \"\x106A; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x106A;\n" 2162 "; Test error \"\x106B; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x106B;\n" 2163 "; Test error \"\x106C; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x106C;\n" 2164 "; Test error \"\x106D; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x106D;\n" 2165 "; Test error \"\x1083; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1083;\n" 2166 "; Test error \"\x1084; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1084;\n" 2167 "; Test error \"\x1087; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1087;\n" 2168 "; Test error \"\x1088; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1088;\n" 2169 "; Test error \"\x1089; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1089;\n" 2170 "; Test error \"\x108A; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x108A;\n" 2171 "; Test error \"\x108B; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x108B;\n" 2172 "; Test error \"\x108C; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x108C;\n" 2173 "; Test error \"\x108F; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x108F;\n" 2174 "; Test error \"\x1090; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1090;\n" 2175 "; Test error \"\x1091; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1091;\n" 2176 "; Test error \"\x1092; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1092;\n" 2177 "; Test error \"\x1093; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1093;\n" 2178 "; Test error \"\x1094; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1094;\n" 2179 "; Test error \"\x1095; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1095;\n" 2180 "; Test error \"\x1096; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1096;\n" 2181 "; Test error \"\x1097; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1097;\n" 2182 "; Test error \"\x1098; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1098;\n" 2183 "; Test error \"\x1099; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1099;\n" 2184 "; Test error \"\x17B6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17B6;\n" 2185 "; Test error \"\x17BE; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17BE;\n" 2186 "; Test error \"\x17BF; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17BF;\n" 2187 "; Test error \"\x17C0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17C0;\n" 2188 "; Test error \"\x17C1; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17C1;\n" 2189 "; Test error \"\x17C2; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17C2;\n" 2190 "; Test error \"\x17C3; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17C3;\n" 2191 "; Test error \"\x17C4; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17C4;\n" 2192 "; Test error \"\x17C5; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17C5;\n" 2193 "; Test error \"\x17C7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17C7;\n" 2194 "; Test error \"\x17C8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17C8;\n" 2195 "; Test error \"\x17E0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17E0;\n" 2196 "; Test error \"\x17E1; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17E1;\n" 2197 "; Test error \"\x17E2; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17E2;\n" 2198 "; Test error \"\x17E3; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17E3;\n" 2199 "; Test error \"\x17E4; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17E4;\n" 2200 "; Test error \"\x17E5; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17E5;\n" 2201 "; Test error \"\x17E6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17E6;\n" 2202 "; Test error \"\x17E7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17E7;\n" 2203 "; Test error \"\x17E8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17E8;\n" 2204 "; Test error \"\x17E9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x17E9;\n" 2205 "; Test error \"\x1810; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1810;\n" 2206 "; Test error \"\x1811; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1811;\n" 2207 "; Test error \"\x1812; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1812;\n" 2208 "; Test error \"\x1813; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1813;\n" 2209 "; Test error \"\x1814; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1814;\n" 2210 "; Test error \"\x1815; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1815;\n" 2211 "; Test error \"\x1816; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1816;\n" 2212 "; Test error \"\x1817; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1817;\n" 2213 "; Test error \"\x1818; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1818;\n" 2214 "; Test error \"\x1819; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1819;\n" 2215 "; Test error \"\x1923; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1923;\n" 2216 "; Test error \"\x1924; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1924;\n" 2217 "; Test error \"\x1925; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1925;\n" 2218 "; Test error \"\x1926; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1926;\n" 2219 "; Test error \"\x1929; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1929;\n" 2220 "; Test error \"\x192A; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x192A;\n" 2221 "; Test error \"\x192B; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x192B;\n" 2222 "; Test error \"\x1930; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1930;\n" 2223 "; Test error \"\x1931; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1931;\n" 2224 "; Test error \"\x1933; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1933;\n" 2225 "; Test error \"\x1934; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1934;\n" 2226 "; Test error \"\x1935; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1935;\n" 2227 "; Test error \"\x1936; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1936;\n" 2228 "; Test error \"\x1937; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1937;\n" 2229 "; Test error \"\x1938; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1938;\n" 2230 "; Test error \"\x1946; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1946;\n" 2231 "; Test error \"\x1947; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1947;\n" 2232 "; Test error \"\x1948; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1948;\n" 2233 "; Test error \"\x1949; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1949;\n" 2234 "; Test error \"\x194A; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x194A;\n" 2235 "; Test error \"\x194B; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x194B;\n" 2236 "; Test error \"\x194C; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x194C;\n" 2237 "; Test error \"\x194D; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x194D;\n" 2238 "; Test error \"\x194E; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x194E;\n" 2239 "; Test error \"\x194F; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x194F;\n" 2240 "; Test error \"\x19B0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19B0;\n" 2241 "; Test error \"\x19B1; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19B1;\n" 2242 "; Test error \"\x19B2; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19B2;\n" 2243 "; Test error \"\x19B3; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19B3;\n" 2244 "; Test error \"\x19B4; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19B4;\n" 2245 "; Test error \"\x19B5; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19B5;\n" 2246 "; Test error \"\x19B6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19B6;\n" 2247 "; Test error \"\x19B7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19B7;\n" 2248 "; Test error \"\x19B8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19B8;\n" 2249 "; Test error \"\x19B9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19B9;\n" 2250 "; Test error \"\x19BA; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19BA;\n" 2251 "; Test error \"\x19BB; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19BB;\n" 2252 "; Test error \"\x19BC; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19BC;\n" 2253 "; Test error \"\x19BD; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19BD;\n" 2254 "; Test error \"\x19BE; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19BE;\n" 2255 "; Test error \"\x19BF; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19BF;\n" 2256 "; Test error \"\x19C0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19C0;\n" 2257 "; Test error \"\x19C8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19C8;\n" 2258 "; Test error \"\x19C9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19C9;\n" 2259 "; Test error \"\x19D0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19D0;\n" 2260 "; Test error \"\x19D1; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19D1;\n" 2261 "; Test error \"\x19D2; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19D2;\n" 2262 "; Test error \"\x19D3; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19D3;\n" 2263 "; Test error \"\x19D4; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19D4;\n" 2264 "; Test error \"\x19D5; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19D5;\n" 2265 "; Test error \"\x19D6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19D6;\n" 2266 "; Test error \"\x19D7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19D7;\n" 2267 "; Test error \"\x19D8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19D8;\n" 2268 "; Test error \"\x19D9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x19D9;\n" 2269 "; Test error \"\x1A19; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1A19;\n" 2270 "; Test error \"\x1A1A; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1A1A;\n" 2271 #;"; Test error \"\x1A1B; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1A1B;\n" ; switched from Mc to Mn in Unicode 7.0 2272 "; Test error \"\x1B04; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B04;\n" 2273 "; Test error \"\x1B35; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B35;\n" 2274 "; Test error \"\x1B3B; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B3B;\n" 2275 "; Test error \"\x1B3D; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B3D;\n" 2276 "; Test error \"\x1B3E; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B3E;\n" 2277 "; Test error \"\x1B3F; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B3F;\n" 2278 "; Test error \"\x1B40; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B40;\n" 2279 "; Test error \"\x1B41; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B41;\n" 2280 "; Test error \"\x1B43; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B43;\n" 2281 "; Test error \"\x1B44; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B44;\n" 2282 "; Test error \"\x1B50; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B50;\n" 2283 "; Test error \"\x1B51; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B51;\n" 2284 "; Test error \"\x1B52; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B52;\n" 2285 "; Test error \"\x1B53; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B53;\n" 2286 "; Test error \"\x1B54; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B54;\n" 2287 "; Test error \"\x1B55; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B55;\n" 2288 "; Test error \"\x1B56; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B56;\n" 2289 "; Test error \"\x1B57; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B57;\n" 2290 "; Test error \"\x1B58; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B58;\n" 2291 "; Test error \"\x1B59; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B59;\n" 2292 "; Test error \"\x1B82; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1B82;\n" 2293 "; Test error \"\x1BA1; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1BA1;\n" 2294 "; Test error \"\x1BA6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1BA6;\n" 2295 "; Test error \"\x1BA7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1BA7;\n" 2296 "; Test error \"\x1BAA; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1BAA;\n" 2297 "; Test error \"\x1BB0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1BB0;\n" 2298 "; Test error \"\x1BB1; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1BB1;\n" 2299 "; Test error \"\x1BB2; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1BB2;\n" 2300 "; Test error \"\x1BB3; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1BB3;\n" 2301 "; Test error \"\x1BB4; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1BB4;\n" 2302 "; Test error \"\x1BB5; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1BB5;\n" 2303 "; Test error \"\x1BB6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1BB6;\n" 2304 "; Test error \"\x1BB7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1BB7;\n" 2305 "; Test error \"\x1BB8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1BB8;\n" 2306 "; Test error \"\x1BB9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1BB9;\n" 2307 "; Test error \"\x1C24; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C24;\n" 2308 "; Test error \"\x1C25; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C25;\n" 2309 "; Test error \"\x1C26; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C26;\n" 2310 "; Test error \"\x1C27; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C27;\n" 2311 "; Test error \"\x1C28; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C28;\n" 2312 "; Test error \"\x1C29; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C29;\n" 2313 "; Test error \"\x1C2A; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C2A;\n" 2314 "; Test error \"\x1C2B; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C2B;\n" 2315 "; Test error \"\x1C34; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C34;\n" 2316 "; Test error \"\x1C35; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C35;\n" 2317 "; Test error \"\x1C40; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C40;\n" 2318 "; Test error \"\x1C41; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C41;\n" 2319 "; Test error \"\x1C42; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C42;\n" 2320 "; Test error \"\x1C43; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C43;\n" 2321 "; Test error \"\x1C44; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C44;\n" 2322 "; Test error \"\x1C45; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C45;\n" 2323 "; Test error \"\x1C46; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C46;\n" 2324 "; Test error \"\x1C47; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C47;\n" 2325 "; Test error \"\x1C48; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C48;\n" 2326 "; Test error \"\x1C49; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C49;\n" 2327 "; Test error \"\x1C50; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C50;\n" 2328 "; Test error \"\x1C51; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C51;\n" 2329 "; Test error \"\x1C52; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C52;\n" 2330 "; Test error \"\x1C53; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C53;\n" 2331 "; Test error \"\x1C54; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C54;\n" 2332 "; Test error \"\x1C55; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C55;\n" 2333 "; Test error \"\x1C56; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C56;\n" 2334 "; Test error \"\x1C57; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C57;\n" 2335 "; Test error \"\x1C58; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C58;\n" 2336 "; Test error \"\x1C59; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1C59;\n" 2337 "; Test error \"\x20DD; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x20DD;\n" 2338 "; Test error \"\x20DE; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x20DE;\n" 2339 "; Test error \"\x20DF; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x20DF;\n" 2340 "; Test error \"\x20E0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x20E0;\n" 2341 "; Test error \"\x20E2; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x20E2;\n" 2342 "; Test error \"\x20E3; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x20E3;\n" 2343 "; Test error \"\x20E4; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x20E4;\n" 2344 "; Test error \"\xA620; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA620;\n" 2345 "; Test error \"\xA621; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA621;\n" 2346 "; Test error \"\xA622; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA622;\n" 2347 "; Test error \"\xA623; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA623;\n" 2348 "; Test error \"\xA624; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA624;\n" 2349 "; Test error \"\xA625; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA625;\n" 2350 "; Test error \"\xA626; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA626;\n" 2351 "; Test error \"\xA627; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA627;\n" 2352 "; Test error \"\xA628; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA628;\n" 2353 "; Test error \"\xA629; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA629;\n" 2354 "; Test error \"\xA670; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA670;\n" 2355 "; Test error \"\xA671; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA671;\n" 2356 "; Test error \"\xA672; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA672;\n" 2357 "; Test error \"\xA823; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA823;\n" 2358 "; Test error \"\xA824; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA824;\n" 2359 "; Test error \"\xA827; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA827;\n" 2360 "; Test error \"\xA880; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA880;\n" 2361 "; Test error \"\xA881; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA881;\n" 2362 "; Test error \"\xA8B4; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8B4;\n" 2363 "; Test error \"\xA8B5; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8B5;\n" 2364 "; Test error \"\xA8B6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8B6;\n" 2365 "; Test error \"\xA8B7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8B7;\n" 2366 "; Test error \"\xA8B8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8B8;\n" 2367 "; Test error \"\xA8B9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8B9;\n" 2368 "; Test error \"\xA8BA; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8BA;\n" 2369 "; Test error \"\xA8BB; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8BB;\n" 2370 "; Test error \"\xA8BC; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8BC;\n" 2371 "; Test error \"\xA8BD; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8BD;\n" 2372 "; Test error \"\xA8BE; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8BE;\n" 2373 "; Test error \"\xA8BF; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8BF;\n" 2374 "; Test error \"\xA8C0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8C0;\n" 2375 "; Test error \"\xA8C1; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8C1;\n" 2376 "; Test error \"\xA8C2; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8C2;\n" 2377 "; Test error \"\xA8C3; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8C3;\n" 2378 "; Test error \"\xA8D0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8D0;\n" 2379 "; Test error \"\xA8D1; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8D1;\n" 2380 "; Test error \"\xA8D2; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8D2;\n" 2381 "; Test error \"\xA8D3; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8D3;\n" 2382 "; Test error \"\xA8D4; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8D4;\n" 2383 "; Test error \"\xA8D5; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8D5;\n" 2384 "; Test error \"\xA8D6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8D6;\n" 2385 "; Test error \"\xA8D7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8D7;\n" 2386 "; Test error \"\xA8D8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8D8;\n" 2387 "; Test error \"\xA8D9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA8D9;\n" 2388 "; Test error \"\xA900; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA900;\n" 2389 "; Test error \"\xA901; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA901;\n" 2390 "; Test error \"\xA902; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA902;\n" 2391 "; Test error \"\xA903; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA903;\n" 2392 "; Test error \"\xA904; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA904;\n" 2393 "; Test error \"\xA905; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA905;\n" 2394 "; Test error \"\xA906; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA906;\n" 2395 "; Test error \"\xA907; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA907;\n" 2396 "; Test error \"\xA908; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA908;\n" 2397 "; Test error \"\xA909; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA909;\n" 2398 "; Test error \"\xA952; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA952;\n" 2399 "; Test error \"\xA953; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xA953;\n" 2400 "; Test error \"\xAA2F; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAA2F;\n" 2401 "; Test error \"\xAA30; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAA30;\n" 2402 "; Test error \"\xAA33; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAA33;\n" 2403 "; Test error \"\xAA34; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAA34;\n" 2404 "; Test error \"\xAA4D; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAA4D;\n" 2405 "; Test error \"\xAA50; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAA50;\n" 2406 "; Test error \"\xAA51; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAA51;\n" 2407 "; Test error \"\xAA52; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAA52;\n" 2408 "; Test error \"\xAA53; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAA53;\n" 2409 "; Test error \"\xAA54; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAA54;\n" 2410 "; Test error \"\xAA55; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAA55;\n" 2411 "; Test error \"\xAA56; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAA56;\n" 2412 "; Test error \"\xAA57; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAA57;\n" 2413 "; Test error \"\xAA58; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAA58;\n" 2414 "; Test error \"\xAA59; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xAA59;\n" 2415 "; Test error \"\xFF10; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xFF10;\n" 2416 "; Test error \"\xFF11; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xFF11;\n" 2417 "; Test error \"\xFF12; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xFF12;\n" 2418 "; Test error \"\xFF13; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xFF13;\n" 2419 "; Test error \"\xFF14; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xFF14;\n" 2420 "; Test error \"\xFF15; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xFF15;\n" 2421 "; Test error \"\xFF16; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xFF16;\n" 2422 "; Test error \"\xFF17; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xFF17;\n" 2423 "; Test error \"\xFF18; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xFF18;\n" 2424 "; Test error \"\xFF19; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \xFF19;\n" 2425 "; Test error \"\x104A0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x104A0;\n" 2426 "; Test error \"\x104A1; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x104A1;\n" 2427 "; Test error \"\x104A2; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x104A2;\n" 2428 "; Test error \"\x104A3; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x104A3;\n" 2429 "; Test error \"\x104A4; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x104A4;\n" 2430 "; Test error \"\x104A5; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x104A5;\n" 2431 "; Test error \"\x104A6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x104A6;\n" 2432 "; Test error \"\x104A7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x104A7;\n" 2433 "; Test error \"\x104A8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x104A8;\n" 2434 "; Test error \"\x104A9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x104A9;\n" 2435 "; Test error \"\x1D165; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D165;\n" 2436 "; Test error \"\x1D166; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D166;\n" 2437 "; Test error \"\x1D16D; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D16D;\n" 2438 "; Test error \"\x1D16E; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D16E;\n" 2439 "; Test error \"\x1D16F; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D16F;\n" 2440 "; Test error \"\x1D170; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D170;\n" 2441 "; Test error \"\x1D171; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D171;\n" 2442 "; Test error \"\x1D172; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D172;\n" 2443 "; Test error \"\x1D7CE; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7CE;\n" 2444 "; Test error \"\x1D7CF; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7CF;\n" 2445 "; Test error \"\x1D7D0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7D0;\n" 2446 "; Test error \"\x1D7D1; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7D1;\n" 2447 "; Test error \"\x1D7D2; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7D2;\n" 2448 "; Test error \"\x1D7D3; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7D3;\n" 2449 "; Test error \"\x1D7D4; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7D4;\n" 2450 "; Test error \"\x1D7D5; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7D5;\n" 2451 "; Test error \"\x1D7D6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7D6;\n" 2452 "; Test error \"\x1D7D7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7D7;\n" 2453 "; Test error \"\x1D7D8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7D8;\n" 2454 "; Test error \"\x1D7D9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7D9;\n" 2455 "; Test error \"\x1D7DA; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7DA;\n" 2456 "; Test error \"\x1D7DB; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7DB;\n" 2457 "; Test error \"\x1D7DC; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7DC;\n" 2458 "; Test error \"\x1D7DD; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7DD;\n" 2459 "; Test error \"\x1D7DE; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7DE;\n" 2460 "; Test error \"\x1D7DF; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7DF;\n" 2461 "; Test error \"\x1D7E0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7E0;\n" 2462 "; Test error \"\x1D7E1; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7E1;\n" 2463 "; Test error \"\x1D7E2; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7E2;\n" 2464 "; Test error \"\x1D7E3; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7E3;\n" 2465 "; Test error \"\x1D7E4; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7E4;\n" 2466 "; Test error \"\x1D7E5; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7E5;\n" 2467 "; Test error \"\x1D7E6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7E6;\n" 2468 "; Test error \"\x1D7E7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7E7;\n" 2469 "; Test error \"\x1D7E8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7E8;\n" 2470 "; Test error \"\x1D7E9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7E9;\n" 2471 "; Test error \"\x1D7EA; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7EA;\n" 2472 "; Test error \"\x1D7EB; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7EB;\n" 2473 "; Test error \"\x1D7EC; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7EC;\n" 2474 "; Test error \"\x1D7ED; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7ED;\n" 2475 "; Test error \"\x1D7EE; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7EE;\n" 2476 "; Test error \"\x1D7EF; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7EF;\n" 2477 "; Test error \"\x1D7F0; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7F0;\n" 2478 "; Test error \"\x1D7F1; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7F1;\n" 2479 "; Test error \"\x1D7F2; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7F2;\n" 2480 "; Test error \"\x1D7F3; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7F3;\n" 2481 "; Test error \"\x1D7F4; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7F4;\n" 2482 "; Test error \"\x1D7F5; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7F5;\n" 2483 "; Test error \"\x1D7F6; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7F6;\n" 2484 "; Test error \"\x1D7F7; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7F7;\n" 2485 "; Test error \"\x1D7F8; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7F8;\n" 2486 "; Test error \"\x1D7F9; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7F9;\n" 2487 "; Test error \"\x1D7FA; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7FA;\n" 2488 "; Test error \"\x1D7FB; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7FB;\n" 2489 "; Test error \"\x1D7FC; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7FC;\n" 2490 "; Test error \"\x1D7FD; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7FD;\n" 2491 "; Test error \"\x1D7FE; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7FE;\n" 2492 "; Test error \"\x1D7FF; symbol syntax not allowed in #!r6rs mode\"\n\n#!r6rs \x1D7FF;\n" 2493 ) 2494 2495(mat record-annotation 2496 ; regression check: make sure annotations do not slip into records 2497 ; by way of graph references 2498 (let ([p (open-output-file "testfile.ss" 'truncate)]) 2499 (display "(define-record #{%foo %bar} (x y)) 2500(define $$rats (list '#0=(a b) #;'#1=(d e) '#[#{%foo %bar} #0# #1#])) 2501" p) 2502 (close-output-port p) 2503 #t) 2504 (begin 2505 (load "testfile.ss") 2506 #t) 2507 (record? (cadr $$rats) (type-descriptor #{%foo %bar})) 2508 (let ([r (cadr $$rats)]) 2509 (eq? (%foo-x r) (car $$rats)) 2510 (equal? (%foo-y r) '(d e))) 2511 ) 2512 2513(mat annotation-tests 2514 (let ([x (read (open-input-string "#1=#2=(#1# . #2#)"))]) 2515 (and (eq? (car x) x) (eq? (cdr x) x))) 2516 (let ([x (read (open-input-string "(#1=#1# . #1#)"))] 2517 [y (read (open-input-string "#2=#2#"))]) 2518 (and (eq? (car x) (cdr x)) (eq? (car x) y))) 2519 (vector? '#(annotation 3 #f 3)) 2520 (vector? (eval (read (open-input-string "'#(annotation #1=(a . #1#) #f #f)")))) 2521 (load-test "(define-record #{$elmer fudd} (c))\n(define x '#[#{$elmer fudd} 3])\n") 2522 (and ($elmer? x) (eq? ($elmer-c x) 3)) 2523 (compile-test "(define-record #{$bugs bunny} (c))\n(define x '#[#{$bugs bunny} 3])\n") 2524 (and ($bugs? x) (eq? ($bugs-c x) 3)) 2525 (load-test "(define-syntax $kwote (lambda (x) `(,#'quote ,x)))\n(define $argh #1=($kwote . #1#))\n") 2526 (eq? $argh (cdr $argh)) 2527 (compile-test "(define-syntax $kwoat (lambda (x) `(,#'quote ,x)))\n(define $argh #1=($kwoat #1#))\n") 2528 (eq? $argh (cadr $argh)) 2529 (load-test "(define-syntax $quoat (lambda (x) `(,#'quote ,x)))\n(begin (define x #1=($quoat a)) (define y #1#))\n") 2530 (eq? x y) 2531 (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") 2532 (and (eq? (car x) 17) (eq? (cdr x) x)) 2533 (and (eq? (car y) y) (eq? (cdr y) y)) 2534 (and (eq? (car z) (cdr z)) (eq? (car z) (read (open-input-string "#1=#1#")))) 2535 (and (eq? (car w) w) (eq? (cdr w) w)) 2536 (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") 2537 (and (eq? (car x1) 17) (eq? (cdr x1) x1)) 2538 (and (eq? (car y1) y1) (eq? (cdr y1) y1)) 2539 (and (eq? (car z1) (cdr z1)) (eq? (car z1) (read (open-input-string "#1=#1#")))) 2540 (and (eq? (car w1) w1) (eq? (cdr w1) w1)) 2541 (load-test "(define-record #{$eager beaver} ((immutable busy)))\n(define x '(#[#{$eager beaver} #1=(a b)] #1#))\n") 2542 (and ($eager? (car x)) 2543 (equal? ($eager-busy (car x)) '(a b)) 2544 (eq? ($eager-busy (car x)) (cadr x))) 2545 (compile-test "(define-record #{$beaver eager} ((immutable busy)))\n(define x '(#[#{$beaver eager} #1=(a b)] #1#))\n") 2546 (and ($beaver? (car x)) 2547 (equal? ($beaver-busy (car x)) '(a b)) 2548 (eq? ($beaver-busy (car x)) (cadr x))) 2549 ; w/quote on record 2550 (load-test "(define-record #{$tony tiger} ((immutable great!)))\n(define x (list '#[#{$tony tiger} #1=(a b)] '#1#))\n") 2551 (and ($tony? (car x)) 2552 (equal? ($tony-great! (car x)) '(a b)) 2553 (eq? ($tony-great! (car x)) (cadr x))) 2554 ; missing quote on record; see if annotation still comes back 2555 (load-test "(define-record #{$tiger tony} ((immutable great!)))\n(define x (list '#[#{$tiger tony} #1=(a b)] '#1#))\n") 2556 (and ($tiger? (car x)) 2557 (equal? ($tiger-great! (car x)) '(a b)) 2558 (eq? ($tiger-great! (car x)) (cadr x))) 2559 (load-test "(define-record #{$slow joe} ((double-float pokey)))\n(define x '#[#{$slow joe} 3.4])\n") 2560 (and ($slow? x) (eqv? ($slow-pokey x) 3.4)) 2561 (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") 2562 (equal? 2563 x 2564 '(#2(1 2) 2565 #3(3 4 5) 2566 #0() 2567 #0() 2568 #3(#&8) 2569 #3(#2(1 2) #3(3 4 5) #0()) 2570 #2(#0() #3(#&8)) 2571 #3(#2(1 2) #3(3 4 5) #0()) 2572 #2(#0() #3(#&8)))) 2573 (load-test "(define-record #{james kirk} ((double-float girls)))\n(define x '(#2=253.5 . #[#{james kirk} #2#]))\n") 2574 (and (= (car x) 253.5) (= (james-girls (cdr x)) 253.5)) 2575 (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") 2576 (and (equal? x 5) (equal? y '(4 20))) 2577 ) 2578 2579(mat symbol-printing 2580 (equal? (format "~s" '\#foo\|bar) "\\x23;foo\\x7C;bar") 2581 (eq? '\x23;foo\x7C;bar '\#foo\|bar) 2582 ) 2583 2584(mat with-source-path 2585 (equal? (source-directories) '(".")) 2586 (equal? 2587 (with-source-path 'test "I should not be here" list) 2588 '("I should not be here")) 2589 (equal? 2590 (with-source-path 'test "/I/should/not/be/here" list) 2591 '("/I/should/not/be/here")) 2592 (equal? 2593 (with-source-path 'test "fatfib.ss" list) 2594 '("fatfib.ss")) 2595 (equal? 2596 (parameterize ([source-directories '("")]) 2597 (with-source-path 'test "fatfib.ss" list)) 2598 '("fatfib.ss")) 2599 (error? ; Error in test: file "fatfib.ss" not found in source directories 2600 (parameterize ([source-directories '("." ".")]) 2601 (with-source-path 'test "fatfib.ss" list))) 2602 (error? ; Error in test: file "I should not be here" not found in source directories 2603 (parameterize ([source-directories '("." "../examples")]) 2604 (with-source-path 'test "I should not be here" list))) 2605 (equal? 2606 (parameterize ([source-directories '("." "../examples")]) 2607 (with-source-path 'test "mat.ss" list)) 2608 '("mat.ss")) 2609 (equal? 2610 (with-source-path 'test "mat.ss" list) 2611 '("mat.ss")) 2612 (equal? 2613 (parameterize ([source-directories '("" "../examples")]) 2614 (with-source-path 'test "mat.ss" list)) 2615 '("mat.ss")) 2616 (error? ; Error in test: file "mat.ss" not found in source directories 2617 (parameterize ([source-directories '()]) 2618 (with-source-path 'test "mat.ss" list))) 2619 (error? ; Error in test: file "mat.ss" not found in source directories 2620 (parameterize ([source-directories '("../examples")]) 2621 (with-source-path 'test "mat.ss" list))) 2622 (equal? 2623 (parameterize ([source-directories '("." "../examples")]) 2624 (with-source-path 'test "fatfib.ss" list)) 2625 '("../examples/fatfib.ss")) 2626 (equal? 2627 (parameterize ([source-directories '("." "../examples")]) 2628 (with-source-path 'test "./fatfib.ss" list)) 2629 '("./fatfib.ss")) 2630 (begin 2631 (parameterize ([source-directories '("." "../examples")]) 2632 (load "fatfib.ss" compile)) 2633 (procedure? fatfib)) 2634 (equal? ((inspect/object fatfib) 'type) 'procedure) 2635 (equal? 2636 (call-with-values 2637 (lambda () (((inspect/object fatfib) 'code) 'source-path)) 2638 list) 2639 '("../examples/fatfib.ss" 16 4)) 2640 (equal? 2641 (parameterize ([source-directories '("." "../examples")]) 2642 (call-with-values 2643 (lambda () (((inspect/object fatfib) 'code) 'source-path)) 2644 list)) 2645 '("../examples/fatfib.ss" 16 4)) 2646 (begin 2647 (load "../examples/fatfib.ss" compile) 2648 (procedure? fatfib)) 2649 (equal? ((inspect/object fatfib) 'type) 'procedure) 2650 (equal? 2651 (call-with-values 2652 (lambda () (((inspect/object fatfib) 'code) 'source-path)) 2653 list) 2654 '("../examples/fatfib.ss" 16 4)) 2655 (or (windows?) 2656 (equal? 2657 (parameterize ([cd "/"] [source-directories (list (cd))]) 2658 (call-with-values 2659 (lambda () (((inspect/object fatfib) 'code) 'source-path)) 2660 list)) 2661 (list (format "~a/../examples/fatfib.ss" (cd)) 16 4))) 2662 (begin 2663 (parameterize ([source-directories (list (parameterize ([cd ".."]) (cd)))]) 2664 (load "examples/fatfib.ss" compile)) 2665 (procedure? fatfib)) 2666 (equal? ((inspect/object fatfib) 'type) 'procedure) 2667 (equal? 2668 (call-with-values 2669 (lambda () (((inspect/object fatfib) 'code) 'source-path)) 2670 (lambda (x y z) (list (path-last x) y z))) 2671 '("fatfib.ss" 16 4)) 2672 (equal? 2673 (parameterize ([source-directories (list (parameterize ([cd ".."]) (cd)))]) 2674 (call-with-values 2675 (lambda () (((inspect/object fatfib) 'code) 'source-path)) 2676 list)) 2677 (list (format "~a/examples/fatfib.ss" (parameterize ([cd ".."]) (cd))) 16 4)) 2678 (equal? 2679 (parameterize ([cd ".."] [source-directories '("examples")]) 2680 (call-with-values 2681 (lambda () (((inspect/object fatfib) 'code) 'source-path)) 2682 (lambda (x y z) (list (path-last x) y z)))) 2683 '("fatfib.ss" 16 4)) 2684 (or (windows?) (embedded?) 2685 (begin 2686 (system "ln -s ../examples .") 2687 (load "examples/fatfib.ss" compile) 2688 (system "/bin/rm examples") 2689 #t)) 2690 (or (windows?) (embedded?) 2691 (equal? 2692 (call-with-values 2693 (lambda () (((inspect/object fatfib) 'code) 'source-path)) 2694 list) 2695 '("examples/fatfib.ss" 359))) 2696 (or (windows?) (embedded?) 2697 (equal? 2698 (parameterize ([source-directories '("..")]) 2699 (call-with-values 2700 (lambda () (((inspect/object fatfib) 'code) 'source-path)) 2701 list)) 2702 '("../examples/fatfib.ss" 16 4))) 2703 (or (windows?) (embedded?) 2704 (equal? 2705 (parameterize ([source-directories '("../examples")]) 2706 (call-with-values 2707 (lambda () (((inspect/object fatfib) 'code) 'source-path)) 2708 list)) 2709 '("../examples/fatfib.ss" 16 4))) 2710 (or (windows?) (embedded?) 2711 (equal? 2712 (parameterize ([source-directories (list (format "~a/examples" (parameterize ([cd ".."]) (cd))))]) 2713 (call-with-values 2714 (lambda () (((inspect/object fatfib) 'code) 'source-path)) 2715 list)) 2716 (list (format "~a/examples/fatfib.ss" (parameterize ([cd ".."]) (cd))) 16 4))) 2717) 2718 2719(mat filesystem-operations 2720 (eqv? 2721 (directory-separator) 2722 (if (windows?) #\\ #\/)) 2723 (directory-separator? #\/) 2724 (or (not (windows?)) (directory-separator? #\\)) 2725 (error? (directory-separator? '/)) 2726 (error? (directory-separator? '"/")) 2727 (begin 2728 (delete-file "testfile.ss" #f) 2729 (delete-file "testfile.ss" #f) 2730 (delete-file "testfile.ss") 2731 #t) 2732 (begin 2733 (with-output-to-file "testfile.ss" values) 2734 (r6rs:delete-file "testfile.ss") 2735 (not (file-exists? "testfile.ss"))) 2736 (error? (delete-file "testfile.ss" #t)) 2737 (error? (r6rs:delete-file "testfile.ss")) 2738 (and 2739 (not (file-exists? "testfile.ss")) 2740 (not (file-exists? "testfile.ss" #t)) 2741 (not (file-exists? "testfile.ss" #f))) 2742 (and 2743 (not (file-regular? "testfile.ss")) 2744 (not (file-regular? "testfile.ss" #t)) 2745 (not (file-regular? "testfile.ss" #f))) 2746 (and 2747 (not (file-directory? "testfile.ss")) 2748 (not (file-directory? "testfile.ss" #t)) 2749 (not (file-directory? "testfile.ss" #f))) 2750 (not (file-symbolic-link? "testfile.ss")) 2751 (begin 2752 (rm-rf "testdir") 2753 #t) 2754 (and 2755 (not (file-exists? "testdir")) 2756 (not (file-exists? "testdir" #t)) 2757 (not (file-exists? "testdir" #f))) 2758 (and 2759 (not (file-regular? "testdir")) 2760 (not (file-regular? "testdir" #t)) 2761 (not (file-regular? "testdir" #f))) 2762 (and 2763 (not (file-directory? "testdir")) 2764 (not (file-directory? "testdir" #t)) 2765 (not (file-directory? "testdir" #f))) 2766 (not (file-symbolic-link? "testdir")) 2767 (begin 2768 (mkdir "testdir") 2769 (and 2770 (file-exists? "testdir") 2771 (file-exists? "testdir" #t) 2772 (file-exists? "testdir" #f))) 2773 (and 2774 (not (file-regular? "testdir")) 2775 (not (file-regular? "testdir" #t)) 2776 (not (file-regular? "testdir" #f))) 2777 (and 2778 (file-directory? "testdir") 2779 (file-directory? "testdir" #t) 2780 (file-directory? "testdir" #f)) 2781 (not (file-symbolic-link? "testdir")) 2782 (eqv? (directory-list "testdir") '()) 2783 (begin 2784 (with-output-to-file "testdir/testfile.ss" values) 2785 (and 2786 (file-exists? "testdir/testfile.ss") 2787 (file-exists? "testdir/testfile.ss" #t) 2788 (file-exists? "testdir/testfile.ss" #f))) 2789 (and 2790 (file-regular? "testdir/testfile.ss") 2791 (file-regular? "testdir/testfile.ss" #t) 2792 (file-regular? "testdir/testfile.ss" #f)) 2793 (and 2794 (not (file-directory? "testdir/testfile.ss")) 2795 (not (file-directory? "testdir/testfile.ss" #t)) 2796 (not (file-directory? "testdir/testfile.ss" #f))) 2797 (not (file-symbolic-link? "testdir/testfile.ss")) 2798 (equal? (directory-list "testdir") '("testfile.ss")) 2799 (begin 2800 (with-output-to-file "testdir/foo" values) 2801 (and 2802 (file-exists? "testdir/foo") 2803 (file-exists? "testdir/foo" #t) 2804 (file-exists? "testdir/foo" #f))) 2805 (begin 2806 (with-output-to-file "testdir/bar" values) 2807 (and 2808 (file-exists? "testdir/bar") 2809 (file-exists? "testdir/bar" #t) 2810 (file-exists? "testdir/bar" #f))) 2811 (file-regular? "testdir/foo") 2812 (not (file-directory? "testdir/foo")) 2813 (not (file-symbolic-link? "testdir/foo")) 2814 (file-regular? "testdir/bar") 2815 (not (file-directory? "testdir/bar")) 2816 (not (file-symbolic-link? "testdir/bar")) 2817 (equal? 2818 (sort string<? (directory-list "testdir")) 2819 '("bar" "foo" "testfile.ss")) 2820 (guard (c [(and (i/o-filename-error? c) 2821 (equal? (i/o-error-filename c) "testdir"))]) 2822 (delete-directory "testdir" #t)) 2823 (eqv? (delete-directory "testdir" #f) #f) 2824 (eqv? (delete-directory "testdir") #f) 2825 (guard (c [(and (i/o-filename-error? c) 2826 (equal? (i/o-error-filename c) "testdir/testfile.ss"))]) 2827 (delete-directory "testdir/testfile.ss" #t)) 2828 (not (delete-directory "testdir/testfile.ss" #f)) 2829 (not (delete-directory "testdir/testfile.ss")) 2830 (guard (c [(and (i/o-filename-error? c) 2831 (equal? (i/o-error-filename c) "testdir"))]) 2832 (delete-file "testdir" #t)) 2833 (not (delete-file "testdir")) 2834 (not (delete-file "testdir" #f)) 2835 (eqv? (delete-file "testdir/testfile.ss" #t) (void)) 2836 (eqv? (delete-file "testdir/foo" #f) #t) 2837 (eqv? (delete-file "testdir/bar") #t) 2838 (not (delete-file "testdir" #f)) 2839 (not (delete-file "testdir")) 2840 (eqv? (delete-directory "testdir" #f) #t) 2841 (begin 2842 (mkdir "testdir") 2843 (file-exists? "testdir")) 2844 (eqv? (delete-directory "testdir" #t) (void)) 2845 (begin 2846 (mkdir "testdir") 2847 (file-exists? "testdir")) 2848 (eqv? (delete-directory "testdir") #t) 2849 (error? (file-exists? 'foo)) 2850 (error? (file-regular? 'foo)) 2851 (error? (file-directory? 'foo)) 2852 (error? (file-symbolic-link? 'foo)) 2853 (error? (file-exists? 'foo #t)) 2854 (error? (file-regular? 'foo #t)) 2855 (error? (file-directory? 'foo #t)) 2856 (error? (file-exists? 'foo #f)) 2857 (error? (file-regular? 'foo #f)) 2858 (error? (file-directory? 'foo #f)) 2859 (error? (delete-file 'foo #t)) 2860 (error? (delete-file 'foo #f)) 2861 (error? (delete-file 'foo)) 2862 (error? (delete-directory 'foo #t)) 2863 (error? (delete-directory 'foo #f)) 2864 (error? (delete-directory 'foo)) 2865 (error? (directory-list 'foo)) 2866 (begin 2867 (mkdir "testdir") 2868 (with-output-to-file "testdir/rats" values) 2869 (file-exists? "testdir")) 2870 (eqv? (rename-file "testdir" "testdirx") (void)) 2871 (eqv? (rename-file "testdirx/rats" "testdirx/star") (void)) 2872 (not (delete-file "testdirx/rats" #f)) 2873 (eqv? (delete-file "testdirx/star" #t) (void)) 2874 (not (delete-directory "testdir" #f)) 2875 (eqv? (delete-directory "testdirx" #t) (void)) 2876 (or (embedded?) (> (length (directory-list "~")) 0)) 2877 (or (embedded?) (> (length (directory-list "~/")) 0)) 2878 (or (not (windows?)) 2879 (> (length (directory-list "c:")) 0)) 2880 (or (not (windows?)) 2881 (> (length (directory-list "c:/")) 0)) 2882 (or (not (windows?)) 2883 (> (length (directory-list "\\\\?\\c:\\")) 0)) 2884 (or (not (windows?)) 2885 (> (length (directory-list "\\\\?\\C:\\")) 0)) 2886 (file-directory? "/") 2887 (file-directory? "/.") 2888 (file-exists? ".") 2889 (file-exists? "./") 2890 (if (windows?) 2891 (and (file-directory? "c:") 2892 (file-directory? "c:/") 2893 (file-directory? "c:/.")) 2894 (not (file-directory? "c:"))) 2895 (if (windows?) 2896 (and (not (file-directory? "\\\\?\\c:")) 2897 (file-directory? "\\\\?\\c:\\")) 2898 (not (file-directory? "\\\\?\\c:"))) 2899 (if (windows?) 2900 (and (file-exists? "c:") 2901 (file-exists? "c:/") 2902 (file-exists? "c:/.")) 2903 (not (file-exists? "c:"))) 2904 (if (windows?) 2905 (and (not (file-exists? "\\\\?\\c:")) 2906 (file-exists? "\\\\?\\c:\\")) 2907 (not (file-exists? "\\\\?\\c:"))) 2908 (if (windows?) 2909 (and (not (file-regular? "\\\\?\\c:")) 2910 (not (file-regular? "\\\\?\\c:\\")) 2911 (or (not (file-exists? "\\\\?\\c:\\autoexec.bat")) 2912 (file-regular? "\\\\?\\c:\\autoexec.bat"))) 2913 (not (file-regular? "\\\\?\\c:\\autoexec.bat"))) 2914 (error? (get-mode 'foo)) 2915 (error? (get-mode 'foo #t)) 2916 (error? (get-mode 'foo #f)) 2917 (error? (get-mode "probably/not/there")) 2918 (error? (get-mode "probably/not/there" #f)) 2919 (error? (get-mode "probably/not/there" #t)) 2920 (if (or (windows?) (embedded?)) 2921 (fixnum? (get-mode "mat.ss")) 2922 (let ([m (get-mode "mat.ss")]) 2923 (and (logtest m #o400) 2924 (not (logtest m #o111))))) 2925 (or (not (windows?)) 2926 (and (fixnum? (get-mode "c:/")) 2927 (eqv? (get-mode "c:/") (get-mode "C:\\")) 2928 (eqv? (get-mode "c:/") (get-mode "c:\\.")))) 2929 (if (or (windows?) (embedded?)) 2930 (fixnum? (get-mode "../mats")) 2931 (eqv? (logand (get-mode "../mats") #o700) #o700)) 2932 (and (eqv? (get-mode "../mats") (get-mode "../mats/")) 2933 (eqv? (get-mode "../mats") (get-mode "../mats/."))) 2934 ; access times are unreliable on contemporary file systems 2935 (time? (file-access-time "../../mats/mat.ss")) 2936 (time<=? (file-change-time "mat.ss") (file-change-time "mat.so")) 2937 (time<=? (file-modification-time "mat.ss") (file-modification-time "mat.so")) 2938 (equal? 2939 (list (time? (file-access-time "../mats")) 2940 (time? (file-change-time "../mats")) 2941 (time? (file-modification-time "../mats"))) 2942 '(#t #t #t)) 2943 (equal? 2944 (list (time? (file-access-time "../mats/")) 2945 (time? (file-change-time "../mats/")) 2946 (time? (file-modification-time "../mats/"))) 2947 '(#t #t #t)) 2948 (or (not (windows?)) 2949 (and (time? (file-access-time "c:")) 2950 (time? (file-change-time "c:")) 2951 (time? (file-modification-time "c:")))) 2952 (or (not (windows?)) 2953 (and (time? (file-access-time "c:/")) 2954 (time? (file-change-time "c:/")) 2955 (time? (file-modification-time "c:/")))) 2956 (or (not (windows?)) 2957 (and (time? (file-access-time "\\\\?\\C:\\")) 2958 (time? (file-change-time "\\\\?\\C:\\")) 2959 (time? (file-modification-time "\\\\?\\C:\\")))) 2960 (or (not (windows?)) 2961 (and (time? (file-access-time "\\\\?\\c:\\")) 2962 (time? (file-change-time "\\\\?\\c:\\")) 2963 (time? (file-modification-time "\\\\?\\c:\\")))) 2964 (or (windows?) (embedded?) 2965 (time=? (file-access-time "Makefile") (file-access-time (format "Mf-~a" (machine-type))))) 2966 (or (windows?) (embedded?) 2967 (time=? (file-change-time "Makefile") (file-change-time (format "Mf-~a" (machine-type))))) 2968 (or (windows?) (embedded?) 2969 (time=? (file-modification-time "Makefile") (file-modification-time (format "Mf-~a" (machine-type))))) 2970 (error? (file-access-time "probably/not/there")) 2971 (error? (file-access-time "probably/not/there" #f)) 2972 (error? (file-access-time "probably/not/there" #t)) 2973 (error? (file-change-time "probably/not/there")) 2974 (error? (file-change-time "probably/not/there" #f)) 2975 (error? (file-change-time "probably/not/there" #t)) 2976 (error? (file-modification-time "probably/not/there")) 2977 (error? (file-modification-time "probably/not/there" #f)) 2978 (error? (file-modification-time "probably/not/there" #t)) 2979) 2980 2981(mat unicode-filesystem-operations 2982 (begin 2983 (delete-file "testfile\x3bb;.ss" #f) 2984 (delete-file "testfile\x3bb;.ss" #f) 2985 (delete-file "testfile\x3bb;.ss") 2986 #t) 2987 (begin 2988 (with-output-to-file "testfile\x3bb;.ss" values) 2989 (r6rs:delete-file "testfile\x3bb;.ss") 2990 (not (file-exists? "testfile\x3bb;.ss"))) 2991 (error? (delete-file "testfile\x3bb;.ss" #t)) 2992 (error? (r6rs:delete-file "testfile\x3bb;.ss")) 2993 (and 2994 (not (file-exists? "testfile\x3bb;.ss")) 2995 (not (file-exists? "testfile\x3bb;.ss" #t)) 2996 (not (file-exists? "testfile\x3bb;.ss" #f))) 2997 (and 2998 (not (file-regular? "testfile\x3bb;.ss")) 2999 (not (file-regular? "testfile\x3bb;.ss" #t)) 3000 (not (file-regular? "testfile\x3bb;.ss" #f))) 3001 (and 3002 (not (file-directory? "testfile\x3bb;.ss")) 3003 (not (file-directory? "testfile\x3bb;.ss" #t)) 3004 (not (file-directory? "testfile\x3bb;.ss" #f))) 3005 (not (file-symbolic-link? "testfile\x3bb;.ss")) 3006 (and 3007 (not (file-exists? "testdir\x3bb;")) 3008 (not (file-exists? "testdir\x3bb;" #t)) 3009 (not (file-exists? "testdir\x3bb;" #f))) 3010 (and 3011 (not (file-regular? "testdir\x3bb;")) 3012 (not (file-regular? "testdir\x3bb;" #t)) 3013 (not (file-regular? "testdir\x3bb;" #f))) 3014 (and 3015 (not (file-directory? "testdir\x3bb;")) 3016 (not (file-directory? "testdir\x3bb;" #t)) 3017 (not (file-directory? "testdir\x3bb;" #f))) 3018 (not (file-symbolic-link? "testdir\x3bb;")) 3019 (begin 3020 (mkdir "testdir\x3bb;") 3021 (and 3022 (file-exists? "testdir\x3bb;") 3023 (file-exists? "testdir\x3bb;" #t) 3024 (file-exists? "testdir\x3bb;" #f))) 3025 (and 3026 (not (file-regular? "testdir\x3bb;")) 3027 (not (file-regular? "testdir\x3bb;" #t)) 3028 (not (file-regular? "testdir\x3bb;" #f))) 3029 (and 3030 (file-directory? "testdir\x3bb;") 3031 (file-directory? "testdir\x3bb;" #t) 3032 (file-directory? "testdir\x3bb;" #f)) 3033 (not (file-symbolic-link? "testdir\x3bb;")) 3034 (eqv? (directory-list "testdir\x3bb;") '()) 3035 (begin 3036 (with-output-to-file "testdir\x3bb;/testfile\x3bb;.ss" values) 3037 (and 3038 (file-exists? "testdir\x3bb;/testfile\x3bb;.ss") 3039 (file-exists? "testdir\x3bb;/testfile\x3bb;.ss" #t) 3040 (file-exists? "testdir\x3bb;/testfile\x3bb;.ss" #f))) 3041 (and 3042 (file-regular? "testdir\x3bb;/testfile\x3bb;.ss") 3043 (file-regular? "testdir\x3bb;/testfile\x3bb;.ss" #t) 3044 (file-regular? "testdir\x3bb;/testfile\x3bb;.ss" #f)) 3045 (and 3046 (not (file-directory? "testdir\x3bb;/testfile\x3bb;.ss")) 3047 (not (file-directory? "testdir\x3bb;/testfile\x3bb;.ss" #t)) 3048 (not (file-directory? "testdir\x3bb;/testfile\x3bb;.ss" #f))) 3049 (not (file-symbolic-link? "testdir\x3bb;/testfile\x3bb;.ss")) 3050 (equal? (directory-list "testdir\x3bb;") '("testfile\x3bb;.ss")) 3051 (begin 3052 (with-output-to-file "testdir\x3bb;/foo" values) 3053 (and 3054 (file-exists? "testdir\x3bb;/foo") 3055 (file-exists? "testdir\x3bb;/foo" #t) 3056 (file-exists? "testdir\x3bb;/foo" #f))) 3057 (begin 3058 (with-output-to-file "testdir\x3bb;/bar" values) 3059 (and 3060 (file-exists? "testdir\x3bb;/bar") 3061 (file-exists? "testdir\x3bb;/bar" #t) 3062 (file-exists? "testdir\x3bb;/bar" #f))) 3063 (file-regular? "testdir\x3bb;/foo") 3064 (not (file-directory? "testdir\x3bb;/foo")) 3065 (not (file-symbolic-link? "testdir\x3bb;/foo")) 3066 (file-regular? "testdir\x3bb;/bar") 3067 (not (file-directory? "testdir\x3bb;/bar")) 3068 (not (file-symbolic-link? "testdir\x3bb;/bar")) 3069 (equal? 3070 (sort string<? (directory-list "testdir\x3bb;")) 3071 '("bar" "foo" "testfile\x3bb;.ss")) 3072 (guard (c [(and (i/o-filename-error? c) 3073 (equal? (i/o-error-filename c) "testdir\x3bb;"))]) 3074 (delete-directory "testdir\x3bb;" #t)) 3075 (eqv? (delete-directory "testdir\x3bb;" #f) #f) 3076 (eqv? (delete-directory "testdir\x3bb;") #f) 3077 (guard (c [(and (i/o-filename-error? c) 3078 (equal? (i/o-error-filename c) "testdir\x3bb;/testfile\x3bb;.ss"))]) 3079 (delete-directory "testdir\x3bb;/testfile\x3bb;.ss" #t)) 3080 (not (delete-directory "testdir\x3bb;/testfile\x3bb;.ss" #f)) 3081 (not (delete-directory "testdir\x3bb;/testfile\x3bb;.ss")) 3082 (guard (c [(and (i/o-filename-error? c) 3083 (equal? (i/o-error-filename c) "testdir\x3bb;"))]) 3084 (delete-file "testdir\x3bb;" #t)) 3085 (not (delete-file "testdir\x3bb;")) 3086 (not (delete-file "testdir\x3bb;" #f)) 3087 (eqv? (delete-file "testdir\x3bb;/testfile\x3bb;.ss" #t) (void)) 3088 (eqv? (delete-file "testdir\x3bb;/foo" #f) #t) 3089 (eqv? (delete-file "testdir\x3bb;/bar") #t) 3090 (not (delete-file "testdir\x3bb;" #f)) 3091 (not (delete-file "testdir\x3bb;")) 3092 (eqv? (delete-directory "testdir\x3bb;" #f) #t) 3093 (begin 3094 (mkdir "testdir\x3bb;") 3095 (file-exists? "testdir\x3bb;")) 3096 (eqv? (delete-directory "testdir\x3bb;" #t) (void)) 3097 (begin 3098 (mkdir "testdir\x3bb;") 3099 (file-exists? "testdir\x3bb;")) 3100 (eqv? (delete-directory "testdir\x3bb;") #t) 3101 (begin 3102 (mkdir "testdir\x3bb;") 3103 (with-output-to-file "testdir\x3bb;/ra\x3bb;ts" values) 3104 (file-exists? "testdir\x3bb;")) 3105 (fixnum? (get-mode "testdir\x3bb;/ra\x3bb;ts")) 3106 (time? (file-access-time "testdir\x3bb;/ra\x3bb;ts")) 3107 (time? (file-change-time "testdir\x3bb;/ra\x3bb;ts")) 3108 (time? (file-modification-time "testdir\x3bb;/ra\x3bb;ts")) 3109 (eqv? (rename-file "testdir\x3bb;" "testdir\x3bb;x") (void)) 3110 (eqv? (rename-file "testdir\x3bb;x/ra\x3bb;ts" "testdir\x3bb;x/sta\x3bb;r") (void)) 3111 (not (delete-file "testdir\x3bb;x/ra\x3bb;ts" #f)) 3112 (eqv? (delete-file "testdir\x3bb;x/sta\x3bb;r" #t) (void)) 3113 (not (delete-directory "testdir\x3bb;" #f)) 3114 (eqv? (delete-directory "testdir\x3bb;x" #t) (void)) 3115 (error? (get-mode "probably/not/there\x3bb;")) 3116 (error? (get-mode "probably/not/there\x3bb;" #f)) 3117 (error? (get-mode "probably/not/there\x3bb;" #t)) 3118 (error? (file-access-time "probably/not/\x3bb;there")) 3119 (error? (file-access-time "probably/not/\x3bb;there" #f)) 3120 (error? (file-access-time "probably/not/\x3bb;there" #t)) 3121 (error? (file-change-time "probably/not/\x3bb;there")) 3122 (error? (file-change-time "probably/not/\x3bb;there" #f)) 3123 (error? (file-change-time "probably/not/\x3bb;there" #t)) 3124 (error? (file-modification-time "probably/not/\x3bb;there")) 3125 (error? (file-modification-time "probably/not/\x3bb;there" #f)) 3126 (error? (file-modification-time "probably/not/\x3bb;there" #t)) 3127) 3128 3129(mat pathprocs 3130 (error? (path-absolute? 'a/b/c)) 3131 (error? (path-parent 'a/b/c)) 3132 (error? (path-last 'a/b/c)) 3133 (error? (path-root 'a/b/c)) 3134 (error? (path-extension 'a/b/c)) 3135 3136 (eq? (path-absolute? "") #f) 3137 (eq? (path-absolute? "a") #f) 3138 (eq? (path-absolute? "/") #t) 3139 (eq? (path-absolute? "//bar/rot") #t) 3140 (eq? (path-absolute? "~foo/bar") #t) 3141 (eq? (path-absolute? "~/foo") #t) 3142 (eq? (path-absolute? "../") #f) 3143 (eq? (path-absolute? "./") #f) 3144 (eq? (path-absolute? "/abc") #t) 3145 (eq? (path-absolute? "foo") #f) 3146 (eq? (path-absolute? "foo/bar/a.b") #f) 3147 (eq? (path-absolute? "c:abc") #f) 3148 3149 (equal? (path-parent "") "") 3150 (equal? (path-parent "a") "") 3151 (equal? (path-parent "/") "/") 3152 (equal? (path-parent "../") "..") 3153 (equal? (path-parent "./") ".") 3154 (equal? (path-parent "/abc") "/") 3155 (equal? (path-parent "foo/bar") "foo") 3156 (equal? (path-parent "foo/bar/") "foo/bar") 3157 (equal? (path-parent "foo/bar/a") "foo/bar") 3158 (equal? (path-parent "foo/bar/a.b") "foo/bar") 3159 (equal? (path-parent "foo/bar.b.q/a.b") "foo/bar.b.q") 3160 (equal? 3161 (path-parent "c:abc") 3162 (if (windows?) "c:" "")) 3163 (equal? 3164 (path-parent "Z:abc") 3165 (if (windows?) "Z:" "")) 3166 3167 (equal? (path-last "") "") 3168 (equal? (path-last "a") "a") 3169 (equal? (path-last "/") "") 3170 (equal? (path-last "../") "") 3171 (equal? (path-last "./") "") 3172 (equal? (path-last "//") "") 3173 (equal? (path-last "/abc") "abc") 3174 (equal? (path-last "foo/bar") "bar") 3175 (equal? (path-last "foo/bar/") "") 3176 (equal? (path-last "foo/bar/a") "a") 3177 (equal? (path-last "foo/bar/a.b") "a.b") 3178 (equal? (path-last "foo/bar.b.q/a.b") "a.b") 3179 (equal? 3180 (path-last "c:abc") 3181 (if (windows?) "abc" "c:abc")) 3182 (equal? 3183 (path-last "Z:abc") 3184 (if (windows?) "abc" "Z:abc")) 3185 3186 (equal? (path-root "") "") 3187 (equal? (path-root "a") "a") 3188 (equal? (path-root "..") "..") 3189 (equal? (path-root ".") ".") 3190 (equal? (path-root "..abc") ".") 3191 (equal? (path-root "abc.") "abc") 3192 (equal? (path-root "a.b.c") "a.b") 3193 (equal? (path-root "a.b.c.ss") "a.b.c") 3194 (equal? (path-last "foo") "foo") 3195 (equal? (path-root "/foo/bar.b.q/a.b.c") "/foo/bar.b.q/a.b") 3196 (equal? (path-root "c:/foo/bar.b.q/a.b.c") "c:/foo/bar.b.q/a.b") 3197 (equal? (path-root "c:") "c:") 3198 3199 (equal? (path-extension "") "") 3200 (equal? (path-extension "a") "") 3201 (equal? (path-extension "..") "") 3202 (equal? (path-extension ".") "") 3203 (equal? (path-extension "..abc") "abc") 3204 (equal? (path-extension "abc.") "") 3205 (equal? (path-extension "a.b.c") "c") 3206 (equal? (path-extension "a.b.c.ss") "ss") 3207 (equal? (path-extension "/foo/bar.b.q/a.b.c") "c") 3208 (equal? (path-extension "c:/foo/bar.b.q/a.b.c") "c") 3209 (equal? (path-extension "c:..") "") 3210 (equal? (path-extension "c:") "") 3211 3212 ; if this test fails, search for the asterisks in the printed table 3213 (let ([okay? #t]) 3214 (define print-table 3215 (lambda (x* expected**) 3216 (define print-row 3217 (lambda (abs? path first rest parent last root extension) 3218 (printf "~a~11t~a~17t~a~28t~a~39t~a~50t~a~61t~a~73t~a\n" 3219 abs? path first rest parent last root extension))) 3220 (print-row "path" " abs" " first" " rest" " parent" " last" " root" " ext") 3221 (let ([actual** (map (lambda (x) 3222 (list 3223 (if (path-absolute? x) "t" "f") 3224 (path-first x) 3225 (path-rest x) 3226 (path-parent x) 3227 (path-last x) 3228 (path-root x) 3229 (path-extension x))) 3230 x*)]) 3231 (for-each 3232 (lambda (x expected* actual*) 3233 (define uscore (lambda (s) (if (eqv? s "") "_" s))) 3234 (apply print-row x 3235 (map (lambda (expected actual) 3236 (format "~a~a" 3237 (if (string=? expected actual) " " (begin (set! okay? #f) "*")) 3238 (uscore actual))) 3239 expected* actual*))) 3240 x* expected** actual**)))) 3241 3242 (define-syntax table 3243 (syntax-rules () 3244 [(_ (path abs? first rest parent last root extension) ...) 3245 (print-table '(path ...) 3246 '((abs? first rest parent last root extension) ...))])) 3247 3248 ; common 3249 (table 3250 ("c" "f" "" "c" "" "c" "c" "") 3251 ("c." "f" "" "c." "" "c." "c" "") 3252 ("c.q" "f" "" "c.q" "" "c.q" "c" "q") 3253 ("c.qq" "f" "" "c.qq" "" "c.qq" "c" "qq") 3254 ("c.qqqqq" "f" "" "c.qqqqq" "" "c.qqqqq" "c" "qqqqq") 3255 ("c.qqq." "f" "" "c.qqq." "" "c.qqq." "c.qqq" "") 3256 ("c.qqq.zz" "f" "" "c.qqq.zz" "" "c.qqq.zz" "c.qqq" "zz") 3257 ("c./" "f" "c." "" "c." "" "c./" "") 3258 ("c.q/" "f" "c.q" "" "c.q" "" "c.q/" "") 3259 ("c.qq.z/" "f" "c.qq.z" "" "c.qq.z" "" "c.qq.z/" "") 3260 (".qq" "f" "" ".qq" "" ".qq" "" "qq") 3261 (".qq.z" "f" "" ".qq.z" "" ".qq.z" ".qq" "z") 3262 ("/" "t" "/" "" "/" "" "/" "") 3263 ("/abc" "t" "/" "abc" "/" "abc" "/abc" "") 3264 ("/abc/" "t" "/" "abc/" "/abc" "" "/abc/" "") 3265 ("abc" "f" "" "abc" "" "abc" "abc" "") 3266 ("/abc/def" "t" "/" "abc/def" "/abc" "def" "/abc/def" "") 3267 ("abc//def" "f" "abc" "def" "abc" "def" "abc//def" "") 3268 (".." "f" ".." "" ".." "" ".." "") 3269 ("../.." "f" ".." ".." ".." ".." "../.." "") 3270 ("../" "f" ".." "" ".." "" "../" "") 3271 ("../a" "f" ".." "a" ".." "a" "../a" "") 3272 ("../a/b" "f" ".." "a/b" "../a" "b" "../a/b" "") 3273 ("." "f" "." "" "." "" "." "") 3274 ("./." "f" "." "." "." "." "./." "") 3275 ("./" "f" "." "" "." "" "./" "") 3276 ("./a" "f" "." "a" "." "a" "./a" "") 3277 ("./a/b" "f" "." "a/b" "./a" "b" "./a/b" "") 3278 ("..." "f" "" "..." "" "..." ".." "") 3279 (".../" "f" "..." "" "..." "" ".../" "") 3280 (".../a" "f" "..." "a" "..." "a" ".../a" "") 3281 (".foo" "f" "" ".foo" "" ".foo" "" "foo") 3282 (".foo/" "f" ".foo" "" ".foo" "" ".foo/" "") 3283 (".foo/a" "f" ".foo" "a" ".foo" "a" ".foo/a" "") 3284 (".foo/a.q" "f" ".foo" "a.q" ".foo" "a.q" ".foo/a" "q") 3285 ("~" "t" "~" "" "~" "" "~" "") 3286 ("~/a" "t" "~" "a" "~" "a" "~/a" "") 3287 ("~/a/" "t" "~" "a/" "~/a" "" "~/a/" "") 3288 ("~/a/b" "t" "~" "a/b" "~/a" "b" "~/a/b" "") 3289 ("~a" "t" "~a" "" "~a" "" "~a" "") 3290 ("~a.b" "t" "~a.b" "" "~a.b" "" "~a.b" "") 3291 ("~a/" "t" "~a" "" "~a" "" "~a/" "") 3292 ("~a/b" "t" "~a" "b" "~a" "b" "~a/b" "") 3293 ("~a/b/" "t" "~a" "b/" "~a/b" "" "~a/b/" "") 3294 ("~a/b/c" "t" "~a" "b/c" "~a/b" "c" "~a/b/c" "") 3295 ) 3296 3297 ; windows 3298 (if (windows?) 3299 (table 3300 ("c:" "f" "c:" "" "c:" "" "c:" "") 3301 ("c:/" "t" "c:/" "" "c:/" "" "c:/" "") 3302 ("c:.." "f" "c:" ".." "c:" ".." "c:.." "") 3303 ("c:../" "f" "c:" "../" "c:.." "" "c:../" "") 3304 ("c:../a" "f" "c:" "../a" "c:.." "a" "c:../a" "") 3305 ("c:." "f" "c:" "." "c:" "." "c:." "") 3306 ("c:./" "f" "c:" "./" "c:." "" "c:./" "") 3307 ("c:./a" "f" "c:" "./a" "c:." "a" "c:./a" "") 3308 ("c:/abc" "t" "c:/" "abc" "c:/" "abc" "c:/abc" "") 3309 ("c:abc" "f" "c:" "abc" "c:" "abc" "c:abc" "") 3310 ("c:abc/def" "f" "c:" "abc/def" "c:abc" "def" "c:abc/def" "") 3311 ("c:/abc/def" "t" "c:/" "abc/def" "c:/abc" "def" "c:/abc/def" "") 3312 ("//abc" "t" "//abc" "" "//abc" "" "//abc" "") 3313 ("//abc/" "t" "//abc" "" "//abc" "" "//abc/" "") 3314 ("//abc/def" "t" "//abc" "def" "//abc" "def" "//abc/def" "") 3315 ("//x.com" "t" "//x.com" "" "//x.com" "" "//x.com" "") 3316 ("\\\\?\\" "t" "\\\\?\\" "" "\\\\?\\" "" "\\\\?\\" "" ) 3317 ("\\\\?\\c:" "t" "\\\\?\\c:" "" "\\\\?\\c:" "" "\\\\?\\c:" "" ) 3318 ("\\\\?\\c:\\" "t" "\\\\?\\c:\\" "" "\\\\?\\c:\\" "" "\\\\?\\c:\\" "" ) 3319 ("\\\\?\\UNC\\" "t" "\\\\?\\UNC\\" "" "\\\\?\\UNC\\" "" "\\\\?\\UNC\\" "" ) 3320 ("\\\\?\\Unc\\" "t" "\\\\?\\Unc\\" "" "\\\\?\\Unc\\" "" "\\\\?\\Unc\\" "" ) 3321 ("\\\\?\\uNc\\\\" "t" "\\\\?\\uNc\\\\" "" "\\\\?\\uNc\\\\" "" "\\\\?\\uNc\\\\" "" ) 3322 ("\\\\?\\unc\\x.com" "t" "\\\\?\\unc\\x.com" "" "\\\\?\\unc\\x.com" "" "\\\\?\\unc\\x.com" "" ) 3323 ("\\\\?\\unc\\x.com\\rot.foo" "t" "\\\\?\\unc\\x.com" "rot.foo" "\\\\?\\unc\\x.com" "rot.foo" "\\\\?\\unc\\x.com\\rot" "foo" ) 3324 ("\\\\?\\unc\\\\x.com\\rot.foo" "t" "\\\\?\\unc\\\\x.com" "rot.foo" "\\\\?\\unc\\\\x.com" "rot.foo" "\\\\?\\unc\\\\x.com\\rot" "foo" ) 3325 ("\\\\?\\unc\\x.com/rot.foo" "t" "\\\\?\\unc\\x.com/rot.foo" "" "\\\\?\\unc\\x.com/rot.foo" "" "\\\\?\\unc\\x.com/rot.foo" "" ) 3326 ) 3327 (table 3328 ("c:" "f" "" "c:" "" "c:" "c:" "") 3329 ("c:/" "f" "c:" "" "c:" "" "c:/" "") 3330 ("c:.." "f" "" "c:.." "" "c:.." "c:." "") 3331 ("c:../" "f" "c:.." "" "c:.." "" "c:../" "") 3332 ("c:../a" "f" "c:.." "a" "c:.." "a" "c:../a" "") 3333 ("c:." "f" "" "c:." "" "c:." "c:" "") 3334 ("c:./" "f" "c:." "" "c:." "" "c:./" "") 3335 ("c:./a" "f" "c:." "a" "c:." "a" "c:./a" "") 3336 ("c:/abc" "f" "c:" "abc" "c:" "abc" "c:/abc" "") 3337 ("c:abc" "f" "" "c:abc" "" "c:abc" "c:abc" "") 3338 ("c:abc/def" "f" "c:abc" "def" "c:abc" "def" "c:abc/def" "") 3339 ("c:/abc/def" "f" "c:" "abc/def" "c:/abc" "def" "c:/abc/def" "") 3340 ("//abc" "t" "/" "abc" "/" "abc" "//abc" "") 3341 ("//abc/" "t" "/" "abc/" "//abc" "" "//abc/" "") 3342 ("//abc/def" "t" "/" "abc/def" "//abc" "def" "//abc/def" "") 3343 ("//x.com" "t" "/" "x.com" "/" "x.com" "//x" "com") 3344 )) 3345 okay?) 3346) 3347 3348(mat binary-vs-textual-port 3349 (textual-port? (current-input-port)) 3350 (not (binary-port? (current-input-port))) 3351 (textual-port? (current-output-port)) 3352 (not (binary-port? (current-output-port))) 3353 3354 (begin 3355 (define $handler-standin (#%$port-handler (open-string-input-port "hi"))) 3356 #t) 3357 3358 (binary-port? (#%$make-binary-input-port "" $handler-standin '#vu8())) 3359 (not (textual-port? (#%$make-binary-input-port "" $handler-standin '#vu8()))) 3360 (not (binary-port? (#%$make-textual-input-port "" $handler-standin ""))) 3361 (textual-port? (#%$make-textual-input-port "" $handler-standin "")) 3362 (not (binary-port? (make-input-port values ""))) 3363 (textual-port? (make-input-port values "")) 3364 3365 (binary-port? (#%$make-binary-output-port "" $handler-standin '#vu8())) 3366 (not (textual-port? (#%$make-binary-output-port "" $handler-standin '#vu8()))) 3367 (not (binary-port? (#%$make-textual-output-port "" $handler-standin ""))) 3368 (textual-port? (#%$make-textual-output-port "" $handler-standin "")) 3369 (not (binary-port? (make-output-port values ""))) 3370 (textual-port? (make-output-port values "")) 3371 3372 (let ((x (make-input-port values ""))) 3373 (and (port? x) 3374 (and (input-port? x) (textual-port? x)) 3375 (not (and (output-port? x) (binary-port? x))) 3376 (not (output-port? x)) 3377 (not (binary-port? x)))) 3378 (let ((x (#%$make-binary-input-port "" $handler-standin '#vu8()))) 3379 (and (port? x) 3380 (and (input-port? x) (binary-port? x)) 3381 (not (and (output-port? x) (textual-port? x))) 3382 (not (output-port? x)) 3383 (not (textual-port? x)))) 3384 (let ((x (#%$make-textual-input-port "" $handler-standin ""))) 3385 (and (port? x) 3386 (and (input-port? x) (textual-port? x)) 3387 (not (and (output-port? x) (binary-port? x))) 3388 (not (output-port? x)) 3389 (not (binary-port? x)))) 3390 (let ((x (make-output-port values ""))) 3391 (and (port? x) 3392 (and (output-port? x) (textual-port? x)) 3393 (not (and (input-port? x) (binary-port? x))) 3394 (not (input-port? x)) 3395 (not (binary-port? x)))) 3396 (let ((x (#%$make-binary-output-port "" $handler-standin '#vu8()))) 3397 (and (port? x) 3398 (and (output-port? x) (binary-port? x)) 3399 (not (and (input-port? x) (textual-port? x))) 3400 (not (input-port? x)) 3401 (not (textual-port? x)))) 3402 (let ((x (#%$make-textual-output-port "" $handler-standin ""))) 3403 (and (port? x) 3404 (and (output-port? x) (textual-port? x)) 3405 (not (and (input-port? x) (binary-port? x))) 3406 (not (input-port? x)) 3407 (not (binary-port? x)))) 3408) 3409 3410(mat port-name 3411 (equal? "foo" (port-name (#%$make-binary-output-port "foo" $handler-standin #vu8()))) 3412 (equal? "foo" (port-name (#%$make-textual-output-port "foo" $handler-standin ""))) 3413 (equal? "foo" (let ([x (#%$make-binary-output-port "rot" $handler-standin #vu8())]) 3414 (set-port-name! x "foo") 3415 (port-name x))) 3416 (equal? "foo" (let ([x (#%$make-textual-output-port "#f" $handler-standin "")]) 3417 (set-port-name! x "foo") 3418 (port-name x))) 3419 (equal? "foo" (port-name (make-output-port (lambda args "foo") ""))) 3420 (equal? "generic" (port-name (make-output-port (lambda args (errorf 'foo "foo")) ""))) 3421) 3422 3423(mat procedure-name 3424 (equal? (format "~s" car) "#<procedure car>") 3425 (equal? (format "~s" (lambda (x) x)) "#<procedure>") 3426 (begin 3427 (with-output-to-file "testfile.ss" 3428 (lambda () 3429 (pretty-print '(define ($pn-q x) (lambda (y) (+ x y))))) 3430 'replace) 3431 (load "testfile.ss" compile) 3432 #t) 3433 (equal? (format "~s" $pn-q) "#<procedure $pn-q at testfile.ss:0>") 3434 (equal? (format "~s" ($pn-q 3)) "#<procedure at testfile.ss:18>") 3435) 3436 3437(mat bignum-printing 3438 (let () 3439 (define wrint 3440 (let ([digit->char 3441 (lambda (d) 3442 (string-ref "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" d))]) 3443 (lambda (n b) 3444 (if (< n b) 3445 (write-char (digit->char n)) 3446 (begin 3447 (wrint (quotient n b) b) 3448 (write-char (digit->char (remainder n b)))))))) 3449 (do ([i 4000 (fx- i 1)]) 3450 ((fx= i 0)) 3451 (let ([n (random (expt 2 (random (* (fixnum-width) 30))))] 3452 [b (+ 2 (random 35))]) 3453 (unless (let ([s (with-output-to-string (lambda () (wrint n b)))]) 3454 (and (string=? 3455 (parameterize ([print-radix b]) (format "~a" n)) 3456 s) 3457 (or (= n 0) 3458 (string=? 3459 (parameterize ([print-radix b]) (format "~a" (- n))) 3460 (format "-~a" s))))) 3461 (errorf #f "failed in base ~s for ~s" b n)) 3462 (unless (string=? 3463 (format "~a" n) 3464 (with-output-to-string (lambda () (wrint n 10)))) 3465 (errorf #f "failed in base 10 for ~s" n)))) 3466 #t) 3467) 3468 3469(mat process 3470 (begin (set! p (process (patch-exec-path $cat_flush))) 3471 (= (length p) 3)) 3472 (and (port? (car p)) (input-port? (car p)) 3473 (port? (cadr p)) (output-port? (cadr p)) 3474 (integer? (caddr p))) 3475 (and (file-port? (car p)) (file-port? (cadr p))) 3476 (and (fixnum? (port-file-descriptor (car p))) 3477 (fixnum? (port-file-descriptor (cadr p)))) 3478 (let ([ip (car p)]) 3479 (and (not (port-has-port-position? ip)) 3480 (not (port-has-set-port-position!? ip)) 3481 (not (port-has-port-length? ip)) 3482 (not (port-has-set-port-length!? ip)))) 3483 (let ([op (car p)]) 3484 (and (not (port-has-port-position? op)) 3485 (not (port-has-set-port-position!? op)) 3486 (not (port-has-port-length? op)) 3487 (not (port-has-set-port-length!? op)))) 3488 (not (char-ready? (car p))) 3489 (begin (display "hello " (cadr p)) 3490 (flush-output-port (cadr p)) 3491 #t) 3492 (begin (sleep (make-time 'time-duration 0 3)) #t) ; wait for subprocess to catch up 3493 (char-ready? (car p)) 3494 (eq? (read (car p)) 'hello) 3495 (char-ready? (car p)) 3496 (char=? (read-char (car p)) #\space) 3497 (not (char-ready? (car p))) 3498 (begin (close-output-port (cadr p)) #t) 3499 (begin (sleep (make-time 'time-duration 0 3)) #t) ; wait for subprocess to catch up 3500 (sanitized-error? (write-char #\a (cadr p))) 3501 (sanitized-error? (write-char #\newline (cadr p))) 3502 (sanitized-error? (flush-output-port (cadr p))) 3503 (char-ready? (car p)) 3504 (eof-object? (read-char (car p))) 3505 (begin (close-input-port (car p)) #t) 3506 (sanitized-error? (char-ready? (car p))) 3507 (sanitized-error? (read-char (car p))) 3508 (sanitized-error? (clear-input-port (cadr p))) 3509 ) 3510