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

Improve handling of locales in the test suite.

Browse source 
* test-suite/guile-test (run-tests): Load each test file within
  (with-locale "C" ...).

* test-suite/tests/encoding-iso88591.test:
* test-suite/tests/encoding-iso88597.test:
* test-suite/tests/encoding-utf8.test:
* test-suite/tests/srfi-14.test: Remove broken code to save and restore
  the previous locale.

* test-suite/tests/bytevectors.test:
* test-suite/tests/format.test:
* test-suite/tests/regexp.test:
* test-suite/tests/srfi-19.test:
* test-suite/tests/tree-il.test: Make sure 'setlocale' is defined before
  calling it.
This commit is contained in:
Mark H Weaver 2014-02-07 21:42:28 -05:00
parent 495cea0c93
commit 0ce224594a
10 changed files with 38 additions and 44 deletions
Download patch file Download diff file Expand all files Collapse all files

8
test-suite/guile-test
View file

@ -5,7 +5,7 @@
;;;; guile-test --- run the Guile test suite
;;;; Jim Blandy <jimb@red-bean.com> --- May 1999
;;;;
;;;; Copyright (C) 1999, 2001, 2006, 2010 Free Software Foundation, Inc.
;;;; Copyright (C) 1999, 2001, 2006, 2010, 2014 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
@ -239,8 +239,9 @@
(lambda ()
(for-each (lambda (test)
(display (string-append "Running " test "\n"))
(with-test-prefix test
(load (test-file-name test))))
(with-locale "C"
(with-test-prefix test
(load (test-file-name test)))))
tests))))
(if (opt 'coverage #f)
(let-values (((coverage-data _)
@ -262,4 +263,5 @@
;;; Local Variables:
;;; mode: scheme
;;; eval: (put 'with-locale 'scheme-indent-function 1)
;;; End:

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

@ -1,6 +1,8 @@
;;;; bytevectors.test --- R6RS bytevectors. -*- mode: scheme; coding: utf-8; -*-
;;;;
;;;; Copyright (C) 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
;;;; Copyright (C) 2009, 2010, 2011, 2012, 2013,
;;;; 2014 Free Software Foundation, Inc.
;;;;
;;;; Ludovic Courtès
;;;;
;;;; This library is free software; you can redistribute it and/or
@ -398,7 +400,8 @@
;; Default to the C locale for the following tests.
(setlocale LC_ALL "C")
(when (defined? 'setlocale)
(setlocale LC_ALL "C"))
(with-test-prefix "2.9 Operations on Strings"

11
test-suite/tests/encoding-iso88591.test
View file

@ -1,6 +1,6 @@
;;;; encoding-iso88591.test --- test suite for Guile's string encodings -*- mode: scheme; coding: iso-8859-1 -*-
;;;;
;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;;;; Copyright (C) 2009, 2010, 2014 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
@ -25,9 +25,8 @@
(apply string (map integer->char args)))
;; Set locale to the environment's locale, so that the prints look OK.
(define oldlocale #f)
(if (defined? 'setlocale)
(set! oldlocale (setlocale LC_ALL "")))
(when (defined? 'setlocale)
(setlocale LC_ALL ""))
(define ascii-a (integer->char 65)) ; LATIN CAPITAL LETTER A
(define a-acute (integer->char #x00c1)) ; LATIN CAPITAL LETTER A WITH ACUTE
@ -177,7 +176,3 @@
(set-port-encoding! pt "ISO-8859-1")
(set-port-conversion-strategy! pt 'error)
(display (string-ints 256) pt))))
;; Reset locales
(if (defined? 'setlocale)
(setlocale LC_ALL oldlocale))

12
test-suite/tests/encoding-iso88597.test
View file

@ -1,6 +1,6 @@
;;;; encoding-iso88697.test --- test suite for Guile's string encodings -*- mode: scheme; coding: iso-8859-7 -*-
;;;;
;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;;;; Copyright (C) 2009, 2010, 2014 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
@ -24,9 +24,9 @@
(define (string-ints . args)
(apply string (map integer->char args)))
(define oldlocale #f)
(if (defined? 'setlocale)
(set! oldlocale (setlocale LC_ALL "")))
(when (defined? 'setlocale)
(setlocale LC_ALL ""))
(define ascii-a (integer->char 65)) ; LATIN CAPITAL LETTER A
(define a-acute (integer->char #x00c1)) ; LATIN CAPITAL LETTER A WITH ACUTE
(define alpha (integer->char #x03b1)) ; GREEK SMALL LETTER ALPHA
@ -167,7 +167,3 @@
(set-port-encoding! pt "ISO-8859-7")
(set-port-conversion-strategy! pt 'error)
(display (string-ints #x0400) pt))))
;; Reset locale
(if (defined? 'setlocale)
(setlocale LC_ALL oldlocale))

10
test-suite/tests/encoding-utf8.test
View file

@ -1,6 +1,6 @@
;;;; encoding-utf8.test --- test suite for Guile's string encodings -*- mode: scheme; coding: utf-8 -*-
;;;;
;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;;;; Copyright (C) 2009, 2010, 2014 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
@ -24,9 +24,8 @@
(define (string-ints . args)
(apply string (map integer->char args)))
(define oldlocale #f)
(if (defined? 'setlocale)
(set! oldlocale (setlocale LC_ALL "")))
(when (defined? 'setlocale)
(setlocale LC_ALL ""))
(define ascii-a (integer->char 65)) ; LATIN CAPITAL LETTER A
(define a-acute (integer->char #x00c1)) ; LATIN CAPITAL LETTER A WITH ACUTE
@ -189,6 +188,3 @@
(let ((芥川龍之介 1)
(ñ 2))
(eqv? (+ 芥川龍之介 ñ) 3))))
(if (defined? 'setlocale)
(setlocale LC_ALL oldlocale))

7
test-suite/tests/format.test
View file

@ -1,7 +1,8 @@
;;;; format.test --- test suite for Guile's CL-ish format -*- scheme -*-
;;;; Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de> --- June 2001
;;;;
;;;; Copyright (C) 2001, 2003, 2004, 2006, 2010, 2011, 2012 Free Software Foundation, Inc.
;;;; Copyright (C) 2001, 2003, 2004, 2006, 2010, 2011, 2012,
;;;; 2014 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
@ -101,7 +102,9 @@
;;; ~h
;;;
(setlocale LC_ALL "C")
(when (defined? 'setlocale)
(setlocale LC_ALL "C"))
(with-test-prefix "~h localized number"
(pass-if "1234.5"

6
test-suite/tests/regexp.test
View file

@ -2,7 +2,7 @@
;;;; Jim Blandy <jimb@red-bean.com> --- September 1999
;;;;
;;;; Copyright (C) 1999, 2004, 2006, 2007, 2008, 2009, 2010,
;;;; 2012, 2013 Free Software Foundation, Inc.
;;;; 2012, 2013, 2014 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
@ -23,8 +23,8 @@
#:use-module (srfi srfi-1)
#:use-module (ice-9 regex))
(if (defined? 'setlocale)
(setlocale LC_ALL "C"))
(when (defined? 'setlocale)
(setlocale LC_ALL "C"))
;; Don't fail if we can't display a test name to stdout/stderr.
(set-port-conversion-strategy! (current-output-port) 'escape)

10
test-suite/tests/srfi-14.test
View file

@ -2,7 +2,7 @@
;;;; --- Test suite for Guile's SRFI-14 functions.
;;;; Martin Grabmueller, 2001-07-16
;;;;
;;;; Copyright (C) 2001, 2006, 2009, 2010 Free Software Foundation, Inc.
;;;; Copyright (C) 2001, 2006, 2009, 2010, 2014 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
@ -745,9 +745,8 @@
(define (every? pred lst)
(not (not (every pred lst))))
(define oldlocale #f)
(if (defined? 'setlocale)
(set! oldlocale (setlocale LC_ALL "")))
(when (defined? 'setlocale)
(setlocale LC_ALL ""))
(with-test-prefix "Latin-1 (8-bit charset)"
@ -844,6 +843,3 @@
(map (lambda (x) (+ #x80 x))
(iota #x20))))))
char-set:iso-control)))
(if (defined? 'setlocale)
(setlocale LC_ALL oldlocale))

5
test-suite/tests/srfi-19.test
View file

@ -2,7 +2,7 @@
;;;; Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de> --- June 2001
;;;;
;;;; Copyright (C) 2001, 2003, 2004, 2005, 2006, 2007, 2008,
;;;; 2011 Free Software Foundation, Inc.
;;;; 2011, 2014 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
@ -28,7 +28,8 @@
:use-module (ice-9 format))
;; Make sure we use the default locale.
(setlocale LC_ALL "C")
(when (defined? 'setlocale)
(setlocale LC_ALL "C"))
(define (with-tz* tz thunk)
"Temporarily set the TZ environment variable to the passed string

6
test-suite/tests/tree-il.test
View file

@ -1,7 +1,8 @@
;;;; tree-il.test --- test suite for compiling tree-il -*- scheme -*-
;;;; Andy Wingo <wingo@pobox.com> --- May 2009
;;;;
;;;; Copyright (C) 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
;;;; Copyright (C) 2009, 2010, 2011, 2012, 2013,
;;;; 2014 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
@ -766,7 +767,8 @@
;;;
;; Make sure we get English messages.
(setlocale LC_ALL "C")
(when (defined? 'setlocale)
(setlocale LC_ALL "C"))
(define (call-with-warnings thunk)
(let ((port (open-output-string)))