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

Move Latin-1 locale fiddling to `(test-suite lib)'.

Browse source 
* 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.
This commit is contained in:
Ludovic Courtès 2010-03-04 00:39:18 +01:00
parent f5147c84a2
commit c45de346fd
2 changed files with 40 additions and 47 deletions
Download patch file Download diff file Expand all files Collapse all files

32
test-suite/lib.scm
View file

@ -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?
@ -472,6 +473,33 @@ with-locale with-locale*
((_ 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
;;;;

55
test-suite/tests/bytevectors.test
View file

@ -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