guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.0-218-gd8478


From: Ludovic Courtès
Subject: [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.0-218-gd84783a
Date: Wed, 27 Apr 2011 14:28:54 +0000

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=d84783a80c186b0b13e3aeb206384bb198bf41e6

The branch, stable-2.0 has been updated
       via  d84783a80c186b0b13e3aeb206384bb198bf41e6 (commit)
       via  9a201881e67780f08fd398538100d4cdb4095321 (commit)
      from  94b55d3fa046523e13de9df1c2fb39280f4842e8 (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 d84783a80c186b0b13e3aeb206384bb198bf41e6
Author: Ludovic Courtès <address@hidden>
Date:   Wed Apr 27 16:26:26 2011 +0200

    Add a couple more Unicode I/O tests.
    
    * test-suite/tests/ports.test ("string ports")["%default-port-encoding
      is honored"]: Make sure `(port-encoding p)' is as expected.
      ["peek-char [utf-16]"]: New test.

commit 9a201881e67780f08fd398538100d4cdb4095321
Author: Ludovic Courtès <address@hidden>
Date:   Wed Apr 27 16:28:29 2011 +0200

    Rewrite port decoding error tests using a mini DSL.
    
    * test-suite/tests/ports.test ("string ports")[test-decoding-error]: New
      macro.
      ["read-char, wrong encoding, error", "read-char, wrong encoding,
      escape", "read-char, wrong encoding, substitute", "peek-char, wrong
      encoding, error"]: Rewrite using `test-decoding-error'.

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

Summary of changes:
 test-suite/tests/ports.test |  163 +++++++++++++++++++++++--------------------
 1 files changed, 88 insertions(+), 75 deletions(-)

diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index 9d3000c..c933724 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -391,7 +391,8 @@
                      (with-fluids ((%default-port-encoding e))
                        (call-with-output-string
                          (lambda (p)
-                           (display (port-encoding p) p)))))
+                           (and (string=? e (port-encoding p))
+                                (display (port-encoding p) p))))))
                    encodings)
               encodings)))
 
@@ -462,80 +463,88 @@
            (= (port-line p) 0)
            (= (port-column p) 0))))
 
-  (pass-if "read-char, wrong encoding, error"
-    (let ((p (open-bytevector-input-port #vu8(255 65 66 67))))
-      (catch 'decoding-error
-        (lambda ()
-          (set-port-encoding! p "UTF-8")
-          (set-port-conversion-strategy! p 'error)
-          (read-char p)
-          #f)
-        (lambda (key subr message err port)
-          (and (eq? port p)
-
-               ;; PORT should point past the error.
-               (equal? '(#\A #\B #\C)
-                       (list (read-char port)
-                             (read-char port)
-                             (read-char port)))
-
-               (eof-object? (read-char port)))))))
-
-  (pass-if "read-char, wrong encoding, escape"
-    ;; `escape' should behave exactly like `error'.
-    (let ((p (open-bytevector-input-port #vu8(255 65 66 67))))
-      (catch 'decoding-error
-        (lambda ()
-          (set-port-encoding! p "UTF-8")
-          (set-port-conversion-strategy! p 'escape)
-          (read-char p)
-          #f)
-        (lambda (key subr message err port)
-          (and (eq? port p)
-
-               ;; PORT should point past the error.
-               (equal? '(#\A #\B #\C)
-                       (list (read-char port)
-                             (read-char port)
-                             (read-char port)))
-
-               (eof-object? (read-char port)))))))
-
-  (pass-if "read-char, wrong encoding, substitute"
-    (let ((p (open-bytevector-input-port #vu8(255 206 187 206 188))))
-      (set-port-encoding! p "UTF-8")
-      (set-port-conversion-strategy! p 'substitute)
-      (equal? (list (read-char p) (read-char p) (read-char p))
-              '(#\? #\λ #\μ))))
-
-  (pass-if "peek-char, wrong encoding, error"
-    (let-syntax ((decoding-error?
-                  (syntax-rules ()
-                    ((_ port exp)
-                     (catch 'decoding-error
-                       (lambda ()
-                         (pk 'exp exp)
-                         #f)
-                       (lambda (key subr message errno p)
-                         (eq? p port)))))))
-      (let ((p (open-bytevector-input-port #vu8(255 65 66 67))))
-        (set-port-encoding! p "UTF-8")
-        (set-port-conversion-strategy! p 'error)
-
-        ;; `peek-char' should repeatedly raise an error.
-        (and (decoding-error? p (peek-char p))
-             (decoding-error? p (peek-char p))
-             (decoding-error? p (peek-char p))
-
-             ;; Move past the error.
-             (decoding-error? p (read-char p))
-
-             ;; Finish happily.
-             (equal? '(#\A #\B #\C)
-                     (list (read-char p)
-                           (read-char p)
-                           (read-char p)))
-             (eof-object? (read-char p)))))))
+  (pass-if "peek-char [utf-16]"
+    (let ((p (with-fluids ((%default-port-encoding "UTF-16BE"))
+               (open-input-string "안녕하세요"))))
+      (and (char=? (peek-char p) #\안)
+           (char=? (peek-char p) #\안)
+           (char=? (peek-char p) #\안)
+           (= (port-line p) 0)
+           (= (port-column p) 0))))
+
+  ;; Mini DSL to test decoding error handling.
+  (letrec-syntax ((decoding-error?
+                   (syntax-rules ()
+                     ((_ port exp)
+                      (catch 'decoding-error
+                        (lambda ()
+                          (pk 'exp exp)
+                          #f)
+                        (lambda (key subr message errno p)
+                          (and (eq? p port)
+                               (not (= 0 errno))))))))
+                  (make-check
+                   (syntax-rules (-> error eof)
+                     ((_ port (proc -> error))
+                      (decoding-error? port (proc port)))
+                     ((_ port (proc -> eof))
+                      (eof-object? (proc port)))
+                     ((_ port (proc -> char))
+                      (eq? (proc port) char))))
+                  (make-checks
+                   (syntax-rules ()
+                     ((_ port check ...)
+                      (and (make-check port check) ...))))
+                  (test-decoding-error
+                      (syntax-rules (tests)
+                        ((_ sequence encoding strategy (tests checks ...))
+                         (pass-if (format #f "test-decoding-error: ~s ~s ~s ~s"
+                                          (caar '(checks ...))
+                                          'sequence encoding strategy)
+                           (let ((p (open-bytevector-input-port
+                                     (u8-list->bytevector 'sequence))))
+                             (set-port-encoding! p encoding)
+                             (set-port-conversion-strategy! p strategy)
+                             (make-checks p checks ...)))))))
+
+    (test-decoding-error (255 65 66 67) "UTF-8" 'error
+      (tests
+       (read-char -> error)
+       (read-char -> #\A)
+       (read-char -> #\B)
+       (read-char -> #\C)
+       (read-char -> eof)))
+
+    (test-decoding-error (255 65 66 67) "UTF-8" 'escape
+      ;; `escape' should behave exactly like `error'.
+      (tests
+       (read-char -> error)
+       (read-char -> #\A)
+       (read-char -> #\B)
+       (read-char -> #\C)
+       (read-char -> eof)))
+
+    (test-decoding-error (255 206 187 206 188) "UTF-8" 'substitute
+      (tests
+       (read-char -> #\?)
+       (read-char -> #\λ)
+       (read-char -> #\μ)
+       (read-char -> eof)))
+
+    (test-decoding-error (255 65 66 67) "UTF-8" 'error
+      (tests
+       ;; `peek-char' should repeatedly raise an error.
+       (peek-char -> error)
+       (peek-char -> error)
+       (peek-char -> error)
+
+       ;; Move past the error.
+       (read-char -> error)
+
+       (read-char -> #\A)
+       (read-char -> #\B)
+       (read-char -> #\C)
+       (read-char -> eof)))))
 
 (with-test-prefix "call-with-output-string"
 
@@ -994,3 +1003,7 @@
            '("read" "read-char" "read-line")))
 
 (delete-file (test-file))
+
+;;; Local Variables:
+;;; eval: (put 'test-decoding-error 'scheme-indent-function 3)
+;;; End:


hooks/post-receive
-- 
GNU Guile



reply via email to

[Prev in Thread] Current Thread [Next in Thread]