[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.1-103-g0687e82

[Andreas Rottmann]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=0687e826a12e45cec9fcf14ed642f176d230afb9

The branch, stable-2.0 has been updated
       via  0687e826a12e45cec9fcf14ed642f176d230afb9 (commit)
      from  dfc4d56df1854e1c93606fa03497ff7218357e3d (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 0687e826a12e45cec9fcf14ed642f176d230afb9
Author: Andreas Rottmann <address@hidden>
Date:   Fri May 27 15:32:01 2011 +0200

    rnrs io ports: fix port encoding when opening file ports
    
    * module/rnrs/io/ports.scm (open-file-input-port)
      (open-file-output-port): Ensure the resulting ports are binary when no
      transcoder is specified.
    
    * test-suite/tests/r6rs-ports.test: Remove superfluous global change of
      `%default-port-encoding' and accompanying comment.
      ("7.2.7 Input Ports"): Add test ensuring `open-file-input-port' opens
      a binary port when no transcoder is specified.
      ("8.2.10 Output ports"): Strengthen existing `open-file-output-port'
      binary-ness test by setting `%default-port-encoding' to "UTF-8".

-----------------------------------------------------------------------

Summary of changes:
 module/rnrs/io/ports.scm         |    8 ++++++--
 test-suite/tests/r6rs-ports.test |   33 ++++++++++++++++++++++-----------
 2 files changed, 28 insertions(+), 13 deletions(-)

diff --git a/module/rnrs/io/ports.scm b/module/rnrs/io/ports.scm
index 4ae01be..246e46b 100644
--- a/module/rnrs/io/ports.scm
+++ b/module/rnrs/io/ports.scm
@@ -311,7 +311,9 @@ read from/written to in @var{port}."
                                (buffer-mode (buffer-mode block))
                                maybe-transcoder)
   (let ((port (with-i/o-filename-conditions filename
-                (lambda () (open filename O_RDONLY)))))
+                (lambda ()
+                  (with-fluids ((%default-port-encoding #f))
+                    (open filename O_RDONLY))))))
     (cond (maybe-transcoder
            (set-port-encoding! port (transcoder-codec maybe-transcoder))))
     port))
@@ -340,7 +342,9 @@ as a string, and a thunk to retrieve the characters 
associated with that port."
                             0
                             O_EXCL)))
          (port (with-i/o-filename-conditions filename
-                 (lambda () (open filename flags)))))
+                 (lambda ()
+                   (with-fluids ((%default-port-encoding #f))
+                     (open filename flags))))))
     (cond (maybe-transcoder
            (set-port-encoding! port (transcoder-codec maybe-transcoder))))
     port))
diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test
index feef48d..f3e8c2c 100644
--- a/test-suite/tests/r6rs-ports.test
+++ b/test-suite/tests/r6rs-ports.test
@@ -27,12 +27,6 @@
   #:use-module (rnrs exceptions)
   #:use-module (rnrs bytevectors))
 
-;;; All these tests assume Guile 1.8's port system, where characters are
-;;; treated as octets.
-
-;; Set the default encoding of future ports to be Latin-1.
-(fluid-set! %default-port-encoding #f)
-
 (define-syntax pass-if-condition
   (syntax-rules ()
     ((_ name predicate body0 body ...)
@@ -322,6 +316,22 @@
 
 (with-test-prefix "7.2.7 Input Ports"
 
+  (let ((filename (test-file))
+        (contents (string->utf8 "GNU λ")))
+    
+    ;; Create file
+    (call-with-output-file filename
+      (lambda (port) (put-bytevector port contents)))
+  
+    (pass-if "open-file-input-port [opens binary port]"
+      (with-fluids ((%default-port-encoding "UTF-8"))
+          (call-with-port (open-file-input-port filename)
+            (lambda (port)
+              (and (binary-port? port)
+                   (bytevector=? contents (get-bytevector-all port)))))))
+
+    (delete-file filename))
+  
   ;; This section appears here so that it can use the binary input
   ;; primitives.
 
@@ -469,11 +479,12 @@
 (with-test-prefix "8.2.10 Output ports"
 
   (let ((filename (test-file)))
-    (pass-if "open-file-output-port [opens binary port]"
-      (call-with-port (open-file-output-port filename)
-        (lambda (port)
-          (put-bytevector port '#vu8(1 2 3))
-          (binary-port? port))))
+    (with-fluids ((%default-port-encoding "UTF-8"))
+      (pass-if "open-file-output-port [opens binary port]"
+        (call-with-port (open-file-output-port filename)
+          (lambda (port)
+            (put-bytevector port '#vu8(1 2 3))
+            (binary-port? port)))))
     
     (pass-if-condition "open-file-output-port [exception: already-exists]"
         i/o-file-already-exists-error?


hooks/post-receive
-- 
GNU Guile