guile-commits
[Top][All Lists]
Advanced

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

[Guile-commits] GNU Guile branch, master, updated. release_1-9-2-125-gce


From: Michael Gran
Subject: [Guile-commits] GNU Guile branch, master, updated. release_1-9-2-125-gce3ed01
Date: Fri, 28 Aug 2009 13:29:14 +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=ce3ed0125fcfb9ad09da815f133a2320102d164c

The branch, master has been updated
       via  ce3ed0125fcfb9ad09da815f133a2320102d164c (commit)
      from  8736ef70acf603447cfcf697d44b8a46e8e53191 (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 ce3ed0125fcfb9ad09da815f133a2320102d164c
Author: Michael Gran <address@hidden>
Date:   Fri Aug 28 06:27:00 2009 -0700

    Don't presume existence or success of setlocale in test-suite
    
    * test-suite/lib.scm (with-locale, with-locale*): new test functions
    
    * test-suite/tests/encoding-escapes: don't fail if en_US.utf8 doesn't exist
    
    * test-suite/tests/encoding-iso88591.test: set and restore locale, if
      possible
    
    * test-suite/tests/encoding-iso88597.test: set and restore locale, if
      possible
    
    * test-suite/tests/encoding-utf8.test: set and restore locale, if possible
    
    * test-suite/tests/srfi-14.test: don't need to setlocale to Latin-1 to
      test Latin-1 since string conversion is handled at read/compile time.
      Set and restore locale, if possible.

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

Summary of changes:
 test-suite/lib.scm                      |   23 ++++
 test-suite/tests/encoding-escapes.test  |   27 +++--
 test-suite/tests/encoding-iso88591.test |    8 +-
 test-suite/tests/encoding-iso88597.test |    7 +-
 test-suite/tests/encoding-utf8.test     |    7 +-
 test-suite/tests/srfi-14.test           |  182 ++++++++++++-------------------
 6 files changed, 124 insertions(+), 130 deletions(-)

diff --git a/test-suite/lib.scm b/test-suite/lib.scm
index 8190d1f..e5b7a08 100644
--- a/test-suite/lib.scm
+++ b/test-suite/lib.scm
@@ -46,6 +46,9 @@
  ;; Using the debugging evaluator.
  with-debugging-evaluator with-debugging-evaluator*
 
+;; Using a given locale
+with-locale with-locale*
+
  ;; Reporting results in various ways.
  register-reporter unregister-reporter reporter-registered?
  make-count-reporter print-counts
@@ -437,6 +440,26 @@
 (define-macro (with-debugging-evaluator . body)
   `(with-debugging-evaluator* (lambda () ,@body)))
 
+;;; Call THUNK with a given locale
+(define (with-locale* nloc thunk)
+  (let ((loc #f))
+    (dynamic-wind
+       (lambda ()
+          (if (defined? 'setlocale)
+              (begin
+                (set! loc 
+                      (false-if-exception (setlocale LC_ALL nloc)))
+                (if (not loc)
+                    (throw 'unresolved)))
+              (throw 'unresolved)))
+       thunk
+       (lambda ()
+          (if (defined? 'setlocale)
+              (setlocale LC_ALL loc))))))
+
+;;; Evaluate BODY... using the given locale.
+(define-macro (with-locale loc . body)
+  `(with-locale* ,loc (lambda () ,@body)))
 
 
 ;;;; REPORTERS
diff --git a/test-suite/tests/encoding-escapes.test 
b/test-suite/tests/encoding-escapes.test
index 8859d2e..ea7a821 100644
--- a/test-suite/tests/encoding-escapes.test
+++ b/test-suite/tests/encoding-escapes.test
@@ -118,22 +118,23 @@
             (string=? "\\xfaltima"
                       (get-output-string pt))))
   (pass-if "Rashomon"
-          (let ((pt (open-output-string)))
-            (set-port-encoding! pt "ASCII")
-            (set-port-conversion-strategy! pt 'escape)
-            (display s4 pt)
-            (string=? "\\u7F85\\u751F\\u9580"
-                      (get-output-string pt)))))
-
-(setlocale LC_ALL "en_US.utf8")
+    (let ((pt (open-output-string)))
+      (set-port-encoding! pt "ASCII")
+      (set-port-conversion-strategy! pt 'escape)
+      (display s4 pt)
+      (string=? "\\u7F85\\u751F\\u9580"
+                (get-output-string pt)))))
 
 (with-test-prefix "input escapes"
 
-  (pass-if  "última"
-           (string=? "última"
-                     (with-input-from-string "\"\\xfaltima\"" read)))
+  (pass-if "última"
+    (with-locale "en_US.utf8"
+                 (string=? "última"
+                           (with-input-from-string "\"\\xfaltima\"" read))))
 
   (pass-if "羅生門"
-          (string=? "羅生門"
-                    (with-input-from-string "\"\\u7F85\\u751F\\u9580\"" 
read))))
+    (with-locale "en_US.utf8"
+                 (string=? "羅生門"
+                           (with-input-from-string 
+                               "\"\\u7F85\\u751F\\u9580\"" read)))))
 
diff --git a/test-suite/tests/encoding-iso88591.test 
b/test-suite/tests/encoding-iso88591.test
index edd5734..d4de5e5 100644
--- a/test-suite/tests/encoding-iso88591.test
+++ b/test-suite/tests/encoding-iso88591.test
@@ -28,7 +28,10 @@
 (define (string-ints . args)
   (apply string (map integer->char args)))
 
-(setlocale LC_ALL "")
+;; Set locale to the environment's locale, so that the prints look OK.
+(define oldlocale #f)
+(if (defined? 'setlocale)
+    (set! oldlocale (setlocale LC_ALL "")))
 
 (define s1 "última")
 (define s2 "cédula")
@@ -132,4 +135,5 @@
                       (display (string-ints 256) pt))))
 
 ;; Reset locales
-(setlocale LC_ALL "C")
\ No newline at end of file
+(if (defined? 'setlocale)
+    (setlocale LC_ALL oldlocale))
diff --git a/test-suite/tests/encoding-iso88597.test 
b/test-suite/tests/encoding-iso88597.test
index 8985042..2221269 100644
--- a/test-suite/tests/encoding-iso88597.test
+++ b/test-suite/tests/encoding-iso88597.test
@@ -28,7 +28,9 @@
 (define (string-ints . args)
   (apply string (map integer->char args)))
 
-(setlocale LC_ALL "")
+(define oldlocale #f)
+(if (defined? 'setlocale)
+    (set! oldlocale (setlocale LC_ALL "")))
 
 (define s1 "Ðåñß")
 (define s2 "ôçò")
@@ -133,4 +135,5 @@
                       (display (string-ints #x0400) pt))))
 
 ;; Reset locale
-(setlocale LC_ALL "C")
\ No newline at end of file
+(if (defined? 'setlocale)
+    (setlocale LC_ALL oldlocale))
diff --git a/test-suite/tests/encoding-utf8.test 
b/test-suite/tests/encoding-utf8.test
index 83e7540..a2613f1 100644
--- a/test-suite/tests/encoding-utf8.test
+++ b/test-suite/tests/encoding-utf8.test
@@ -28,7 +28,9 @@
 (define (string-ints . args)
   (apply string (map integer->char args)))
 
-(setlocale LC_ALL "")
+(define oldlocale #f)
+(if (defined? 'setlocale)
+    (set! oldlocale (setlocale LC_ALL "")))
 
 (define s1 "última")
 (define s2 "cédula")
@@ -102,4 +104,5 @@
                 (ñ 2))
             (eq? (+  芥川龍之介 ñ) 3))))
 
-
+(if (defined? 'setlocale)
+    (setlocale LC_ALL oldlocale))
diff --git a/test-suite/tests/srfi-14.test b/test-suite/tests/srfi-14.test
index 2bb934a..56c944a 100644
--- a/test-suite/tests/srfi-14.test
+++ b/test-suite/tests/srfi-14.test
@@ -238,9 +238,6 @@
        (string=? (char-set->string cs)
                  "egilu"))))
 
-;; Make sure we get an ASCII charset and character classification.
-(if (defined? 'setlocale) (setlocale LC_CTYPE "C"))
-
 (with-test-prefix "standard char sets (ASCII)"
 
   (pass-if "char-set:lower-case"
@@ -340,142 +337,105 @@
 (define (every? pred lst)
   (not (not (every pred lst))))
 
-(define (find-latin1-locale)
-  ;; Try to find and install an ISO-8859-1 locale.  Return `#f' on failure.
-  (if (defined? 'setlocale)
-      (let loop ((locales (map (lambda (lang)
-                                (string-append lang ".iso88591"))
-                              '("de_DE" "en_GB" "en_US" "es_ES"
-                                "fr_FR" "it_IT"))))
-       (if (null? locales)
-           #f
-           (if (false-if-exception (setlocale LC_CTYPE (car locales)))
-               (car locales)
-               (loop (cdr locales)))))
-      #f))
-
-
-(define %latin1 (find-latin1-locale))
+(define oldlocale #f)
+(if (defined? 'setlocale)
+    (set! oldlocale (setlocale LC_ALL "")))
 
 (with-test-prefix "Latin-1 (8-bit charset)"
 
   (pass-if "char-set:lower-case"
-     (if (not %latin1)
-        (throw 'unresolved)
-         (char-set<= (string->char-set
-                      (string-append "abcdefghijklmnopqrstuvwxyz"
-                                     "µßàáâãäåæçèéêëìíîïðñòóôõöøùúûüýþÿ")
-                      char-set:lower-case))))
+    (char-set<= (string->char-set
+                 (string-append "abcdefghijklmnopqrstuvwxyz"
+                                "µßàáâãäåæçèéêëìíîïðñòóôõöøùúûüýþÿ")
+                 char-set:lower-case)))
 
   (pass-if "char-set:upper-case"
-     (if (not %latin1)
-         (throw 'unresolved)
-         (char-set<= (string->char-set
-                      (string-append "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-                                     "ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞ")
-                      char-set:lower-case))))
+    (char-set<= (string->char-set
+                 (string-append "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+                                "ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞ")
+                 char-set:lower-case)))
 
   (pass-if "char-set:title-case"
-     (if (not %latin1)
-        (throw 'unresolved)
-         (char-set<= (string->char-set "")
-                     char-set:title-case)))
+    (char-set<= (string->char-set "")
+                char-set:title-case))
 
   (pass-if "char-set:letter"
-     (if (not %latin1)
-        (throw 'unresolved)
-         (char-set<= (string->char-set
-                      (string-append 
-                       ;; Lowercase
-                       "abcdefghijklmnopqrstuvwxyz" 
-                       "µßàáâãäåæçèéêëìíîïðñòóôõöøùúûüýþÿ"
-                       ;; Uppercase
-                       "ABCDEFGHIJKLMNOPQRSTUVWXYZ" 
-                       "ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞ"
-                       ;; Uncased
-                       "ªº")) 
-                     char-set:letter)))
+    (char-set<= (string->char-set
+                 (string-append 
+                  ;; Lowercase
+                  "abcdefghijklmnopqrstuvwxyz" 
+                  "µßàáâãäåæçèéêëìíîïðñòóôõöøùúûüýþÿ"
+                  ;; Uppercase
+                  "ABCDEFGHIJKLMNOPQRSTUVWXYZ" 
+                  "ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞ"
+                  ;; Uncased
+                  "ªº")) 
+                char-set:letter))
   
   (pass-if "char-set:digit"
-     (if (not %latin1)
-        (throw 'unresolved)
-         (char-set<= (string->char-set "0123456789")
-                     char-set:digit)))
+    (char-set<= (string->char-set "0123456789")
+                char-set:digit))
 
   (pass-if "char-set:hex-digit"
-     (if (not %latin1)
-        (throw 'unresolved)
-         (char-set<= (string->char-set "0123456789abcdefABCDEF")
-                     char-set:hex-digit)))
+    (char-set<= (string->char-set "0123456789abcdefABCDEF")
+                char-set:hex-digit))
 
   (pass-if "char-set:letter+digit"
-     (if (not %latin1)
-        (throw 'unresolved)
-         (char-set<= (char-set-union
-                      char-set:letter
-                      char-set:digit)
-                     char-set:letter+digit)))
+    (char-set<= (char-set-union
+                 char-set:letter
+                 char-set:digit)
+                char-set:letter+digit))
 
   (pass-if "char-set:punctuation"
-     (if (not %latin1)
-        (throw 'unresolved)
-         (char-set<= (string->char-set 
-                      (string-append "!\"#%&'()*,-./:;address@hidden"
-                                     "¡«·»¿"))
-                     char-set:punctuation)))
+    (char-set<= (string->char-set 
+                 (string-append "!\"#%&'()*,-./:;address@hidden"
+                                "¡«·»¿"))
+                char-set:punctuation))
 
   (pass-if "char-set:symbol"
-     (if (not %latin1)
-        (throw 'unresolved)
-         (char-set<= (string->char-set 
-                      (string-append "$+<=>^`|~"
-                                     "¢£¤¥¦§¨©¬®¯°±´¶¸×÷"))
-                     char-set:symbol)))
+    (char-set<= (string->char-set 
+                 (string-append "$+<=>^`|~"
+                                "¢£¤¥¦§¨©¬®¯°±´¶¸×÷"))
+                char-set:symbol))
 
   ;; Note that SRFI-14 itself is inconsistent here.  Characters that
   ;; are non-digit numbers (such as category No) are clearly 'graphic'
   ;; but don't occur in the letter, digit, punct, or symbol charsets.
   (pass-if "char-set:graphic"
-     (if (not %latin1)
-        (throw 'unresolved)
-         (char-set<= (char-set-union
-                      char-set:letter
-                      char-set:digit
-                      char-set:punctuation
-                      char-set:symbol)
-                     char-set:graphic)))
+    (char-set<= (char-set-union
+                 char-set:letter
+                 char-set:digit
+                 char-set:punctuation
+                 char-set:symbol)
+                char-set:graphic))
 
   (pass-if "char-set:whitespace"
-     (if (not %latin1)
-        (throw 'unresolved)
-         (char-set<= (string->char-set 
-                      (string
-                       (integer->char #x09)
-                       (integer->char #x0a)
-                       (integer->char #x0b)
-                       (integer->char #x0c)
-                       (integer->char #x0d)
-                       (integer->char #x20)
-                       (integer->char #xa0)))
-                     char-set:whitespace)))
+    (char-set<= (string->char-set 
+                 (string
+                  (integer->char #x09)
+                  (integer->char #x0a)
+                  (integer->char #x0b)
+                  (integer->char #x0c)
+                  (integer->char #x0d)
+                  (integer->char #x20)
+                  (integer->char #xa0)))
+                char-set:whitespace))
                                   
   (pass-if "char-set:printing"
-     (if (not %latin1)
-        (throw 'unresolved)
-         (char-set<= (char-set-union char-set:graphic char-set:whitespace)
-                     char-set:printing)))
+    (char-set<= (char-set-union char-set:graphic char-set:whitespace)
+                char-set:printing))
 
   (pass-if "char-set:iso-control"
-     (if (not %latin1)
-        (throw 'unresolved)
-         (char-set<= (string->char-set 
-                      (apply string 
-                             (map integer->char (append 
-                                                 ;; U+0000 to U+001F
-                                                 (iota #x20)
-                                                 (list #x7f)
-                                                 ;; U+007F to U+009F
-                                                 (map (lambda (x) (+ #x80 x))
-                                                      (iota #x20))))))
-                     char-set:iso-control))))
-
+    (char-set<= (string->char-set 
+                 (apply string 
+                        (map integer->char (append 
+                                            ;; U+0000 to U+001F
+                                            (iota #x20)
+                                            (list #x7f)
+                                            ;; U+007F to U+009F
+                                            (map (lambda (x) (+ #x80 x))
+                                                 (iota #x20))))))
+                char-set:iso-control)))
+
+(if (defined? 'setlocale)
+    (setlocale LC_ALL oldlocale))


hooks/post-receive
-- 
GNU Guile




reply via email to

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