mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-26 05:00:28 +02:00
c62da8f891
* libguile/ports.c (scm_read_char): Mention `decoding-error' in the
docstring.
(get_codepoint): Change to return an error code; add `codepoint'
output parameter. Don't raise an error from here.
(scm_getc): Raise an error with `scm_decoding_error' if
`get_codepoint' returns an error.
(scm_peek_char): Likewise. Update docstring.
* libguile/strings.c (scm_decoding_error_key): New variable.
(scm_decoding_error): New function.
(scm_from_stringn): Use `scm_decoding_error' instead of
`scm_encoding_error'.
* libguile/strings.h (scm_decoding_error): New declaration.
* test-suite/tests/ports.test ("string ports")["read-char, wrong
encoding, error"]: Change to expect `decoding-error'. Make sure PORT
points past the error.
["read-char, wrong encoding, escape"]: Likewise.
["peek-char, wrong encoding, error"]: New test.
* test-suite/tests/r6rs-ports.test ("7.2.11 Binary
Output")["put-bytevector with wrong-encoding string port"]: Change to
expect `decoding-error'.
("8.2.6 Input and output ports")["transcoded-port [error handling
mode = raise]"]: Likewise.
* test-suite/tests/rdelim.test ("read-line")["decoding error", "decoding
error, substitute"]: New tests.
* doc/ref/api-io.texi (Reading): Update documentation of `read-char' and
`peek-char'.
(Line/Delimited): Update documentation of `read-line'.
99 lines
3.7 KiB
Scheme
99 lines
3.7 KiB
Scheme
;;;; rdelim.test --- Delimited I/O. -*- mode: scheme; coding: utf-8; -*-
|
||
;;;; Ludovic Courtès <ludo@gnu.org>
|
||
;;;;
|
||
;;;; Copyright (C) 2011 Free Software Foundation, Inc.
|
||
;;;;
|
||
;;;; This library is free software; you can redistribute it and/or
|
||
;;;; modify it under the terms of the GNU Lesser General Public
|
||
;;;; License as published by the Free Software Foundation; either
|
||
;;;; version 3 of the License, or (at your option) any later version.
|
||
;;;;
|
||
;;;; This library is distributed in the hope that it will be useful,
|
||
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||
;;;; Lesser General Public License for more details.
|
||
;;;;
|
||
;;;; You should have received a copy of the GNU Lesser General Public
|
||
;;;; License along with this library; if not, write to the Free Software
|
||
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
||
|
||
(define-module (test-suite test-rdelim)
|
||
#:use-module (ice-9 rdelim)
|
||
#:use-module ((rnrs io ports) #:select (open-bytevector-input-port))
|
||
#:use-module (test-suite lib))
|
||
|
||
(with-fluids ((%default-port-encoding "UTF-8"))
|
||
|
||
(with-test-prefix "read-line"
|
||
|
||
(pass-if "one line"
|
||
(let* ((s "hello, world")
|
||
(p (open-input-string s)))
|
||
(and (string=? s (read-line p))
|
||
(eof-object? (read-line p)))))
|
||
|
||
(pass-if "two lines, trim"
|
||
(let* ((s "foo\nbar\n")
|
||
(p (open-input-string s)))
|
||
(and (equal? (string-tokenize s)
|
||
(list (read-line p) (read-line p)))
|
||
(eof-object? (read-line p)))))
|
||
|
||
(pass-if "two lines, concat"
|
||
(let* ((s "foo\nbar\n")
|
||
(p (open-input-string s)))
|
||
(and (equal? '("foo\n" "bar\n")
|
||
(list (read-line p 'concat)
|
||
(read-line p 'concat)))
|
||
(eof-object? (read-line p)))))
|
||
|
||
(pass-if "two lines, peek"
|
||
(let* ((s "foo\nbar\n")
|
||
(p (open-input-string s)))
|
||
(and (equal? '("foo" #\newline "bar" #\newline)
|
||
(list (read-line p 'peek) (read-char p)
|
||
(read-line p 'peek) (read-char p)))
|
||
(eof-object? (read-line p)))))
|
||
|
||
(pass-if "two lines, split"
|
||
(let* ((s "foo\nbar\n")
|
||
(p (open-input-string s)))
|
||
(and (equal? '(("foo" . #\newline)
|
||
("bar" . #\newline))
|
||
(list (read-line p 'split)
|
||
(read-line p 'split)))
|
||
(eof-object? (read-line p)))))
|
||
|
||
(pass-if "two Greek lines, trim"
|
||
(let* ((s "λαμβδα\nμυ\n")
|
||
(p (open-input-string s)))
|
||
(and (equal? (string-tokenize s)
|
||
(list (read-line p) (read-line p)))
|
||
(eof-object? (read-line p)))))
|
||
|
||
(pass-if "decoding error"
|
||
(let ((p (with-fluids ((%default-port-encoding "UTF-8"))
|
||
(open-bytevector-input-port #vu8(65 255 66 67 68)))))
|
||
(set-port-conversion-strategy! p 'error)
|
||
(catch 'decoding-error
|
||
(lambda ()
|
||
(read-line p)
|
||
#f)
|
||
(lambda (key subr message err port)
|
||
(and (eq? port p)
|
||
|
||
;; PORT should now point past the error.
|
||
(string=? (read-line p) "BCD")
|
||
(eof-object? (read-line p)))))))
|
||
|
||
(pass-if "decoding error, substitute"
|
||
(let ((p (with-fluids ((%default-port-encoding "UTF-8"))
|
||
(open-bytevector-input-port #vu8(65 255 66 67 68)))))
|
||
(set-port-conversion-strategy! p 'substitute)
|
||
(and (string=? (read-line p) "A?BCD")
|
||
(eof-object? (read-line p)))))))
|
||
|
||
;;; Local Variables:
|
||
;;; eval: (put 'with-test-prefix 'scheme-indent-function 1)
|
||
;;; eval: (put 'pass-if 'scheme-indent-function 1)
|
||
;;; End:
|