1;;;; ports.test --- Guile I/O ports. -*- coding: utf-8; mode: scheme; -*- 2;;;; Jim Blandy <jimb@red-bean.com> --- May 1999 3;;;; 4;;;; Copyright (C) 1999, 2001, 2004, 2006, 2007, 2009, 2010, 5;;;; 2011, 2012, 2013, 2014, 2015, 2017, 2019 Free Software Foundation, Inc. 6;;;; 7;;;; This library is free software; you can redistribute it and/or 8;;;; modify it under the terms of the GNU Lesser General Public 9;;;; License as published by the Free Software Foundation; either 10;;;; version 3 of the License, or (at your option) any later version. 11;;;; 12;;;; This library is distributed in the hope that it will be useful, 13;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 15;;;; Lesser General Public License for more details. 16;;;; 17;;;; You should have received a copy of the GNU Lesser General Public 18;;;; License along with this library; if not, write to the Free Software 19;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 20 21(define-module (test-suite test-ports) 22 #:use-module (test-suite lib) 23 #:use-module (test-suite guile-test) 24 #:use-module (ice-9 popen) 25 #:use-module (ice-9 rdelim) 26 #:use-module (ice-9 threads) 27 #:use-module (rnrs bytevectors) 28 #:use-module ((ice-9 binary-ports) #:select (open-bytevector-input-port 29 open-bytevector-output-port 30 put-bytevector 31 get-bytevector-n 32 get-bytevector-all 33 unget-bytevector))) 34 35(define (display-line . args) 36 (for-each display args) 37 (newline)) 38 39(define (test-file) 40 (data-file-name "ports-test.tmp")) 41 42 43;;;; Some general utilities for testing ports. 44 45;; Make sure we are set up for 8-bit Latin-1 data. 46(fluid-set! %default-port-encoding "ISO-8859-1") 47(for-each (lambda (p) 48 (set-port-encoding! p (fluid-ref %default-port-encoding))) 49 (list (current-input-port) (current-output-port) 50 (current-error-port))) 51 52;;; Read from PORT until EOF, and return the result as a string. 53(define (read-all port) 54 (let loop ((chars '())) 55 (let ((char (read-char port))) 56 (if (eof-object? char) 57 (list->string (reverse! chars)) 58 (loop (cons char chars)))))) 59 60(define (read-file filename) 61 (let* ((port (open-input-file filename)) 62 (string (read-all port))) 63 (close-port port) 64 string)) 65 66 67 68(with-test-prefix "%default-port-conversion-strategy" 69 70 (pass-if "initial value" 71 (eq? 'substitute (fluid-ref %default-port-conversion-strategy))) 72 73 (pass-if "file port" 74 (let ((strategies '(error substitute escape))) 75 (equal? (map (lambda (s) 76 (with-fluids ((%default-port-conversion-strategy s)) 77 (call-with-output-file "/dev/null" 78 (lambda (p) 79 (port-conversion-strategy p))))) 80 strategies) 81 strategies))) 82 83 (pass-if "(set-port-conversion-strategy! #f sym)" 84 (begin 85 (set-port-conversion-strategy! #f 'error) 86 (and (eq? (fluid-ref %default-port-conversion-strategy) 'error) 87 (begin 88 (set-port-conversion-strategy! #f 'substitute) 89 (eq? (fluid-ref %default-port-conversion-strategy) 90 'substitute))))) 91 92) 93 94 95;;;; Normal file ports. 96 97;;; Write out an s-expression, and read it back. 98(let ((string '("From fairest creatures we desire increase," 99 "That thereby beauty's rose might never die,")) 100 (filename (test-file))) 101 (let ((port (open-output-file filename))) 102 (write string port) 103 (close-port port)) 104 (let ((port (open-input-file filename))) 105 (let ((in-string (read port))) 106 (pass-if "file: write and read back list of strings" 107 (equal? string in-string))) 108 (close-port port)) 109 (delete-file filename)) 110 111;;; Write out a string, and read it back a character at a time. 112(let ((string "This is a test string\nwith no newline at the end") 113 (filename (test-file))) 114 (let ((port (open-output-file filename))) 115 (display string port) 116 (close-port port)) 117 (let ((in-string (read-file filename))) 118 (pass-if "file: write and read back characters" 119 (equal? string in-string))) 120 (delete-file filename)) 121 122;;; Buffered input/output port with seeking. 123(let* ((filename (test-file)) 124 (port (open-file filename "w+"))) 125 (display "J'Accuse" port) 126 (seek port -1 SEEK_CUR) 127 (pass-if "file: r/w 1" 128 (char=? (read-char port) #\e)) 129 (pass-if "file: r/w 2" 130 (eof-object? (read-char port))) 131 (seek port -1 SEEK_CUR) 132 (write-char #\x port) 133 (seek port 7 SEEK_SET) 134 (pass-if "file: r/w 3" 135 (char=? (read-char port) #\x)) 136 (seek port -2 SEEK_END) 137 (pass-if "file: r/w 4" 138 (char=? (read-char port) #\s)) 139 (close-port port) 140 (delete-file filename)) 141 142;;; Unbuffered input/output port with seeking. 143(let* ((filename (test-file)) 144 (port (open-file filename "w+0"))) 145 (display "J'Accuse" port) 146 (seek port -1 SEEK_CUR) 147 (pass-if "file: ub r/w 1" 148 (char=? (read-char port) #\e)) 149 (pass-if "file: ub r/w 2" 150 (eof-object? (read-char port))) 151 (seek port -1 SEEK_CUR) 152 (write-char #\x port) 153 (seek port 7 SEEK_SET) 154 (pass-if "file: ub r/w 3" 155 (char=? (read-char port) #\x)) 156 (seek port -2 SEEK_END) 157 (pass-if "file: ub r/w 4" 158 (char=? (read-char port) #\s)) 159 (close-port port) 160 (delete-file filename)) 161 162;;; Buffered output-only and input-only ports with seeking. 163(let* ((filename (test-file)) 164 (port (open-output-file filename))) 165 (display "J'Accuse" port) 166 (pass-if "file: out tell" 167 (= (seek port 0 SEEK_CUR) 8)) 168 (seek port -1 SEEK_CUR) 169 (write-char #\x port) 170 (close-port port) 171 (let ((iport (open-input-file filename))) 172 (pass-if "file: in tell 0" 173 (= (seek iport 0 SEEK_CUR) 0)) 174 (read-char iport) 175 (pass-if "file: in tell 1" 176 (= (seek iport 0 SEEK_CUR) 1)) 177 (unread-char #\z iport) 178 (pass-if "file: in tell 0 after unread" 179 (= (seek iport 0 SEEK_CUR) 0)) 180 (pass-if "file: unread char still there" 181 (char=? (read-char iport) #\z)) 182 (seek iport 7 SEEK_SET) 183 (pass-if "file: in last char" 184 (char=? (read-char iport) #\x)) 185 (close-port iport)) 186 (delete-file filename)) 187 188;;; unusual characters. 189(let* ((filename (test-file)) 190 (port (open-output-file filename))) 191 (display (string #\nul (integer->char 255) (integer->char 128) 192 #\nul) port) 193 (close-port port) 194 (let* ((port (open-input-file filename)) 195 (line (read-line port))) 196 (pass-if "file: read back NUL 1" 197 (char=? (string-ref line 0) #\nul)) 198 (pass-if "file: read back 255" 199 (char=? (string-ref line 1) (integer->char 255))) 200 (pass-if "file: read back 128" 201 (char=? (string-ref line 2) (integer->char 128))) 202 (pass-if "file: read back NUL 2" 203 (char=? (string-ref line 3) #\nul)) 204 (pass-if "file: EOF" 205 (eof-object? (read-char port))) 206 (close-port port)) 207 (delete-file filename)) 208 209;;; line buffering mode. 210(let* ((filename (test-file)) 211 (port (open-file filename "wl")) 212 (test-string "one line more or less")) 213 (write-line test-string port) 214 (let* ((in-port (open-input-file filename)) 215 (line (read-line in-port))) 216 (close-port in-port) 217 (close-port port) 218 (pass-if "file: line buffering" 219 (string=? line test-string))) 220 (delete-file filename)) 221 222;;; read-line should use the port encoding (not the locale encoding). 223(let ((str "ĉu bone?")) 224 (with-locale "C" 225 (let* ((filename (test-file)) 226 (port (open-file filename "wl"))) 227 (set-port-encoding! port "UTF-8") 228 (write-line str port) 229 (let ((in-port (open-input-file filename))) 230 (set-port-encoding! in-port "UTF-8") 231 (let ((line (read-line in-port))) 232 (close-port in-port) 233 (close-port port) 234 (pass-if "file: read-line honors port encoding" 235 (string=? line str)))) 236 (delete-file filename)))) 237 238;;; binary mode ignores port encoding 239(pass-if "file: binary mode ignores port encoding" 240 (with-fluids ((%default-port-encoding "UTF-8")) 241 (let* ((filename (test-file)) 242 (port (open-file filename "w")) 243 (test-string "一二三") 244 (binary-test-string 245 (apply string 246 (map integer->char 247 (array->list 248 (string->utf8 test-string)))))) 249 (write-line test-string port) 250 (close-port port) 251 (let* ((in-port (open-file filename "rb")) 252 (line (read-line in-port))) 253 (close-port in-port) 254 (delete-file filename) 255 (string=? line binary-test-string))))) 256 257;;; binary mode ignores file coding declaration 258(pass-if "file: binary mode ignores file coding declaration" 259 (with-fluids ((%default-port-encoding "UTF-8")) 260 (let* ((filename (test-file)) 261 (port (open-file filename "w")) 262 (test-string "一二三") 263 (binary-test-string 264 (apply string 265 (map integer->char 266 (array->list 267 (string->utf8 test-string)))))) 268 (write-line ";; coding: utf-8" port) 269 (write-line test-string port) 270 (close-port port) 271 (let* ((in-port (open-file filename "rb")) 272 (line1 (read-line in-port)) 273 (line2 (read-line in-port))) 274 (close-port in-port) 275 (delete-file filename) 276 (string=? line2 binary-test-string))))) 277 278;; open-file ignores file coding declaration by default 279(pass-if "file: open-file ignores coding declaration by default" 280 (with-fluids ((%default-port-encoding "UTF-8")) 281 (let* ((filename (test-file)) 282 (port (open-output-file filename)) 283 (test-string "€100")) 284 (write-line ";; coding: iso-8859-15" port) 285 (write-line test-string port) 286 (close-port port) 287 (let* ((in-port (open-input-file filename)) 288 (line1 (read-line in-port)) 289 (line2 (read-line in-port))) 290 (close-port in-port) 291 (delete-file filename) 292 (string=? line2 test-string))))) 293 294;; open-input-file with guess-encoding honors coding declaration 295(pass-if "file: open-input-file with guess-encoding honors coding declaration" 296 (with-fluids ((%default-port-encoding "UTF-8")) 297 (let* ((filename (test-file)) 298 (port (open-output-file filename)) 299 (test-string "€100")) 300 (set-port-encoding! port "iso-8859-15") 301 (write-line ";; coding: iso-8859-15" port) 302 (write-line test-string port) 303 (close-port port) 304 (let* ((in-port (open-input-file filename 305 #:guess-encoding #t)) 306 (line1 (read-line in-port)) 307 (line2 (read-line in-port))) 308 (close-port in-port) 309 (delete-file filename) 310 (string=? line2 test-string))))) 311 312(pass-if-exception "invalid wide mode string" 313 exception:out-of-range 314 (open-file "/dev/null" "λ")) 315 316(pass-if "valid wide mode string" 317 ;; Pass 'open-file' a valid mode string, but as a wide string. 318 (let ((mode (string-copy "λ"))) 319 (string-set! mode 0 #\r) 320 (let ((port (open-file "/dev/null" mode))) 321 (and (input-port? port) 322 (begin 323 (close-port port) 324 #t))))) 325 326(with-test-prefix "keyword arguments for file openers" 327 (with-fluids ((%default-port-encoding "UTF-8")) 328 (let ((filename (test-file))) 329 330 (with-test-prefix "write #:encoding" 331 332 (pass-if-equal "open-file" 333 #vu8(116 0 101 0 115 0 116 0) 334 (let ((port (open-file filename "w" 335 #:encoding "UTF-16LE"))) 336 (display "test" port) 337 (close-port port)) 338 (let* ((port (open-file filename "rb")) 339 (bv (get-bytevector-all port))) 340 (close-port port) 341 bv)) 342 343 (pass-if-equal "open-output-file" 344 #vu8(116 0 101 0 115 0 116 0) 345 (let ((port (open-output-file filename 346 #:encoding "UTF-16LE"))) 347 (display "test" port) 348 (close-port port)) 349 (let* ((port (open-file filename "rb")) 350 (bv (get-bytevector-all port))) 351 (close-port port) 352 bv)) 353 354 (pass-if-equal "call-with-output-file" 355 #vu8(116 0 101 0 115 0 116 0) 356 (call-with-output-file filename 357 (lambda (port) 358 (display "test" port)) 359 #:encoding "UTF-16LE") 360 (let* ((port (open-file filename "rb")) 361 (bv (get-bytevector-all port))) 362 (close-port port) 363 bv)) 364 365 (pass-if-equal "with-output-to-file" 366 #vu8(116 0 101 0 115 0 116 0) 367 (with-output-to-file filename 368 (lambda () 369 (display "test")) 370 #:encoding "UTF-16LE") 371 (let* ((port (open-file filename "rb")) 372 (bv (get-bytevector-all port))) 373 (close-port port) 374 bv)) 375 376 (pass-if-equal "with-error-to-file" 377 #vu8(116 0 101 0 115 0 116 0) 378 (with-error-to-file 379 filename 380 (lambda () 381 (display "test" (current-error-port))) 382 #:encoding "UTF-16LE") 383 (let* ((port (open-file filename "rb")) 384 (bv (get-bytevector-all port))) 385 (close-port port) 386 bv))) 387 388 (with-test-prefix "write #:binary" 389 390 (pass-if-equal "open-output-file" 391 "ISO-8859-1" 392 (let* ((port (open-output-file filename #:binary #t)) 393 (enc (port-encoding port))) 394 (close-port port) 395 enc)) 396 397 (pass-if-equal "call-with-output-file" 398 "ISO-8859-1" 399 (call-with-output-file filename port-encoding #:binary #t)) 400 401 (pass-if-equal "with-output-to-file" 402 "ISO-8859-1" 403 (with-output-to-file filename 404 (lambda () (port-encoding (current-output-port))) 405 #:binary #t)) 406 407 (pass-if-equal "with-error-to-file" 408 "ISO-8859-1" 409 (with-error-to-file 410 filename 411 (lambda () (port-encoding (current-error-port))) 412 #:binary #t))) 413 414 (with-test-prefix "read #:encoding" 415 416 (pass-if-equal "open-file read #:encoding" 417 "test" 418 (call-with-output-file filename 419 (lambda (port) 420 (put-bytevector port #vu8(116 0 101 0 115 0 116 0)))) 421 (let* ((port (open-file filename "r" #:encoding "UTF-16LE")) 422 (str (read-string port))) 423 (close-port port) 424 str)) 425 426 (pass-if-equal "open-input-file #:encoding" 427 "test" 428 (call-with-output-file filename 429 (lambda (port) 430 (put-bytevector port #vu8(116 0 101 0 115 0 116 0)))) 431 (let* ((port (open-input-file filename #:encoding "UTF-16LE")) 432 (str (read-string port))) 433 (close-port port) 434 str)) 435 436 (pass-if-equal "call-with-input-file #:encoding" 437 "test" 438 (call-with-output-file filename 439 (lambda (port) 440 (put-bytevector port #vu8(116 0 101 0 115 0 116 0)))) 441 (call-with-input-file filename 442 read-string 443 #:encoding "UTF-16LE")) 444 445 (pass-if-equal "with-input-from-file #:encoding" 446 "test" 447 (call-with-output-file filename 448 (lambda (port) 449 (put-bytevector port #vu8(116 0 101 0 115 0 116 0)))) 450 (with-input-from-file filename 451 read-string 452 #:encoding "UTF-16LE"))) 453 454 (with-test-prefix "read #:binary" 455 456 (pass-if-equal "open-input-file" 457 "ISO-8859-1" 458 (let* ((port (open-input-file filename #:binary #t)) 459 (enc (port-encoding port))) 460 (close-port port) 461 enc)) 462 463 (pass-if-equal "call-with-input-file" 464 "ISO-8859-1" 465 (call-with-input-file filename port-encoding #:binary #t)) 466 467 (pass-if-equal "with-input-from-file" 468 "ISO-8859-1" 469 (with-input-from-file filename 470 (lambda () (port-encoding (current-input-port))) 471 #:binary #t))) 472 473 (with-test-prefix "#:guess-encoding with coding declaration" 474 475 (pass-if-equal "open-file" 476 "€100" 477 (with-output-to-file filename 478 (lambda () 479 (write-line "test") 480 (write-line "; coding: ISO-8859-15") 481 (write-line "€100")) 482 #:encoding "ISO-8859-15") 483 (let* ((port (open-file filename "r" 484 #:guess-encoding #t 485 #:encoding "UTF-16LE")) 486 (str (begin (read-line port) 487 (read-line port) 488 (read-line port)))) 489 (close-port port) 490 str)) 491 492 (pass-if-equal "open-input-file" 493 "€100" 494 (with-output-to-file filename 495 (lambda () 496 (write-line "test") 497 (write-line "; coding: ISO-8859-15") 498 (write-line "€100")) 499 #:encoding "ISO-8859-15") 500 (let* ((port (open-input-file filename 501 #:guess-encoding #t 502 #:encoding "UTF-16LE")) 503 (str (begin (read-line port) 504 (read-line port) 505 (read-line port)))) 506 (close-port port) 507 str)) 508 509 (pass-if-equal "call-with-input-file" 510 "€100" 511 (with-output-to-file filename 512 (lambda () 513 (write-line "test") 514 (write-line "; coding: ISO-8859-15") 515 (write-line "€100")) 516 #:encoding "ISO-8859-15") 517 (call-with-input-file filename 518 (lambda (port) 519 (read-line port) 520 (read-line port) 521 (read-line port)) 522 #:guess-encoding #t 523 #:encoding "UTF-16LE")) 524 525 (pass-if-equal "with-input-from-file" 526 "€100" 527 (with-output-to-file filename 528 (lambda () 529 (write-line "test") 530 (write-line "; coding: ISO-8859-15") 531 (write-line "€100")) 532 #:encoding "ISO-8859-15") 533 (with-input-from-file filename 534 (lambda () 535 (read-line) 536 (read-line) 537 (read-line)) 538 #:guess-encoding #t 539 #:encoding "UTF-16LE"))) 540 541 (with-test-prefix "#:guess-encoding without coding declaration" 542 543 (pass-if-equal "open-file" 544 "€100" 545 (with-output-to-file filename 546 (lambda () (write-line "€100")) 547 #:encoding "ISO-8859-15") 548 (let* ((port (open-file filename "r" 549 #:guess-encoding #t 550 #:encoding "ISO-8859-15")) 551 (str (read-line port))) 552 (close-port port) 553 str)) 554 555 (pass-if-equal "open-input-file" 556 "€100" 557 (with-output-to-file filename 558 (lambda () (write-line "€100")) 559 #:encoding "ISO-8859-15") 560 (let* ((port (open-input-file filename 561 #:guess-encoding #t 562 #:encoding "ISO-8859-15")) 563 (str (read-line port))) 564 (close-port port) 565 str)) 566 567 (pass-if-equal "call-with-input-file" 568 "€100" 569 (with-output-to-file filename 570 (lambda () (write-line "€100")) 571 #:encoding "ISO-8859-15") 572 (call-with-input-file filename 573 read-line 574 #:guess-encoding #t 575 #:encoding "ISO-8859-15")) 576 577 (pass-if-equal "with-input-from-file" 578 "€100" 579 (with-output-to-file filename 580 (lambda () (write-line "€100")) 581 #:encoding "ISO-8859-15") 582 (with-input-from-file filename 583 read-line 584 #:guess-encoding #t 585 #:encoding "ISO-8859-15"))) 586 587 (delete-file filename)))) 588 589;;; ungetting characters and strings. 590(with-input-from-string "walk on the moon\nmoon" 591 (lambda () 592 (read-char) 593 (unread-char #\a (current-input-port)) 594 (pass-if "unread-char" 595 (char=? (read-char) #\a)) 596 (read-line) 597 (let ((replacenoid "chicken enchilada")) 598 (unread-char #\newline (current-input-port)) 599 (unread-string replacenoid (current-input-port)) 600 (pass-if "unread-string" 601 (string=? (read-line) replacenoid))) 602 (pass-if "unread residue" 603 (string=? (read-line) "moon")))) 604 605(pass-if-equal "close-port & revealed port" 606 EBADF 607 (let* ((port (open-file "/dev/null" "r0")) 608 (fdes (port->fdes port))) ;increments revealed count of PORT 609 (close-port port) ;closes FDES as a side-effect 610 (catch 'system-error 611 (lambda () 612 (seek fdes 0 SEEK_CUR) 613 #f) 614 (lambda args 615 (system-error-errno args))))) 616 617(pass-if "revealed port fdes not closed" 618 (let* ((port (open-file "/dev/null" "r0")) 619 (fdes (port->fdes port)) ;increments revealed count of PORT 620 (guardian (make-guardian))) 621 (guardian port) 622 (set! port #f) 623 (gc) 624 (if (port? (guardian)) 625 (and (zero? (seek fdes 0 SEEK_CUR)) 626 (begin 627 (close-fdes fdes) 628 #t)) 629 (begin 630 (close-fdes fdes) 631 (throw 'unresolved))))) 632 633(when (provided? 'threads) 634 (let* ((p (pipe)) 635 (r (car p)) 636 (w (cdr p))) 637 (fcntl r F_SETFL (logior (fcntl r F_GETFL) O_NONBLOCK)) 638 (let ((thread (call-with-new-thread 639 (lambda () 640 (usleep (* 250 1000)) 641 (write-char #\a w) 642 (force-output w))))) 643 (pass-if-equal "non-blocking-I/O" #\a (read-char r)) 644 (join-thread thread)))) 645 646 647;;;; Pipe (popen) ports. 648 649;;; Run a command, and read its output. 650(let* ((pipe (open-pipe "echo 'Howdy there, partner!'" "r")) 651 (in-string (read-all pipe))) 652 (close-pipe pipe) 653 (pass-if "pipe: read" 654 (equal? in-string "Howdy there, partner!\n"))) 655 656;;; Run a command, send some output to it, and see if it worked. 657(let* ((filename (test-file)) 658 (pipe (open-pipe (string-append "grep Mommy > " filename) "w"))) 659 (display "Now Jimmy lives on a mushroom cloud\n" pipe) 660 (display "Mommy, why does everybody have a bomb?\n" pipe) 661 (close-pipe pipe) 662 (let ((in-string (read-file filename))) 663 (pass-if "pipe: write" 664 (equal? in-string "Mommy, why does everybody have a bomb?\n"))) 665 (delete-file filename)) 666 667(pass-if-equal "pipe, fdopen, and line buffering" 668 "foo\nbar\n" 669 (unless (provided? 'fork) 670 (throw 'unresolved)) 671 (let ((in+out (pipe)) 672 (pid (primitive-fork))) 673 (if (zero? pid) 674 (dynamic-wind 675 (const #t) 676 (lambda () 677 (close-port (car in+out)) 678 (let ((port (cdr in+out))) 679 (setvbuf port 'line ) 680 ;; Strings containing '\n' or should be flushed; others 681 ;; should be kept in PORT's buffer. 682 (display "foo\n" port) 683 (display "bar\n" port) 684 (display "this will be kept in PORT's buffer" port))) 685 (lambda () 686 (primitive-_exit 0))) 687 (begin 688 (close-port (cdr in+out)) 689 (let ((str (read-all (car in+out)))) 690 (waitpid pid) 691 str))))) 692 693 694;;;; Void ports. These are so trivial we don't test them. 695 696 697;;;; String ports. 698 699(with-test-prefix "string ports" 700 701 ;; Write text to a string port. 702 (let* ((string "Howdy there, partner!") 703 (in-string (call-with-output-string 704 (lambda (port) 705 (display string port) 706 (newline port))))) 707 (pass-if "display text" 708 (equal? in-string (string-append string "\n")))) 709 710 ;; Write an s-expression to a string port. 711 (let* ((sexpr '("more utterly random text" 1729 #(a vector) 3.1415926)) 712 (in-sexpr 713 (call-with-input-string (call-with-output-string 714 (lambda (port) 715 (write sexpr port))) 716 read))) 717 (pass-if "write/read sexpr" 718 (equal? in-sexpr sexpr))) 719 720 ;; seeking and unreading from an input string. 721 (let ((text "that text didn't look random to me")) 722 (call-with-input-string text 723 (lambda (p) 724 (pass-if "input tell 0" 725 (= (seek p 0 SEEK_CUR) 0)) 726 (read-char p) 727 (pass-if "input tell 1" 728 (= (seek p 0 SEEK_CUR) 1)) 729 (unread-char #\x p) 730 (pass-if "input tell back to 0" 731 (= (seek p 0 SEEK_CUR) 0)) 732 (pass-if "input ungetted char" 733 (char=? (read-char p) #\x)) 734 (seek p 0 SEEK_END) 735 (pass-if "input seek to end" 736 (= (seek p 0 SEEK_CUR) 737 (string-length text))) 738 (unread-char #\x p) 739 (pass-if "input seek to beginning" 740 (= (seek p 0 SEEK_SET) 0)) 741 (pass-if "input reread first char" 742 (char=? (read-char p) 743 (string-ref text 0)))))) 744 745 ;; seeking an output string. 746 (let* ((text (string-copy "123456789")) 747 (len (string-length text)) 748 (result (call-with-output-string 749 (lambda (p) 750 (pass-if "output tell 0" 751 (= (seek p 0 SEEK_CUR) 0)) 752 (display text p) 753 (pass-if "output tell end" 754 (= (seek p 0 SEEK_CUR) len)) 755 (pass-if "output seek to beginning" 756 (= (seek p 0 SEEK_SET) 0)) 757 (write-char #\a p) 758 (seek p -1 SEEK_END) 759 (pass-if "output seek to last char" 760 (= (seek p 0 SEEK_CUR) 761 (- len 1))) 762 (write-char #\b p))))) 763 (string-set! text 0 #\a) 764 (string-set! text (- len 1) #\b) 765 (pass-if "output check" 766 (string=? text result))) 767 768 (pass-if-exception "truncating input string fails" 769 exception:wrong-type-arg 770 (call-with-input-string "hej" 771 (lambda (p) 772 (truncate-file p 0)))) 773 774 (pass-if-equal "truncating output string" "hej" 775 (call-with-output-string 776 (lambda (p) 777 (truncate-file p 0) 778 (display "hej" p)))) 779 780 (pass-if-exception "truncating output string before position" 781 exception:out-of-range 782 (call-with-output-string 783 (lambda (p) 784 (display "hej" p) 785 (truncate-file p 0)))) 786 787 (pass-if-equal "truncating output string at position" "hej" 788 (call-with-output-string 789 (lambda (p) 790 (display "hej" p) 791 (truncate-file p 3)))) 792 793 (pass-if-equal "truncating output string after seek" "" 794 (call-with-output-string 795 (lambda (p) 796 (display "hej" p) 797 (seek p 0 SEEK_SET) 798 (truncate-file p 0)))) 799 800 (pass-if-equal "truncating output string after seek to end" "hej" 801 (call-with-output-string 802 (lambda (p) 803 (display "hej" p) 804 (seek p 0 SEEK_SET) 805 (truncate-file p 3)))) 806 807 (pass-if "%default-port-encoding is ignored" 808 (let ((str "ĉu bone?")) 809 ;; Latin-1 cannot represent ‘ĉ’. 810 (with-fluids ((%default-port-encoding "ISO-8859-1")) 811 (string=? (call-with-output-string 812 (lambda (p) 813 (set-port-conversion-strategy! p 'substitute) 814 (display str p))) 815 "ĉu bone?")))) 816 817 (pass-if "%default-port-conversion-strategy is honored" 818 (let ((strategies '(error substitute escape))) 819 (equal? (map (lambda (s) 820 (with-fluids ((%default-port-conversion-strategy s)) 821 (call-with-output-string 822 (lambda (p) 823 (and (eq? s (port-conversion-strategy p)) 824 (begin 825 (set-port-conversion-strategy! p s) 826 (display (port-conversion-strategy p) 827 p))))))) 828 strategies) 829 (map symbol->string strategies)))) 830 831 (pass-if "suitable encoding [latin-1]" 832 (let ((str "hello, world") 833 (encoding "ISO-8859-1")) 834 (equal? str 835 (call-with-output-string 836 (lambda (p) 837 (set-port-encoding! p encoding) 838 (display str p)))))) 839 840 (pass-if "suitable encoding [latin-3]" 841 (let ((str "ĉu bone?") 842 (encoding "ISO-8859-3")) 843 (equal? str 844 (call-with-output-string 845 (lambda (p) 846 (set-port-encoding! p encoding) 847 (display str p)))))) 848 849 (pass-if "wrong encoding, error" 850 (let ((str "ĉu bone?")) 851 (catch 'encoding-error 852 (lambda () 853 (with-fluids ((%default-port-conversion-strategy 'error)) 854 (call-with-output-string 855 (lambda (p) 856 ;; Latin-1 cannot represent ‘ĉ’. 857 (set-port-encoding! p "ISO-8859-1") 858 (display str p)))) 859 #f) ; so the test really fails here 860 (lambda (key subr message errno port chr) 861 (and (eqv? chr #\ĉ) 862 (string? (strerror errno))))))) 863 864 (pass-if "wrong encoding, substitute" 865 (let ((str "ĉu bone?")) 866 (string=? (call-with-output-string 867 (lambda (p) 868 (set-port-encoding! p "ISO-8859-1") 869 (set-port-conversion-strategy! p 'substitute) 870 (display str p))) 871 "?u bone?"))) 872 873 (pass-if "wrong encoding, escape" 874 (let ((str "ĉu bone?")) 875 (string=? (call-with-output-string 876 (lambda (p) 877 (set-port-encoding! p "ISO-8859-1") 878 (set-port-conversion-strategy! p 'escape) 879 (display str p))) 880 "\\u0109u bone?"))) 881 882 (pass-if "peek-char" 883 (let ((p (open-input-string "안녕하세요"))) 884 (and (char=? (peek-char p) #\안) 885 (char=? (peek-char p) #\안) 886 (char=? (peek-char p) #\안) 887 (= (port-line p) 0) 888 (= (port-column p) 0)))) 889 890 ;; Mini DSL to test decoding error handling. 891 (letrec-syntax ((decoding-error? 892 (syntax-rules () 893 ((_ port proc) 894 (catch 'decoding-error 895 (lambda () 896 (pk 'proc (proc port)) 897 #f) 898 (lambda (key subr message errno p) 899 (define (skip-over-error) 900 (let ((strategy (port-conversion-strategy p))) 901 (set-port-conversion-strategy! p 'substitute) 902 ;; If `proc' is `read-char', this will 903 ;; skip over the bad bytes. 904 (let ((c (proc p))) 905 (unless (eqv? c #\xFFFD) 906 (error "unexpected char" c)) 907 (set-port-conversion-strategy! p strategy) 908 #t))) 909 (and (eq? p port) 910 (not (= 0 errno)) 911 (skip-over-error))))))) 912 (make-check 913 (syntax-rules (-> error eof) 914 ((_ port (proc -> error)) 915 (if (eq? 'substitute 916 (port-conversion-strategy port)) 917 (eqv? (proc port) #\xFFFD) 918 (decoding-error? port proc))) 919 ((_ port (proc -> eof)) 920 (eof-object? (proc port))) 921 ((_ port (proc -> char)) 922 (eqv? (proc port) char)))) 923 (make-checks 924 (syntax-rules () 925 ((_ port check ...) 926 (and (make-check port check) ...)))) 927 (make-peek+read-checks 928 (syntax-rules () 929 ((_ port (result ...) e1 expected ...) 930 (make-peek+read-checks port 931 (result ... 932 (peek-char -> e1) 933 (read-char -> e1)) 934 expected ...)) 935 ((_ port (result ...)) 936 (make-checks port result ...)) 937 ((_ port #f e1 expected ...) 938 (make-peek+read-checks port 939 ((peek-char -> e1) 940 (read-char -> e1)) 941 expected ...)))) 942 943 (test-decoding-error* 944 (syntax-rules () 945 ((_ sequence encoding strategy (expected ...)) 946 (begin 947 (pass-if (format #f "test-decoding-error: ~s ~s ~s" 948 'sequence encoding strategy) 949 (let ((p (open-bytevector-input-port 950 (u8-list->bytevector 'sequence)))) 951 (set-port-encoding! p encoding) 952 (set-port-conversion-strategy! p strategy) 953 (make-checks p 954 (read-char -> expected) ...))) 955 956 ;; Generate the same test, but with one 957 ;; `peek-char' call before each `read-char'. 958 ;; Both should yield the same result. 959 (pass-if (format #f "test-decoding-error: ~s ~s ~s + peek-char" 960 'sequence encoding strategy) 961 (let ((p (open-bytevector-input-port 962 (u8-list->bytevector 'sequence)))) 963 (set-port-encoding! p encoding) 964 (set-port-conversion-strategy! p strategy) 965 (make-peek+read-checks p #f expected 966 ...))))))) 967 (test-decoding-error 968 (syntax-rules () 969 ((_ sequence encoding (expected ...)) 970 (begin 971 (test-decoding-error* sequence encoding 'error 972 (expected ...)) 973 974 ;; `escape' should behave exactly like `error'. 975 (test-decoding-error* sequence encoding 'escape 976 (expected ...)) 977 978 (test-decoding-error* sequence encoding 'substitute 979 (expected ...))))))) 980 981 (test-decoding-error (255 65 66 67) "UTF-8" 982 (error #\A #\B #\C eof)) 983 984 (test-decoding-error (255 206 187 206 188) "UTF-8" 985 (error #\λ #\μ eof)) 986 987 (test-decoding-error (206 187 206) "UTF-8" 988 ;; Unterminated sequence. 989 (#\λ error eof)) 990 991 ;; Check how ill-formed UTF-8 sequences are handled (see Table 3-7 992 ;; of the "Conformance" chapter of Unicode 6.0.0.) 993 994 (test-decoding-error (#xc0 #x80 #x41) "UTF-8" 995 (error ;; C0: should be in the C2..DF range 996 error ;; 80: invalid 997 #\A 998 eof)) 999 1000 (test-decoding-error (#xc2 #x41 #x42) "UTF-8" 1001 ;; Section 3.9 of Unicode 6.0.0 reads: 1002 ;; "If the converter encounters an ill-formed UTF-8 code unit 1003 ;; sequence which starts with a valid first byte, but which does 1004 ;; not continue with valid successor bytes (see Table 3-7), it 1005 ;; must not consume the successor bytes". 1006 ;; Glibc/libiconv do not conform to it and instead swallow the 1007 ;; #x41. This example appears literally in Section 3.9. 1008 (error ;; 41: invalid successor 1009 #\A ;; 41: valid starting byte 1010 #\B 1011 eof)) 1012 1013 (test-decoding-error (#xf0 #x80 #x80 #x41) "UTF-8" 1014 ;; According to Unicode 6.0.0, Section 3.9, "the only formal 1015 ;; requirement mandated by Unicode conformance for a converter is 1016 ;; that the <41> be processed and correctly interpreted as 1017 ;; <U+0041>". 1018 (error ;; 2nd byte should be in the A0..BF range 1019 error ;; 80: not a valid starting byte 1020 error ;; 80: not a valid starting byte 1021 #\A 1022 eof)) 1023 1024 (test-decoding-error (#xe0 #xa0 #x41 #x42) "UTF-8" 1025 (error ;; 3rd byte should be in the 80..BF range 1026 #\A 1027 #\B 1028 eof)) 1029 1030 (test-decoding-error (#xf0 #x88 #x88 #x88) "UTF-8" 1031 (error ;; 2nd byte should be in the 90..BF range 1032 error ;; 88: not a valid starting byte 1033 error ;; 88: not a valid starting byte 1034 error ;; 88: not a valid starting byte 1035 eof)))) 1036 1037(with-test-prefix "call-with-output-string" 1038 1039 ;; In Guile 1.6.4, closing the port resulted in a segv, check that doesn't 1040 ;; occur. 1041 (pass-if-exception "proc closes port" exception:wrong-type-arg 1042 (call-with-output-string close-port))) 1043 1044 1045 1046;;;; Soft ports. No tests implemented yet. 1047 1048 1049;;;; Generic operations across all port types. 1050 1051(let ((port-loop-temp (test-file))) 1052 1053 ;; Return a list of input ports that all return the same text. 1054 ;; We map tests over this list. 1055 (define (input-port-list text) 1056 1057 ;; Create a text file some of the ports will use. 1058 (let ((out-port (open-output-file port-loop-temp))) 1059 (display text out-port) 1060 (close-port out-port)) 1061 1062 (list (open-input-file port-loop-temp) 1063 (open-input-pipe (string-append "cat " port-loop-temp)) 1064 (call-with-input-string text (lambda (x) x)) 1065 ;; We don't test soft ports at the moment. 1066 )) 1067 1068 (define port-list-names '("file" "pipe" "string")) 1069 1070 ;; Test the line counter. 1071 (define (test-line-counter text second-line final-column) 1072 (with-test-prefix "line counter" 1073 (let ((ports (input-port-list text))) 1074 (for-each 1075 (lambda (port port-name) 1076 (with-test-prefix port-name 1077 (pass-if "at beginning of input" 1078 (= (port-line port) 0)) 1079 (pass-if "read first character" 1080 (eqv? (read-char port) #\x)) 1081 (pass-if "after reading one character" 1082 (= (port-line port) 0)) 1083 (pass-if "read first newline" 1084 (eqv? (read-char port) #\newline)) 1085 (pass-if "after reading first newline char" 1086 (= (port-line port) 1)) 1087 (pass-if "second line read correctly" 1088 (equal? (read-line port) second-line)) 1089 (pass-if "read-line increments line number" 1090 (= (port-line port) 2)) 1091 (pass-if "read-line returns EOF" 1092 (let loop ((i 0)) 1093 (cond 1094 ((eof-object? (read-line port)) #t) 1095 ((> i 20) #f) 1096 (else (loop (+ i 1)))))) 1097 (pass-if "line count is 5 at EOF" 1098 (= (port-line port) 5)) 1099 (pass-if "column is correct at EOF" 1100 (= (port-column port) final-column)))) 1101 ports port-list-names) 1102 (for-each close-port ports) 1103 (delete-file port-loop-temp)))) 1104 1105 (with-test-prefix "newline" 1106 (test-line-counter 1107 (string-append "x\n" 1108 "He who receives an idea from me, receives instruction\n" 1109 "himself without lessening mine; as he who lights his\n" 1110 "taper at mine, receives light without darkening me.\n" 1111 " --- Thomas Jefferson\n") 1112 "He who receives an idea from me, receives instruction" 1113 0)) 1114 1115 (with-test-prefix "no newline" 1116 (test-line-counter 1117 (string-append "x\n" 1118 "He who receives an idea from me, receives instruction\n" 1119 "himself without lessening mine; as he who lights his\n" 1120 "taper at mine, receives light without darkening me.\n" 1121 " --- Thomas Jefferson\n" 1122 "no newline here") 1123 "He who receives an idea from me, receives instruction" 1124 15))) 1125 1126;; Test port-line and port-column for output ports 1127 1128(define (test-output-line-counter text final-column) 1129 (with-test-prefix "port-line and port-column for output ports" 1130 (let ((port (open-output-string))) 1131 (pass-if "at beginning of input" 1132 (and (= (port-line port) 0) 1133 (= (port-column port) 0))) 1134 (write-char #\x port) 1135 (pass-if "after writing one character" 1136 (and (= (port-line port) 0) 1137 (= (port-column port) 1))) 1138 (write-char #\newline port) 1139 (pass-if "after writing first newline char" 1140 (and (= (port-line port) 1) 1141 (= (port-column port) 0))) 1142 (display text port) 1143 (pass-if "line count is 5 at end" 1144 (= (port-line port) 5)) 1145 (pass-if "column is correct at end" 1146 (= (port-column port) final-column))))) 1147 1148(test-output-line-counter 1149 (string-append "He who receives an idea from me, receives instruction\n" 1150 "himself without lessening mine; as he who lights his\n" 1151 "taper at mine, receives light without darkening me.\n" 1152 " --- Thomas Jefferson\n" 1153 "no newline here") 1154 15) 1155 1156(with-test-prefix "port-column" 1157 1158 (with-test-prefix "output" 1159 1160 (pass-if "x" 1161 (let ((port (open-output-string))) 1162 (display "x" port) 1163 (= 1 (port-column port)))) 1164 1165 (pass-if "\\a" 1166 (let ((port (open-output-string))) 1167 (display "\a" port) 1168 (= 0 (port-column port)))) 1169 1170 (pass-if "x\\a" 1171 (let ((port (open-output-string))) 1172 (display "x\a" port) 1173 (= 1 (port-column port)))) 1174 1175 (pass-if "\\x08 backspace" 1176 (let ((port (open-output-string))) 1177 (display "\x08" port) 1178 (= 0 (port-column port)))) 1179 1180 (pass-if "x\\x08 backspace" 1181 (let ((port (open-output-string))) 1182 (display "x\x08" port) 1183 (= 0 (port-column port)))) 1184 1185 (pass-if "\\n" 1186 (let ((port (open-output-string))) 1187 (display "\n" port) 1188 (= 0 (port-column port)))) 1189 1190 (pass-if "x\\n" 1191 (let ((port (open-output-string))) 1192 (display "x\n" port) 1193 (= 0 (port-column port)))) 1194 1195 (pass-if "\\r" 1196 (let ((port (open-output-string))) 1197 (display "\r" port) 1198 (= 0 (port-column port)))) 1199 1200 (pass-if "x\\r" 1201 (let ((port (open-output-string))) 1202 (display "x\r" port) 1203 (= 0 (port-column port)))) 1204 1205 (pass-if "\\t" 1206 (let ((port (open-output-string))) 1207 (display "\t" port) 1208 (= 8 (port-column port)))) 1209 1210 (pass-if "x\\t" 1211 (let ((port (open-output-string))) 1212 (display "x\t" port) 1213 (= 8 (port-column port))))) 1214 1215 (with-test-prefix "input" 1216 1217 (pass-if "x" 1218 (let ((port (open-input-string "x"))) 1219 (while (not (eof-object? (read-char port)))) 1220 (= 1 (port-column port)))) 1221 1222 (pass-if "\\a" 1223 (let ((port (open-input-string "\a"))) 1224 (while (not (eof-object? (read-char port)))) 1225 (= 0 (port-column port)))) 1226 1227 (pass-if "x\\a" 1228 (let ((port (open-input-string "x\a"))) 1229 (while (not (eof-object? (read-char port)))) 1230 (= 1 (port-column port)))) 1231 1232 (pass-if "\\x08 backspace" 1233 (let ((port (open-input-string "\x08"))) 1234 (while (not (eof-object? (read-char port)))) 1235 (= 0 (port-column port)))) 1236 1237 (pass-if "x\\x08 backspace" 1238 (let ((port (open-input-string "x\x08"))) 1239 (while (not (eof-object? (read-char port)))) 1240 (= 0 (port-column port)))) 1241 1242 (pass-if "\\n" 1243 (let ((port (open-input-string "\n"))) 1244 (while (not (eof-object? (read-char port)))) 1245 (= 0 (port-column port)))) 1246 1247 (pass-if "x\\n" 1248 (let ((port (open-input-string "x\n"))) 1249 (while (not (eof-object? (read-char port)))) 1250 (= 0 (port-column port)))) 1251 1252 (pass-if "\\r" 1253 (let ((port (open-input-string "\r"))) 1254 (while (not (eof-object? (read-char port)))) 1255 (= 0 (port-column port)))) 1256 1257 (pass-if "x\\r" 1258 (let ((port (open-input-string "x\r"))) 1259 (while (not (eof-object? (read-char port)))) 1260 (= 0 (port-column port)))) 1261 1262 (pass-if "\\t" 1263 (let ((port (open-input-string "\t"))) 1264 (while (not (eof-object? (read-char port)))) 1265 (= 8 (port-column port)))) 1266 1267 (pass-if "x\\t" 1268 (let ((port (open-input-string "x\t"))) 1269 (while (not (eof-object? (read-char port)))) 1270 (= 8 (port-column port)))))) 1271 1272(with-test-prefix "port-line" 1273 1274 ;; in guile 1.8.1 and earlier port-line was truncated to an int, whereas 1275 ;; scm_t_port actually holds a long; this restricted the range on 64-bit 1276 ;; systems 1277 (pass-if "set most-positive-fixnum/2" 1278 (let ((n (quotient most-positive-fixnum 2)) 1279 (port (open-output-string))) 1280 (set-port-line! port n) 1281 (eqv? n (port-line port))))) 1282 1283(with-test-prefix "port-encoding" 1284 1285 (pass-if-exception "set-port-encoding!, wrong encoding" 1286 exception:miscellaneous-error 1287 (let ((p (open-input-string ""))) 1288 (set-port-encoding! p "does-not-exist") 1289 (read p))) 1290 1291 (let ((filename (test-file))) 1292 (with-output-to-file filename (lambda () (write 'test))) 1293 1294 (pass-if-exception "%default-port-encoding, wrong encoding" 1295 exception:miscellaneous-error 1296 (read (with-fluids ((%default-port-encoding "does-not-exist")) 1297 (open-input-file filename)))) 1298 1299 (delete-file filename))) 1300 1301;;; 1302;;; port-for-each 1303;;; 1304 1305(with-test-prefix "port-for-each" 1306 1307 ;; In guile 1.8.0 through 1.8.2, port-for-each could pass a freed cell to 1308 ;; its iterator func if a port was inaccessible in the last gc mark but 1309 ;; the lazy sweeping has not yet reached it to remove it from the port 1310 ;; table (scm_i_port_table). Provoking those gc conditions is a little 1311 ;; tricky, but the following code made it happen in 1.8.2. 1312 (pass-if "passing freed cell" 1313 (let ((lst '())) 1314 ;; clear out the heap 1315 (gc) (gc) (gc) 1316 ;; allocate cells so the opened ports aren't at the start of the heap 1317 (make-list 1000) 1318 (open-input-file "/dev/null") 1319 (make-list 1000) 1320 (open-input-file "/dev/null") 1321 ;; this gc leaves the above ports unmarked, ie. inaccessible 1322 (gc) 1323 ;; but they're still in the port table, so this sees them 1324 (port-for-each (lambda (port) 1325 (set! lst (cons port lst)))) 1326 ;; this forces completion of the sweeping 1327 (gc) (gc) (gc) 1328 ;; and (if the bug is present) the cells accumulated in LST are now 1329 ;; freed cells, which give #f from `port?' 1330 (not (memq #f (map port? lst)))))) 1331 1332(with-test-prefix 1333 "fdes->port" 1334 (pass-if "fdes->ports finds port" 1335 (let* ((port (open-file (test-file) "w")) 1336 (res (not (not (memq port (fdes->ports (port->fdes port))))))) 1337 (close-port port) 1338 res))) 1339 1340;;; 1341;;; seek 1342;;; 1343 1344(with-test-prefix "seek" 1345 1346 (with-test-prefix "file port" 1347 1348 (pass-if "SEEK_CUR" 1349 (call-with-output-file (test-file) 1350 (lambda (port) 1351 (display "abcde" port))) 1352 (let ((port (open-file (test-file) "r"))) 1353 (read-char port) 1354 (seek port 2 SEEK_CUR) 1355 (let ((res (eqv? #\d (read-char port)))) 1356 (close-port port) 1357 res))) 1358 1359 (pass-if "SEEK_SET" 1360 (call-with-output-file (test-file) 1361 (lambda (port) 1362 (display "abcde" port))) 1363 (let ((port (open-file (test-file) "r"))) 1364 (read-char port) 1365 (seek port 3 SEEK_SET) 1366 (let ((res (eqv? #\d (read-char port)))) 1367 (close-port port) 1368 res))) 1369 1370 (pass-if "SEEK_END" 1371 (call-with-output-file (test-file) 1372 (lambda (port) 1373 (display "abcde" port))) 1374 (let ((port (open-file (test-file) "r"))) 1375 (read-char port) 1376 (seek port -2 SEEK_END) 1377 (let ((res (eqv? #\d (read-char port)))) 1378 (close-port port) 1379 res))))) 1380 1381;;; 1382;;; truncate-file 1383;;; 1384 1385(with-test-prefix "truncate-file" 1386 1387 (pass-if-exception "flonum file" exception:wrong-type-arg 1388 (truncate-file 1.0 123)) 1389 1390 (pass-if-exception "frac file" exception:wrong-type-arg 1391 (truncate-file 7/3 123)) 1392 1393 (with-test-prefix "filename" 1394 1395 (pass-if-exception "flonum length" exception:wrong-type-arg 1396 (call-with-output-file (test-file) 1397 (lambda (port) 1398 (display "hello" port))) 1399 (truncate-file (test-file) 1.0)) 1400 1401 (pass-if "shorten" 1402 (call-with-output-file (test-file) 1403 (lambda (port) 1404 (display "hello" port))) 1405 (truncate-file (test-file) 1) 1406 (eqv? 1 (stat:size (stat (test-file))))) 1407 1408 (pass-if-exception "shorten to current pos" exception:miscellaneous-error 1409 (call-with-output-file (test-file) 1410 (lambda (port) 1411 (display "hello" port))) 1412 (truncate-file (test-file)))) 1413 1414 (with-test-prefix "file descriptor" 1415 1416 (pass-if "shorten" 1417 (call-with-output-file (test-file) 1418 (lambda (port) 1419 (display "hello" port))) 1420 (let ((fd (open-fdes (test-file) O_RDWR))) 1421 (truncate-file fd 1) 1422 (close-fdes fd)) 1423 (eqv? 1 (stat:size (stat (test-file))))) 1424 1425 (pass-if "shorten to current pos" 1426 (call-with-output-file (test-file) 1427 (lambda (port) 1428 (display "hello" port))) 1429 (let ((fd (open-fdes (test-file) O_RDWR))) 1430 (seek fd 1 SEEK_SET) 1431 (truncate-file fd) 1432 (close-fdes fd)) 1433 (eqv? 1 (stat:size (stat (test-file)))))) 1434 1435 (with-test-prefix "file port" 1436 1437 (pass-if "shorten" 1438 (call-with-output-file (test-file) 1439 (lambda (port) 1440 (display "hello" port))) 1441 (let ((port (open-file (test-file) "r+"))) 1442 (truncate-file port 1) 1443 (close-port port)) 1444 (eqv? 1 (stat:size (stat (test-file))))) 1445 1446 (pass-if "shorten to current pos" 1447 (call-with-output-file (test-file) 1448 (lambda (port) 1449 (display "hello" port))) 1450 (let ((port (open-file (test-file) "r+"))) 1451 (read-char port) 1452 (truncate-file port) 1453 (close-port port)) 1454 (eqv? 1 (stat:size (stat (test-file))))))) 1455 1456 1457;;;; testing read-delimited and friends 1458 1459(with-test-prefix "read-delimited!" 1460 (let ((c (make-string 20 #\!))) 1461 (call-with-input-string 1462 "defdef\nghighi\n" 1463 (lambda (port) 1464 1465 (read-delimited! "\n" c port 'concat) 1466 (pass-if "read-delimited! reads a first line" 1467 (string=? c "defdef\n!!!!!!!!!!!!!")) 1468 1469 (read-delimited! "\n" c port 'concat 3) 1470 (pass-if "read-delimited! reads a first line" 1471 (string=? c "defghighi\n!!!!!!!!!!")))))) 1472 1473 1474;;;; char-ready? 1475 1476(call-with-input-string 1477 "howdy" 1478 (lambda (port) 1479 (pass-if "char-ready? returns true on string port" 1480 (char-ready? port)))) 1481 1482;;; This segfaults on some versions of Guile. We really should run 1483;;; the tests in a subprocess... 1484 1485(call-with-input-string 1486 "howdy" 1487 (lambda (port) 1488 (with-input-from-port 1489 port 1490 (lambda () 1491 (pass-if "char-ready? returns true on string port as default port" 1492 (char-ready?)))))) 1493 1494 1495;;;; pending-eof behavior 1496 1497(with-test-prefix "pending EOF behavior" 1498 ;; Make a test port that will produce the given sequence. Each 1499 ;; element of 'lst' may be either a character or #f (which means EOF). 1500 (define (test-soft-port . lst) 1501 (make-soft-port 1502 (vector (lambda (c) #f) ; write char 1503 (lambda (s) #f) ; write string 1504 (lambda () #f) ; flush 1505 (lambda () ; read char 1506 (let ((c (car lst))) 1507 (set! lst (cdr lst)) 1508 c)) 1509 (lambda () #f)) ; close 1510 "rw")) 1511 1512 (define (call-with-port p proc) 1513 (dynamic-wind 1514 (lambda () #f) 1515 (lambda () (proc p)) 1516 (lambda () (close-port p)))) 1517 1518 (define (call-with-test-file str proc) 1519 (let ((filename (test-file))) 1520 (dynamic-wind 1521 (lambda () (call-with-output-file filename 1522 (lambda (p) (display str p)))) 1523 (lambda () (call-with-input-file filename proc)) 1524 (lambda () (delete-file (test-file)))))) 1525 1526 (pass-if "peek-char does not swallow EOF (soft port)" 1527 (call-with-port (test-soft-port #\a #f #\b) 1528 (lambda (p) 1529 (and (char=? #\a (peek-char p)) 1530 (char=? #\a (read-char p)) 1531 (eof-object? (peek-char p)) 1532 (eof-object? (read-char p)) 1533 (char=? #\b (peek-char p)) 1534 (char=? #\b (read-char p)))))) 1535 1536 (pass-if "unread clears pending EOF (soft port)" 1537 (call-with-port (test-soft-port #\a #f #\b) 1538 (lambda (p) 1539 (and (char=? #\a (read-char p)) 1540 (eof-object? (peek-char p)) 1541 (begin (unread-char #\u p) 1542 (char=? #\u (read-char p))))))) 1543 1544 (pass-if "unread clears pending EOF (string port)" 1545 (call-with-input-string "a" 1546 (lambda (p) 1547 (and (char=? #\a (read-char p)) 1548 (eof-object? (peek-char p)) 1549 (begin (unread-char #\u p) 1550 (char=? #\u (read-char p))))))) 1551 1552 (pass-if "unread clears pending EOF (file port)" 1553 (call-with-test-file 1554 "a" 1555 (lambda (p) 1556 (and (char=? #\a (read-char p)) 1557 (eof-object? (peek-char p)) 1558 (begin (unread-char #\u p) 1559 (char=? #\u (read-char p))))))) 1560 1561 (pass-if "seek clears pending EOF (string port)" 1562 (call-with-input-string "a" 1563 (lambda (p) 1564 (and (char=? #\a (read-char p)) 1565 (eof-object? (peek-char p)) 1566 (begin (seek p 0 SEEK_SET) 1567 (char=? #\a (read-char p))))))) 1568 1569 (pass-if "seek clears pending EOF (file port)" 1570 (call-with-test-file 1571 "a" 1572 (lambda (p) 1573 (and (char=? #\a (read-char p)) 1574 (eof-object? (peek-char p)) 1575 (begin (seek p 0 SEEK_SET) 1576 (char=? #\a (read-char p)))))))) 1577 1578 1579;;;; Close current-input-port, and make sure everyone can handle it. 1580 1581(with-test-prefix "closing current-input-port" 1582 (for-each (lambda (procedure name) 1583 (with-input-from-port 1584 (call-with-input-string "foo" (lambda (p) p)) 1585 (lambda () 1586 (close-port (current-input-port)) 1587 (pass-if-exception name 1588 exception:wrong-type-arg 1589 (procedure))))) 1590 (list read read-char read-line) 1591 '("read" "read-char" "read-line"))) 1592 1593 1594 1595(with-test-prefix "setvbuf" 1596 1597 (pass-if-exception "closed port" 1598 exception:wrong-type-arg 1599 (let ((port (open-input-file "/dev/null"))) 1600 (close-port port) 1601 (setvbuf port 'block))) 1602 1603 (pass-if-exception "string port" 1604 exception:wrong-type-arg 1605 (let ((port (open-input-string "Hey!"))) 1606 (close-port port) 1607 (setvbuf port 'block))) 1608 1609 (pass-if "line/column number preserved" 1610 ;; In Guile 2.0.5, `setvbuf' would erroneously decrease the port's 1611 ;; line and/or column number. 1612 (call-with-output-file (test-file) 1613 (lambda (p) 1614 (display "This is GNU Guile.\nWelcome." p))) 1615 (call-with-input-file (test-file) 1616 (lambda (p) 1617 (and (eqv? #\T (read-char p)) 1618 (let ((line (port-line p)) 1619 (col (port-column p))) 1620 (and (= line 0) (= col 1) 1621 (begin 1622 (setvbuf p 'block 777) 1623 (let ((line* (port-line p)) 1624 (col* (port-column p))) 1625 (and (= line line*) 1626 (= col col*))))))))))) 1627 1628 1629 1630(pass-if-equal "unget-bytevector" 1631 #vu8(10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 200 201 202 203 1632 1 2 3 4 251 253 254 255) 1633 (let ((port (open-bytevector-input-port #vu8(1 2 3 4 251 253 254 255)))) 1634 (unget-bytevector port #vu8(200 201 202 203)) 1635 (unget-bytevector port #vu8(20 21 22 23 24)) 1636 (unget-bytevector port #vu8(10 11 12 13 14 15 16 17 18 19) 4) 1637 (unget-bytevector port #vu8(10 11 12 13 14 15 16 17 18 19) 2 2) 1638 (unget-bytevector port #vu8(10 11)) 1639 (get-bytevector-all port))) 1640 1641 1642 1643(with-test-prefix "unicode byte-order marks (BOMs)" 1644 1645 (define (bv-read-test* encoding bv proc) 1646 (let ((port (open-bytevector-input-port bv))) 1647 (set-port-encoding! port encoding) 1648 (proc port))) 1649 1650 (define (bv-read-test encoding bv) 1651 (bv-read-test* encoding bv read-string)) 1652 1653 (define (bv-write-test* encoding proc) 1654 (call-with-values 1655 (lambda () (open-bytevector-output-port)) 1656 (lambda (port get-bytevector) 1657 (set-port-encoding! port encoding) 1658 (proc port) 1659 (get-bytevector)))) 1660 1661 (define (bv-write-test encoding str) 1662 (bv-write-test* encoding 1663 (lambda (p) 1664 (display str p)))) 1665 1666 (pass-if-equal "BOM not discarded from Latin-1 stream" 1667 "\xEF\xBB\xBF\x61" 1668 (bv-read-test "ISO-8859-1" #vu8(#xEF #xBB #xBF #x61))) 1669 1670 (pass-if-equal "BOM not discarded from Latin-2 stream" 1671 "\u010F\u0165\u017C\x61" 1672 (bv-read-test "ISO-8859-2" #vu8(#xEF #xBB #xBF #x61))) 1673 1674 (pass-if-equal "BOM not discarded from UTF-16BE stream" 1675 "\uFEFF\x61" 1676 (bv-read-test "UTF-16BE" #vu8(#xFE #xFF #x00 #x61))) 1677 1678 (pass-if-equal "BOM not discarded from UTF-16LE stream" 1679 "\uFEFF\x61" 1680 (bv-read-test "UTF-16LE" #vu8(#xFF #xFE #x61 #x00))) 1681 1682 (pass-if-equal "BOM not discarded from UTF-32BE stream" 1683 "\uFEFF\x61" 1684 (bv-read-test "UTF-32BE" #vu8(#x00 #x00 #xFE #xFF 1685 #x00 #x00 #x00 #x61))) 1686 1687 (pass-if-equal "BOM not discarded from UTF-32LE stream" 1688 "\uFEFF\x61" 1689 (bv-read-test "UTF-32LE" #vu8(#xFF #xFE #x00 #x00 1690 #x61 #x00 #x00 #x00))) 1691 1692 (pass-if-equal "BOM not written to UTF-8 stream" 1693 #vu8(#x61) 1694 (bv-write-test "UTF-8" "a")) 1695 1696 (pass-if-equal "BOM not written to UTF-16BE stream" 1697 #vu8(#x00 #x61) 1698 (bv-write-test "UTF-16BE" "a")) 1699 1700 (pass-if-equal "BOM not written to UTF-16LE stream" 1701 #vu8(#x61 #x00) 1702 (bv-write-test "UTF-16LE" "a")) 1703 1704 (pass-if-equal "BOM not written to UTF-32BE stream" 1705 #vu8(#x00 #x00 #x00 #x61) 1706 (bv-write-test "UTF-32BE" "a")) 1707 1708 (pass-if-equal "BOM not written to UTF-32LE stream" 1709 #vu8(#x61 #x00 #x00 #x00) 1710 (bv-write-test "UTF-32LE" "a")) 1711 1712 (pass-if "Don't read from the port unless user asks to" 1713 (let* ((p (make-soft-port 1714 (vector 1715 (lambda (c) #f) ; write char 1716 (lambda (s) #f) ; write string 1717 (lambda () #f) ; flush 1718 (lambda () (throw 'fail)) ; read char 1719 (lambda () #f)) 1720 "rw"))) 1721 (set-port-encoding! p "UTF-16") 1722 (display "abc" p) 1723 (set-port-encoding! p "UTF-32") 1724 (display "def" p) 1725 #t)) 1726 1727 ;; TODO: test that input and output streams are independent when 1728 ;; appropriate, and linked when appropriate. 1729 1730 (pass-if-equal "BOM discarded from start of UTF-8 stream" 1731 "a" 1732 (bv-read-test "Utf-8" #vu8(#xEF #xBB #xBF #x61))) 1733 1734 (pass-if-equal "BOM discarded from start of UTF-8 stream after seek to 0" 1735 '(#\a "a") 1736 (bv-read-test* "uTf-8" #vu8(#xEF #xBB #xBF #x61) 1737 (lambda (p) 1738 (let ((c (read-char p))) 1739 (seek p 0 SEEK_SET) 1740 (let ((s (read-string p))) 1741 (list c s)))))) 1742 1743 (pass-if-equal "Only one BOM discarded from start of UTF-8 stream" 1744 "\uFEFFa" 1745 (bv-read-test "UTF-8" #vu8(#xEF #xBB #xBF #xEF #xBB #xBF #x61))) 1746 1747 (pass-if-equal "BOM not discarded from UTF-8 stream after seek to > 0" 1748 "\uFEFFb" 1749 (bv-read-test* "UTF-8" #vu8(#x61 #xEF #xBB #xBF #x62) 1750 (lambda (p) 1751 (seek p 1 SEEK_SET) 1752 (read-string p)))) 1753 1754 (pass-if-equal "BOM not discarded unless at start of UTF-8 stream" 1755 "a\uFEFFb" 1756 (bv-read-test "UTF-8" #vu8(#x61 #xEF #xBB #xBF #x62))) 1757 1758 (pass-if-equal "BOM (BE) written to start of UTF-16 stream" 1759 #vu8(#xFE #xFF #x00 #x61 #x00 #x62) 1760 (bv-write-test "UTF-16" "ab")) 1761 1762 (pass-if-equal "BOM (BE) written to UTF-16 stream after set-port-encoding!" 1763 #vu8(#xFE #xFF #x00 #x61 #x00 #x62 #xFE #xFF #x00 #x63 #x00 #x64) 1764 (bv-write-test* "UTF-16" 1765 (lambda (p) 1766 (display "ab" p) 1767 (set-port-encoding! p "UTF-16") 1768 (display "cd" p)))) 1769 1770 (pass-if-equal "BOM discarded from start of UTF-16 stream (BE)" 1771 "a" 1772 (bv-read-test "UTF-16" #vu8(#xFE #xFF #x00 #x61))) 1773 1774 (pass-if-equal "BOM discarded from start of UTF-16 stream (BE) after seek to 0" 1775 '(#\a "a") 1776 (bv-read-test* "utf-16" #vu8(#xFE #xFF #x00 #x61) 1777 (lambda (p) 1778 (let ((c (read-char p))) 1779 (seek p 0 SEEK_SET) 1780 (let ((s (read-string p))) 1781 (list c s)))))) 1782 1783 (pass-if-equal "Only one BOM discarded from start of UTF-16 stream (BE)" 1784 "\uFEFFa" 1785 (bv-read-test "Utf-16" #vu8(#xFE #xFF #xFE #xFF #x00 #x61))) 1786 1787 (pass-if-equal "BOM not discarded from UTF-16 stream (BE) after seek to > 0" 1788 "\uFEFFa" 1789 (bv-read-test* "uTf-16" #vu8(#xFE #xFF #xFE #xFF #x00 #x61) 1790 (lambda (p) 1791 (seek p 2 SEEK_SET) 1792 (read-string p)))) 1793 1794 (pass-if-equal "BOM not discarded unless at start of UTF-16 stream" 1795 "a\uFEFFb" 1796 (bv-read-test "utf-16" #vu8(#x00 #x61 #xFE #xFF #x00 #x62))) 1797 1798 (pass-if-equal "BOM discarded from start of UTF-16 stream (LE)" 1799 "a" 1800 (bv-read-test "UTF-16" #vu8(#xFF #xFE #x61 #x00))) 1801 1802 (pass-if-equal "BOM discarded from start of UTF-16 stream (LE) after seek to 0" 1803 '(#\a "a") 1804 (bv-read-test* "Utf-16" #vu8(#xFF #xFE #x61 #x00) 1805 (lambda (p) 1806 (let ((c (read-char p))) 1807 (seek p 0 SEEK_SET) 1808 (let ((s (read-string p))) 1809 (list c s)))))) 1810 1811 (pass-if-equal "Only one BOM discarded from start of UTF-16 stream (LE)" 1812 "\uFEFFa" 1813 (bv-read-test "UTf-16" #vu8(#xFF #xFE #xFF #xFE #x61 #x00))) 1814 1815 (pass-if-equal "BOM discarded from start of UTF-32 stream (BE)" 1816 "a" 1817 (bv-read-test "UTF-32" #vu8(#x00 #x00 #xFE #xFF 1818 #x00 #x00 #x00 #x61))) 1819 1820 (pass-if-equal "BOM discarded from start of UTF-32 stream (BE) after seek to 0" 1821 '(#\a "a") 1822 (bv-read-test* "utF-32" #vu8(#x00 #x00 #xFE #xFF 1823 #x00 #x00 #x00 #x61) 1824 (lambda (p) 1825 (let ((c (read-char p))) 1826 (seek p 0 SEEK_SET) 1827 (let ((s (read-string p))) 1828 (list c s)))))) 1829 1830 (pass-if-equal "Only one BOM discarded from start of UTF-32 stream (BE)" 1831 "\uFEFFa" 1832 (bv-read-test "UTF-32" #vu8(#x00 #x00 #xFE #xFF 1833 #x00 #x00 #xFE #xFF 1834 #x00 #x00 #x00 #x61))) 1835 1836 (pass-if-equal "BOM not discarded from UTF-32 stream (BE) after seek to > 0" 1837 "\uFEFFa" 1838 (bv-read-test* "UtF-32" #vu8(#x00 #x00 #xFE #xFF 1839 #x00 #x00 #xFE #xFF 1840 #x00 #x00 #x00 #x61) 1841 (lambda (p) 1842 (seek p 4 SEEK_SET) 1843 (read-string p)))) 1844 1845 (pass-if-equal "BOM discarded within UTF-16 stream (BE) after set-port-encoding!" 1846 "ab" 1847 (bv-read-test* "UTF-16" #vu8(#x00 #x61 #xFE #xFF #x00 #x62) 1848 (lambda (p) 1849 (let ((a (read-char p))) 1850 (set-port-encoding! p "UTF-16") 1851 (string a (read-char p)))))) 1852 1853 (pass-if-equal "BOM discarded within UTF-16 stream (LE,BE) after set-port-encoding!" 1854 "ab" 1855 (bv-read-test* "utf-16" #vu8(#x00 #x61 #xFF #xFE #x62 #x00) 1856 (lambda (p) 1857 (let ((a (read-char p))) 1858 (set-port-encoding! p "UTF-16") 1859 (string a (read-char p)))))) 1860 1861 (pass-if-equal "BOM discarded within UTF-32 stream (BE) after set-port-encoding!" 1862 "ab" 1863 (bv-read-test* "UTF-32" #vu8(#x00 #x00 #x00 #x61 1864 #x00 #x00 #xFE #xFF 1865 #x00 #x00 #x00 #x62) 1866 (lambda (p) 1867 (let ((a (read-char p))) 1868 (set-port-encoding! p "UTF-32") 1869 (string a (read-char p)))))) 1870 1871 (pass-if-equal "BOM discarded within UTF-32 stream (LE,BE) after set-port-encoding!" 1872 "ab" 1873 (bv-read-test* "UTF-32" #vu8(#x00 #x00 #x00 #x61 1874 #xFF #xFE #x00 #x00 1875 #x62 #x00 #x00 #x00) 1876 (lambda (p) 1877 (let ((a (read-char p))) 1878 (set-port-encoding! p "UTF-32") 1879 (string a (read-char p)))))) 1880 1881 (pass-if-equal "BOM not discarded unless at start of UTF-32 stream" 1882 "a\uFEFFb" 1883 (bv-read-test "UTF-32" #vu8(#x00 #x00 #x00 #x61 1884 #x00 #x00 #xFE #xFF 1885 #x00 #x00 #x00 #x62))) 1886 1887 (pass-if-equal "BOM discarded from start of UTF-32 stream (LE)" 1888 "a" 1889 (bv-read-test "UTF-32" #vu8(#xFF #xFE #x00 #x00 1890 #x61 #x00 #x00 #x00))) 1891 1892 (pass-if-equal "BOM discarded from start of UTF-32 stream (LE) after seek to 0" 1893 '(#\a "a") 1894 (bv-read-test* "UTf-32" #vu8(#xFF #xFE #x00 #x00 1895 #x61 #x00 #x00 #x00) 1896 (lambda (p) 1897 (let ((c (read-char p))) 1898 (seek p 0 SEEK_SET) 1899 (let ((s (read-string p))) 1900 (list c s)))))) 1901 1902 (pass-if-equal "Only one BOM discarded from start of UTF-32 stream (LE)" 1903 "\uFEFFa" 1904 (bv-read-test "UTF-32" #vu8(#xFF #xFE #x00 #x00 1905 #xFF #xFE #x00 #x00 1906 #x61 #x00 #x00 #x00)))) 1907 1908 1909 1910(define-syntax-rule (with-load-path path body ...) 1911 (let ((new path) 1912 (old %load-path)) 1913 (dynamic-wind 1914 (lambda () 1915 (set! %load-path new)) 1916 (lambda () 1917 body ...) 1918 (lambda () 1919 (set! %load-path old))))) 1920 1921(define %temporary-directory 1922 (string-append (or (getenv "TMPDIR") "/tmp") "/guile-ports-test." 1923 (number->string (getpid)))) 1924 1925(with-test-prefix "%file-port-name-canonicalization" 1926 1927 (pass-if-equal "absolute file name & empty %load-path entry" "/dev/null" 1928 ;; In Guile 2.0.5 and earlier, this would return "dev/null" instead 1929 ;; of "/dev/null". See 1930 ;; <http://lists.gnu.org/archive/html/guile-devel/2012-05/msg00059.html> 1931 ;; for a discussion. 1932 (with-load-path (cons "" (delete "/" %load-path)) 1933 (with-fluids ((%file-port-name-canonicalization 'relative)) 1934 (port-filename (open-input-file "/dev/null"))))) 1935 1936 (pass-if-equal "relative canonicalization with /" "dev/null" 1937 (with-load-path (cons "/" %load-path) 1938 (with-fluids ((%file-port-name-canonicalization 'relative)) 1939 (port-filename (open-input-file "/dev/null"))))) 1940 1941 (pass-if-equal "relative canonicalization with /dev/.." "dev/null" 1942 (with-load-path (cons "/dev/.." %load-path) 1943 (with-fluids ((%file-port-name-canonicalization 'relative)) 1944 (port-filename (open-input-file "/dev/null"))))) 1945 1946 (pass-if-equal "relative canonicalization from ice-9" "ice-9/q.scm" 1947 (with-fluids ((%file-port-name-canonicalization 'relative)) 1948 (port-filename 1949 (open-input-file (%search-load-path "ice-9/q.scm"))))) 1950 1951 (pass-if-equal "relative canonicalization with common prefixes" 1952 "x.scm" 1953 1954 ;; In Guile up to 2.2.2, this would return "wrong/x.scm'. 1955 (let* ((dir1 (string-append %temporary-directory "/something")) 1956 (dir2 (string-append dir1 "-wrong"))) 1957 (with-load-path (append (list dir1 dir2) %load-path) 1958 (dynamic-wind 1959 (lambda () 1960 (mkdir %temporary-directory) 1961 (mkdir dir1) 1962 (mkdir dir2) 1963 (call-with-output-file (string-append dir2 "/x.scm") 1964 (const #t))) 1965 (lambda () 1966 (with-fluids ((%file-port-name-canonicalization 'relative)) 1967 (port-filename 1968 (open-input-file (string-append dir2 "/x.scm"))))) 1969 (lambda () 1970 (delete-file (string-append dir2 "/x.scm")) 1971 (rmdir dir2) 1972 (rmdir dir1) 1973 (rmdir %temporary-directory)))))) 1974 1975 (pass-if-equal "absolute canonicalization from ice-9" 1976 (canonicalize-path 1977 (string-append (assoc-ref %guile-build-info 'top_srcdir) 1978 "/module/ice-9/q.scm")) 1979 (with-fluids ((%file-port-name-canonicalization 'absolute)) 1980 (port-filename (open-input-file (%search-load-path "ice-9/q.scm")))))) 1981 1982(with-test-prefix "file name separators" 1983 1984 (pass-if "no backslash separators in Windows file names" 1985 ;; In Guile 2.0.11 and earlier, %load-path on Windows could 1986 ;; include file names with backslashes, and `getcwd' on Windows 1987 ;; would always return a directory name with backslashes. 1988 (or (not (file-name-separator? #\\)) 1989 (with-load-path (cons (getcwd) %load-path) 1990 (not (string-index (%search-load-path (basename (test-file))) 1991 #\\)))))) 1992 1993(delete-file (test-file)) 1994 1995;;; Local Variables: 1996;;; eval: (put 'test-decoding-error 'scheme-indent-function 3) 1997;;; eval: (put 'with-load-path 'scheme-indent-function 1) 1998;;; End: 1999