[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. release_1-9-8-65-gd33
|
From: |
Ludovic Courtès |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. release_1-9-8-65-gd332d84 |
|
Date: |
Wed, 03 Mar 2010 23:54:39 +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=d332d84610f1ae8dacd546d974287c9279a64428
The branch, master has been updated
via d332d84610f1ae8dacd546d974287c9279a64428 (commit)
via 1c242b37f0dda6e82e3cafecd6f28a7df1841d77 (commit)
via c45de346fd40a296b6c2519af1c807df968b9e05 (commit)
via f5147c84a2228b5f23608aba4319b3fa4b7a432c (commit)
from 54096be7528be999a5eb1b393922c331880128ae (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 d332d84610f1ae8dacd546d974287c9279a64428
Author: Ludovic Courtès <address@hidden>
Date: Thu Mar 4 00:54:18 2010 +0100
Write the test suite log file in UTF-8.
* test-suite/guile-test (main): Set LOG-PORT's encoding to UTF-8.
commit 1c242b37f0dda6e82e3cafecd6f28a7df1841d77
Author: Ludovic Courtès <address@hidden>
Date: Thu Mar 4 00:47:21 2010 +0100
Use `with-latin1-locale' in `regexp.test'.
As a side effect, it fixes tests on platforms with no 8-bit locale and
where executing regexps on characters >= 128 can lead to errors such as
`cannot convert to output locale "US-ASCII": ""\x80""'.
This commit partially reverts 7583976b ("More setlocale robustness in
regexp tests").
* test-suite/tests/regexp.test (mysetlocale, set-latin-1): Remove.
("regexp-quote"): Use `with-latin1-locale' instead of the above
procedures.
commit c45de346fd40a296b6c2519af1c807df968b9e05
Author: Ludovic Courtès <address@hidden>
Date: Thu Mar 4 00:39:18 2010 +0100
Move Latin-1 locale fiddling to `(test-suite lib)'.
* test-suite/lib.scm (with-latin1-locale*): New procedure.
(with-latin1-locale): New macro.
* test-suite/tests/bytevectors.test (with-locale, with-latin1-locale):
Remove. Adjust users.
commit f5147c84a2228b5f23608aba4319b3fa4b7a432c
Author: Ludovic Courtès <address@hidden>
Date: Wed Mar 3 23:57:50 2010 +0100
Fix `with-locale*' in `(test-suite lib)'.
* test-suite/lib.scm (with-locale*): Set LOC to the previous locale
name, not to the new locale name. Only restore LOC when it's not #f.
(with-locale): Use `syntax-rules'.
-----------------------------------------------------------------------
Summary of changes:
test-suite/guile-test | 5 ++-
test-suite/lib.scm | 46 ++++++++++++++++----
test-suite/tests/bytevectors.test | 55 ++++-------------------
test-suite/tests/regexp.test | 85 ++++++++----------------------------
4 files changed, 71 insertions(+), 120 deletions(-)
diff --git a/test-suite/guile-test b/test-suite/guile-test
index 65b0533..bb7797f 100755
--- a/test-suite/guile-test
+++ b/test-suite/guile-test
@@ -5,7 +5,7 @@
;;;; guile-test --- run the Guile test suite
;;;; Jim Blandy <address@hidden> --- May 1999
;;;;
-;;;; Copyright (C) 1999, 2001, 2006 Free Software Foundation, Inc.
+;;;; Copyright (C) 1999, 2001, 2006, 2010 Free Software Foundation, Inc.
;;;;
;;;; This program is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -205,6 +205,9 @@
;; Open the log file.
(let ((log-port (open-output-file log-file)))
+ ;; Allow for arbitrary Unicode characters in the log file.
+ (set-port-encoding! log-port "UTF-8")
+
;; Register some reporters.
(let ((global-pass #t)
(counter (make-count-reporter)))
diff --git a/test-suite/lib.scm b/test-suite/lib.scm
index d67b957..41dda98 100644
--- a/test-suite/lib.scm
+++ b/test-suite/lib.scm
@@ -19,6 +19,7 @@
(define-module (test-suite lib)
:use-module (ice-9 stack-catch)
:use-module (ice-9 regex)
+ :autoload (srfi srfi-1) (append-map)
:export (
;; Exceptions which are commonly being tested for.
@@ -48,8 +49,8 @@
;; Using the debugging evaluator.
with-debugging-evaluator with-debugging-evaluator*
-;; Using a given locale
-with-locale with-locale*
+ ;; Using a given locale
+ with-locale with-locale* with-latin1-locale with-latin1-locale*
;; Reporting results in various ways.
register-reporter unregister-reporter reporter-registered?
@@ -456,19 +457,48 @@ with-locale with-locale*
(lambda ()
(if (defined? 'setlocale)
(begin
- (set! loc
- (false-if-exception (setlocale LC_ALL nloc)))
- (if (not loc)
+ (set! loc (false-if-exception (setlocale LC_ALL)))
+ (if (or (not loc)
+ (not (false-if-exception (setlocale LC_ALL nloc))))
(throw 'unresolved)))
(throw 'unresolved)))
thunk
(lambda ()
- (if (defined? 'setlocale)
+ (if (and (defined? 'setlocale) loc)
(setlocale LC_ALL loc))))))
;;; Evaluate BODY... using the given locale.
-(define-macro (with-locale loc . body)
- `(with-locale* ,loc (lambda () ,@body)))
+(define-syntax with-locale
+ (syntax-rules ()
+ ((_ loc body ...)
+ (with-locale* loc (lambda () body ...)))))
+
+;;; Try out several ISO-8859-1 locales and run THUNK under the one that works
+;;; (if any).
+(define (with-latin1-locale* thunk)
+ (define %locales
+ (append-map (lambda (name)
+ (list (string-append name ".ISO-8859-1")
+ (string-append name ".iso88591")
+ (string-append name ".ISO8859-1")))
+ '("ca_ES" "da_DK" "de_DE" "es_ES" "es_MX" "en_GB" "en_US"
+ "fr_FR" "pt_PT" "nl_NL" "sv_SE")))
+
+ (let loop ((locales %locales))
+ (if (null? locales)
+ (throw 'unresolved)
+ (catch 'unresolved
+ (lambda ()
+ (with-locale* (car locales) thunk))
+ (lambda (key . args)
+ (loop (cdr locales)))))))
+
+;;; Evaluate BODY... using an ISO-8859-1 locale or throw `unresolved' if none
+;;; was found.
+(define-syntax with-latin1-locale
+ (syntax-rules ()
+ ((_ body ...)
+ (with-latin1-locale* (lambda () body ...)))))
;;;; REPORTERS
diff --git a/test-suite/tests/bytevectors.test
b/test-suite/tests/bytevectors.test
index 35bdb47..3f68c81 100644
--- a/test-suite/tests/bytevectors.test
+++ b/test-suite/tests/bytevectors.test
@@ -377,39 +377,6 @@
(bytevector-ieee-double-ref b 8 (endianness big))))))
-(define (with-locale locale thunk)
- ;; Run THUNK under LOCALE.
- (let ((original-locale (setlocale LC_ALL)))
- (catch 'system-error
- (lambda ()
- (setlocale LC_ALL locale))
- (lambda (key . args)
- (throw 'unresolved)))
-
- (dynamic-wind
- (lambda ()
- #t)
- thunk
- (lambda ()
- (setlocale LC_ALL original-locale)))))
-
-(define (with-latin1-locale thunk)
- ;; Try out several ISO-8859-1 locales and run THUNK under the one that
- ;; works (if any).
- (define %locales
- (map (lambda (name)
- (string-append name ".ISO-8859-1"))
- '("fr_FR" "es_ES" "en_GB" "en_US" "de_DE" "pt_PT")))
-
- (let loop ((locales %locales))
- (if (null? locales)
- (throw 'unresolved)
- (catch 'unresolved
- (lambda ()
- (with-locale (car locales) thunk))
- (lambda (key . args)
- (loop (cdr locales)))))))
-
;; Default to the C locale for the following tests.
(setlocale LC_ALL "C")
@@ -428,12 +395,11 @@
(pass-if "string->utf8 [latin-1]"
(with-latin1-locale
- (lambda ()
- (let* ((str "hé, ça va bien ?")
- (utf8 (string->utf8 str)))
- (and (bytevector? utf8)
- (= (bytevector-length utf8)
- (+ 2 (string-length str))))))))
+ (let* ((str "hé, ça va bien ?")
+ (utf8 (string->utf8 str)))
+ (and (bytevector? utf8)
+ (= (bytevector-length utf8)
+ (+ 2 (string-length str)))))))
(pass-if "string->utf16"
(let* ((str "hello, world")
@@ -492,12 +458,11 @@
(pass-if "utf8->string [latin-1]"
(with-latin1-locale
- (lambda ()
- (let* ((utf8 (string->utf8 "hé, ça va bien ?"))
- (str (utf8->string utf8)))
- (and (string? str)
- (= (string-length str)
- (- (bytevector-length utf8) 2)))))))
+ (let* ((utf8 (string->utf8 "hé, ça va bien ?"))
+ (str (utf8->string utf8)))
+ (and (string? str)
+ (= (string-length str)
+ (- (bytevector-length utf8) 2))))))
(pass-if "utf16->string"
(let* ((utf16 (uint-list->bytevector (map char->integer
diff --git a/test-suite/tests/regexp.test b/test-suite/tests/regexp.test
index 422d8f3..bc785ab 100644
--- a/test-suite/tests/regexp.test
+++ b/test-suite/tests/regexp.test
@@ -1,7 +1,7 @@
;;;; regexp.test --- test Guile's regular expression functions -*- scheme -*-
;;;; Jim Blandy <address@hidden> --- September 1999
;;;;
-;;;; Copyright (C) 1999, 2004, 2006, 2007, 2008, 2009 Free Software
Foundation, Inc.
+;;;; Copyright (C) 1999, 2004, 2006, 2007, 2008, 2009, 2010 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
@@ -22,53 +22,10 @@
#:use-module (srfi srfi-1)
#:use-module (ice-9 regex))
-;; Set the locale to LOC, if possible. Failing that, set the locale
-;; to C. If that fails, force the port encoding to ASCII.
-(define (mysetlocale loc)
- (or
- (and (defined? 'setlocale)
- (false-if-exception (setlocale LC_ALL loc)))
- (and (defined? 'setlocale)
- (false-if-exception (setlocale LC_ALL "C")))
- (begin
- (false-if-exception (set-port-encoding! (current-input-port)
- "ASCII"))
- (false-if-exception (set-port-encoding! (current-output-port)
- "ASCII"))
- #f)))
-
-;; Set the locale to a Latin-1 friendly locale. Failing that, force
-;; the port encoding to Latin-1. Returns the encoding used.
-(define (set-latin-1)
- (set-port-conversion-strategy! (current-output-port) 'escape)
- (or
- (any
- (lambda (loc)
- (if (defined? 'setlocale)
- (let ((ret (false-if-exception (setlocale LC_ALL loc))))
- (if ret
- loc
- #f))
- #f))
- (append
- (map (lambda (name)
- (string-append name ".ISO-8859-1"))
- '("fr_FR" "es_MX" "es_ES" "en_GB" "en_US" "de_DE" "pt_PT"))
- (map (lambda (name)
- (string-append name ".iso88591"))
- '("fr_FR" "es_MX" "es_ES" "en_GB" "en_US" "de_DE" "pt_PT"))
- (map (lambda (name)
- (string-append name ".ISO8859-1"))
- '("fr_FR" "es_MX" "es_ES" "en_GB" "en_US" "de_DE" "pt_PT"))
- ))
- (begin
- (false-if-exception (set-port-encoding! (current-input-port)
- "ISO-8859-1"))
- (false-if-exception (set-port-encoding! (current-output-port)
- "ISO-8859-1"))
- #f)))
-
-(mysetlocale "C")
+(set-port-conversion-strategy! (current-output-port) 'escape)
+
+(if (defined? 'setlocale)
+ (setlocale LC_ALL "C"))
;;; Run a regexp-substitute or regexp-substitute/global test, once
@@ -204,15 +161,13 @@
(do ((i 1 (1+ i)))
((>= i char-code-limit))
(let* ((c (integer->char i))
- (s (string c))
- (q (regexp-quote s)))
- (pass-if (list "char" i (format #f "~s ~s ~s" c s q))
- (set-latin-1) ; set locale for regexp processing
- ; on binary data
- (let ((m (regexp-exec (make-regexp q flag) s)))
- (mysetlocale "") ; restore locale
- (and (= 0 (match:start m))
- (= 1 (match:end m)))))))
+ (s (string c)))
+ (pass-if (list "char" i (format #f "~s ~s" c s))
+ (with-latin1-locale
+ (let* ((q (regexp-quote s))
+ (m (regexp-exec (make-regexp q flag) s)))
+ (and (= 0 (match:start m))
+ (= 1 (match:end m))))))))
;; try on pattern "aX" where X is each character, except #\nul
;; this exposes things like "?" which are special only when they
@@ -223,24 +178,22 @@
(s (string #\a c))
(q (regexp-quote s)))
(pass-if (list "string \"aX\"" i (format #f "~s ~s ~s" c s q))
- (set-latin-1)
+ (with-latin1-locale
(let* ((m (regexp-exec (make-regexp q flag) s)))
- (mysetlocale "")
(and (= 0 (match:start m))
- (= 2 (match:end m)))))))
+ (= 2 (match:end m))))))))
(pass-if "string of all chars"
- (set-latin-1)
- (let ((m (regexp-exec (make-regexp (regexp-quote allchars)
- flag) allchars)))
- (and (= 0 (match:start m))
- (= (string-length allchars) (match:end m))))))))
+ (with-latin1-locale
+ (let ((m (regexp-exec (make-regexp (regexp-quote allchars)
+ flag) allchars)))
+ (and (= 0 (match:start m))
+ (= (string-length allchars) (match:end m)))))))))
lst)))
;;;
;;; regexp-substitute
;;;
-(mysetlocale "C")
(with-test-prefix "regexp-substitute"
(let ((match
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. release_1-9-8-65-gd332d84,
Ludovic Courtès <=