mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-22 03:30:22 +02:00
Code Activity

Add keyword arguments to file opening procedures.

Browse source 
* libguile/fports.c (scm_open_file_with_encoding): New API function,
  containing the code previously found in 'scm_open_file', but modified
  to accept the new 'guess_encoding' and 'encoding' arguments.

  (scm_open_file): Now just a simple wrapper that calls
  'scm_open_file_with_encoding'.

  (scm_i_open_file): New implementation of 'open-file' that accepts
  keyword arguments '#:guess-encoding' and '#:encoding', and calls
  'scm_open_file_with_encoding'.

  (scm_init_fports_keywords): New initialization function that gets
  called after keywords are initialized.

* libguile/fports.h (scm_open_file_with_encoding,
  scm_init_fports_keywords): Add prototypes.

* libguile/init.c (scm_i_init_guile): Call 'scm_init_fports_keywords'.

* module/ice-9/boot-9.scm: Add enhanced versions of 'open-input-file',
  'open-output-file', 'call-with-input-file', 'call-with-output-file',
  'with-input-from-file', 'with-output-to-file', and
  'with-error-to-file', that accept keyword arguments '#:binary',
  '#:encoding', and (for input port constructors) '#:guess-encoding'.

* doc/ref/api-io.texi (File Ports): Update documentation.

* test-suite/tests/ports.test ("keyword arguments for file openers"):
  Add tests.
This commit is contained in:
Mark H Weaver 2013-04-06 23:19:55 -04:00
parent b6e374e535
commit 3ace9a8e4e
6 changed files with 581 additions and 70 deletions
Download patch file Download diff file Expand all files Collapse all files

285
test-suite/tests/ports.test
View file

@ -274,8 +274,8 @@
(delete-file filename)
(string=? line2 binary-test-string)))))
;; open-file ignores file coding declaration
(pass-if "file: open-file ignores coding declarations"
;; open-file ignores file coding declaration by default
(pass-if "file: open-file ignores coding declaration by default"
(with-fluids ((%default-port-encoding "UTF-8"))
(let* ((filename (test-file))
(port (open-output-file filename))
@ -290,6 +290,287 @@
(delete-file filename)
(string=? line2 test-string)))))
;; open-input-file with guess-encoding honors coding declaration
(pass-if "file: open-input-file with guess-encoding honors coding declaration"
(with-fluids ((%default-port-encoding "UTF-8"))
(let* ((filename (test-file))
(port (open-output-file filename))
(test-string "€100"))
(set-port-encoding! port "iso-8859-15")
(write-line ";; coding: iso-8859-15" port)
(write-line test-string port)
(close-port port)
(let* ((in-port (open-input-file filename
#:guess-encoding #t))
(line1 (read-line in-port))
(line2 (read-line in-port)))
(close-port in-port)
(delete-file filename)
(string=? line2 test-string)))))
(with-test-prefix "keyword arguments for file openers"
(with-fluids ((%default-port-encoding "UTF-8"))
(let ((filename (test-file)))
(with-test-prefix "write #:encoding"
(pass-if-equal "open-file"
#vu8(116 0 101 0 115 0 116 0)
(let ((port (open-file filename "w"
#:encoding "UTF-16LE")))
(display "test" port)
(close-port port))
(let* ((port (open-file filename "rb"))
(bv (get-bytevector-all port)))
(close-port port)
bv))
(pass-if-equal "open-output-file"
#vu8(116 0 101 0 115 0 116 0)
(let ((port (open-output-file filename
#:encoding "UTF-16LE")))
(display "test" port)
(close-port port))
(let* ((port (open-file filename "rb"))
(bv (get-bytevector-all port)))
(close-port port)
bv))
(pass-if-equal "call-with-output-file"
#vu8(116 0 101 0 115 0 116 0)
(call-with-output-file filename
(lambda (port)
(display "test" port))
#:encoding "UTF-16LE")
(let* ((port (open-file filename "rb"))
(bv (get-bytevector-all port)))
(close-port port)
bv))
(pass-if-equal "with-output-to-file"
#vu8(116 0 101 0 115 0 116 0)
(with-output-to-file filename
(lambda ()
(display "test"))
#:encoding "UTF-16LE")
(let* ((port (open-file filename "rb"))
(bv (get-bytevector-all port)))
(close-port port)
bv))
(pass-if-equal "with-error-to-file"
#vu8(116 0 101 0 115 0 116 0)
(with-error-to-file
filename
(lambda ()
(display "test" (current-error-port)))
#:encoding "UTF-16LE")
(let* ((port (open-file filename "rb"))
(bv (get-bytevector-all port)))
(close-port port)
bv)))
(with-test-prefix "write #:binary"
(pass-if-equal "open-output-file"
"ISO-8859-1"
(let* ((port (open-output-file filename #:binary #t))
(enc (port-encoding port)))
(close-port port)
enc))
(pass-if-equal "call-with-output-file"
"ISO-8859-1"
(call-with-output-file filename port-encoding #:binary #t))
(pass-if-equal "with-output-to-file"
"ISO-8859-1"
(with-output-to-file filename
(lambda () (port-encoding (current-output-port)))
#:binary #t))
(pass-if-equal "with-error-to-file"
"ISO-8859-1"
(with-error-to-file
filename
(lambda () (port-encoding (current-error-port)))
#:binary #t)))
(with-test-prefix "read #:encoding"
(pass-if-equal "open-file read #:encoding"
"test"
(call-with-output-file filename
(lambda (port)
(put-bytevector port #vu8(116 0 101 0 115 0 116 0))))
(let* ((port (open-file filename "r" #:encoding "UTF-16LE"))
(str (read-string port)))
(close-port port)
str))
(pass-if-equal "open-input-file #:encoding"
"test"
(call-with-output-file filename
(lambda (port)
(put-bytevector port #vu8(116 0 101 0 115 0 116 0))))
(let* ((port (open-input-file filename #:encoding "UTF-16LE"))
(str (read-string port)))
(close-port port)
str))
(pass-if-equal "call-with-input-file #:encoding"
"test"
(call-with-output-file filename
(lambda (port)
(put-bytevector port #vu8(116 0 101 0 115 0 116 0))))
(call-with-input-file filename
read-string
#:encoding "UTF-16LE"))
(pass-if-equal "with-input-from-file #:encoding"
"test"
(call-with-output-file filename
(lambda (port)
(put-bytevector port #vu8(116 0 101 0 115 0 116 0))))
(with-input-from-file filename
read-string
#:encoding "UTF-16LE")))
(with-test-prefix "read #:binary"
(pass-if-equal "open-input-file"
"ISO-8859-1"
(let* ((port (open-input-file filename #:binary #t))
(enc (port-encoding port)))
(close-port port)
enc))
(pass-if-equal "call-with-input-file"
"ISO-8859-1"
(call-with-input-file filename port-encoding #:binary #t))
(pass-if-equal "with-input-from-file"
"ISO-8859-1"
(with-input-from-file filename
(lambda () (port-encoding (current-input-port)))
#:binary #t)))
(with-test-prefix "#:guess-encoding with coding declaration"
(pass-if-equal "open-file"
"€100"
(with-output-to-file filename
(lambda ()
(write-line "test")
(write-line "; coding: ISO-8859-15")
(write-line "€100"))
#:encoding "ISO-8859-15")
(let* ((port (open-file filename "r"
#:guess-encoding #t
#:encoding "UTF-16LE"))
(str (begin (read-line port)
(read-line port)
(read-line port))))
(close-port port)
str))
(pass-if-equal "open-input-file"
"€100"
(with-output-to-file filename
(lambda ()
(write-line "test")
(write-line "; coding: ISO-8859-15")
(write-line "€100"))
#:encoding "ISO-8859-15")
(let* ((port (open-input-file filename
#:guess-encoding #t
#:encoding "UTF-16LE"))
(str (begin (read-line port)
(read-line port)
(read-line port))))
(close-port port)
str))
(pass-if-equal "call-with-input-file"
"€100"
(with-output-to-file filename
(lambda ()
(write-line "test")
(write-line "; coding: ISO-8859-15")
(write-line "€100"))
#:encoding "ISO-8859-15")
(call-with-input-file filename
(lambda (port)
(read-line port)
(read-line port)
(read-line port))
#:guess-encoding #t
#:encoding "UTF-16LE"))
(pass-if-equal "with-input-from-file"
"€100"
(with-output-to-file filename
(lambda ()
(write-line "test")
(write-line "; coding: ISO-8859-15")
(write-line "€100"))
#:encoding "ISO-8859-15")
(with-input-from-file filename
(lambda ()
(read-line)
(read-line)
(read-line))
#:guess-encoding #t
#:encoding "UTF-16LE")))
(with-test-prefix "#:guess-encoding without coding declaration"
(pass-if-equal "open-file"
"€100"
(with-output-to-file filename
(lambda () (write-line "€100"))
#:encoding "ISO-8859-15")
(let* ((port (open-file filename "r"
#:guess-encoding #t
#:encoding "ISO-8859-15"))
(str (read-line port)))
(close-port port)
str))
(pass-if-equal "open-input-file"
"€100"
(with-output-to-file filename
(lambda () (write-line "€100"))
#:encoding "ISO-8859-15")
(let* ((port (open-input-file filename
#:guess-encoding #t
#:encoding "ISO-8859-15"))
(str (read-line port)))
(close-port port)
str))
(pass-if-equal "call-with-input-file"
"€100"
(with-output-to-file filename
(lambda () (write-line "€100"))
#:encoding "ISO-8859-15")
(call-with-input-file filename
read-line
#:guess-encoding #t
#:encoding "ISO-8859-15"))
(pass-if-equal "with-input-from-file"
"€100"
(with-output-to-file filename
(lambda () (write-line "€100"))
#:encoding "ISO-8859-15")
(with-input-from-file filename
read-line
#:guess-encoding #t
#:encoding "ISO-8859-15")))
(delete-file filename))))
;;; ungetting characters and strings.
(with-input-from-string "walk on the moon\nmoon"
(lambda ()