mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-21 12:10:26 +02:00
Code Activity

Have lookahead-u8' and get-u8' actually do binary input.

Browse source 
* libguile/r6rs-ports.c (scm_lookahead_u8): Use `scm_get_byte_or_eof'
  instead of `scm_peek_char'.
  (scm_get_u8): Likewise.

* test-suite/tests/r6rs-ports.test ("7.2.8 Binary
  Input")["lookahead-u8"]: Fix typo.
  ["lookahead-u8 non-ASCII"]: New test.
This commit is contained in:
Ludovic Courtès 2010-12-21 00:18:20 +01:00
parent 829ed325cf
commit 8aa47f2609
2 changed files with 28 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

14
libguile/r6rs-ports.c
View file

@ -433,7 +433,7 @@ SCM_DEFINE (scm_get_u8, "get-u8", 1, 0, 0,
SCM_VALIDATE_BINARY_INPUT_PORT (1, port); SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
c_result = scm_getc (port); c_result = scm_get_byte_or_eof (port);
if (c_result == EOF) if (c_result == EOF)
result = SCM_EOF_VAL; result = SCM_EOF_VAL;
else else
@ -449,15 +449,19 @@ SCM_DEFINE (scm_lookahead_u8, "lookahead-u8", 1, 0, 0,
"point past the octet.") "point past the octet.")
#define FUNC_NAME s_scm_lookahead_u8 #define FUNC_NAME s_scm_lookahead_u8
{ {
int u8;
SCM result; SCM result;
SCM_VALIDATE_BINARY_INPUT_PORT (1, port); SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
result = scm_peek_char (port); u8 = scm_get_byte_or_eof (port);
if (SCM_CHARP (result)) if (u8 == EOF)
result = SCM_I_MAKINUM ((unsigned char) SCM_CHAR (result));
else
result = SCM_EOF_VAL; result = SCM_EOF_VAL;
else
{
scm_unget_byte (u8, port);
result = SCM_I_MAKINUM ((scm_t_uint8) u8);
}
return result; return result;
} }

26
test-suite/tests/r6rs-ports.test
View file

@ -1,7 +1,7 @@
;;;; r6rs-ports.test --- R6RS I/O port tests. -*- coding: iso-8859-1; -*- ;;;; r6rs-ports.test --- R6RS I/O port tests. -*- coding: utf-8; -*-
;;;; ;;;;
;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. ;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;;;; Ludovic Courtès ;;;; Ludovic Courtès
;;;; ;;;;
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -48,10 +48,22 @@
(pass-if "lookahead-u8" (pass-if "lookahead-u8"
(let ((port (open-input-string "A"))) (let ((port (open-input-string "A")))
(and (= (char->integer #\A) (lookahead-u8 port)) (and (= (char->integer #\A) (lookahead-u8 port))
(not (eof-object? port)) (= (char->integer #\A) (lookahead-u8 port))
(= (char->integer #\A) (get-u8 port)) (= (char->integer #\A) (get-u8 port))
(eof-object? (get-u8 port))))) (eof-object? (get-u8 port)))))
(pass-if "lookahead-u8 non-ASCII"
(let ((port (with-fluids ((%default-port-encoding "UTF-8"))
(open-input-string "λ"))))
(and (= 206 (lookahead-u8 port))
(= 206 (lookahead-u8 port))
(= 206 (get-u8 port))
(= 187 (lookahead-u8 port))
(= 187 (lookahead-u8 port))
(= 187 (get-u8 port))
(eof-object? (lookahead-u8 port))
(eof-object? (get-u8 port)))))
(pass-if "lookahead-u8: result is unsigned" (pass-if "lookahead-u8: result is unsigned"
;; Bug #31081. ;; Bug #31081.
(let ((port (open-bytevector-input-port #vu8(255)))) (let ((port (open-bytevector-input-port #vu8(255))))
@ -501,7 +513,7 @@
(with-test-prefix "8.2.6 Input and output ports" (with-test-prefix "8.2.6 Input and output ports"
(pass-if "transcoded-port [output]" (pass-if "transcoded-port [output]"
(let ((s "Hello\nÄÖÜ")) (let ((s "Hello\nÄÖÜ"))
(bytevector=? (bytevector=?
(string->utf8 s) (string->utf8 s)
(call-with-bytevector-output-port (call-with-bytevector-output-port
@ -511,7 +523,7 @@
(put-string utf8-port s)))))))) (put-string utf8-port s))))))))
(pass-if "transcoded-port [input]" (pass-if "transcoded-port [input]"
(let ((s "Hello\nÄÖÜ")) (let ((s "Hello\nÄÖÜ"))
(string=? (string=?
s s
(get-string-all (get-string-all
@ -519,9 +531,9 @@
(make-transcoder (utf-8-codec))))))) (make-transcoder (utf-8-codec)))))))
(pass-if "transcoded-port [input line]" (pass-if "transcoded-port [input line]"
(string=? "ÄÖÜ" (string=? "ÄÖÜ"
(get-line (transcoded-port (get-line (transcoded-port
(open-bytevector-input-port (string->utf8 "ÄÖÜ\nFooBar")) (open-bytevector-input-port (string->utf8 "ÄÖÜ\nFooBar"))
(make-transcoder (utf-8-codec)))))) (make-transcoder (utf-8-codec))))))
(pass-if "transcoded-port [error handling mode = raise]" (pass-if "transcoded-port [error handling mode = raise]"