mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 20:00:19 +02:00
Code Activity

implement port-eof?

Browse source 
* module/rnrs/io/ports.scm (port-eof?): Implement.
* module/rnrs.scm: Re-export port-eof?.

* test-suite/tests/r6rs-ports.test ("7.2.5 End-of-File Object"): Add
  test.

Thanks to Göran Weinholt for the report.
This commit is contained in:
Andy Wingo 2011-01-21 08:27:08 +01:00
parent dc78bee588
commit b04f841d5f
3 changed files with 15 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

5
module/rnrs.scm
View file

@ -1,6 +1,6 @@
;;; rnrs.scm --- The R6RS composite library ;;; rnrs.scm --- The R6RS composite library
;; Copyright (C) 2010 Free Software Foundation, Inc. ;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
;; ;;
;; 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
@ -165,7 +165,8 @@
make-transcoder transcoder-codec native-transcoder make-transcoder transcoder-codec native-transcoder
latin-1-codec utf-8-codec utf-16-codec latin-1-codec utf-8-codec utf-16-codec
eof-object? port? input-port? output-port? eof-object port-transcoder eof-object? port? input-port? output-port? eof-object port-eof?
port-transcoder
binary-port? transcoded-port port-position set-port-position! binary-port? transcoded-port port-position set-port-position!
port-has-port-position? port-has-set-port-position!? port-has-port-position? port-has-set-port-position!?
close-port call-with-port close-port call-with-port

8
module/rnrs/io/ports.scm
View file

@ -1,6 +1,6 @@
;;;; ports.scm --- R6RS port API -*- coding: utf-8 -*- ;;;; ports.scm --- R6RS port API -*- coding: utf-8 -*-
;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. ;;;; Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc.
;;;; ;;;;
;;;; 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
@ -37,6 +37,7 @@
;; input & output ports ;; input & output ports
port? input-port? output-port? port? input-port? output-port?
port-eof?
port-transcoder binary-port? transcoded-port port-transcoder binary-port? transcoded-port
port-position set-port-position! port-position set-port-position!
port-has-port-position? port-has-set-port-position!? port-has-port-position? port-has-set-port-position!?
@ -191,6 +192,11 @@
;; So far, we don't support transcoders other than the binary transcoder. ;; So far, we don't support transcoders other than the binary transcoder.
#t) #t)
(define (port-eof? port)
(eof-object? (if (binary-port? port)
(lookahead-u8 port)
(lookahead-char port))))
(define (transcoded-port port transcoder) (define (transcoded-port port transcoder)
"Return a new textual port based on @var{port}, using "Return a new textual port based on @var{port}, using
@var{transcoder} to encode and decode data written to or @var{transcoder} to encode and decode data written to or

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

@ -1,6 +1,6 @@
;;;; r6rs-ports.test --- R6RS I/O port tests. -*- coding: utf-8; -*- ;;;; r6rs-ports.test --- R6RS I/O port tests. -*- coding: utf-8; -*-
;;;; ;;;;
;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. ;;;; Copyright (C) 2009, 2010, 2011 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
@ -35,7 +35,10 @@
(pass-if "eof-object" (pass-if "eof-object"
(and (eqv? (eof-object) (eof-object)) (and (eqv? (eof-object) (eof-object))
(eq? (eof-object) (eof-object))))) (eq? (eof-object) (eof-object))))
(pass-if "port-eof?"
(port-eof? (open-input-string ""))))
(with-test-prefix "7.2.8 Binary Input" (with-test-prefix "7.2.8 Binary Input"