[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.5-22-gb4af80
|
From: |
Ludovic Courtès |
|
Subject: |
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.5-22-gb4af80a |
|
Date: |
Fri, 03 Feb 2012 16:12:48 +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=b4af80a4231c1b2296a3ee8397fdbb975692ed75
The branch, stable-2.0 has been updated
via b4af80a4231c1b2296a3ee8397fdbb975692ed75 (commit)
via afd08fdf87caa499abf3423c663eb44be57cceb9 (commit)
via c76fdf69a833378ce18228d242e926009df9add1 (commit)
via a0919aefee7512686c3374876df2c549fd47e071 (commit)
from eb4a14ed47a34e03566261b02c77bfcc02b20134 (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 b4af80a4231c1b2296a3ee8397fdbb975692ed75
Author: Ludovic Courtès <address@hidden>
Date: Fri Feb 3 16:52:15 2012 +0100
Augment `-Wformat' analysis with support for `~:h'.
* module/language/tree-il/analyze.scm (format-string-argument-count):
Add support for ~h.
* test-suite/tests/tree-il.test ("warnings")["format"]("~h", "~:h with
locale object", "~:h without locale object"): New tests.
commit afd08fdf87caa499abf3423c663eb44be57cceb9
Author: Ludovic Courtès <address@hidden>
Date: Fri Feb 3 16:35:06 2012 +0100
format: Add specifier ~h for localized number output.
* doc/ref/misc-modules.texi (Formatted Output): Document ~h. Recommend
use of ~h instead of ~:d.
* module/ice-9/format.scm (format): Add support for ~h.
* test-suite/tests/format.test ("~h localized number"): New test prefix.
* test-suite/tests/i18n.test (%american-english-locale-name,
%american-english-locale): New variables.
(under-american-english-locale-or-unresolved): New procedure.
("format ~h"): New test prefix.
commit c76fdf69a833378ce18228d242e926009df9add1
Author: Ludovic Courtès <address@hidden>
Date: Fri Feb 3 14:31:17 2012 +0100
i18n: Add a couple of tests for `monetary-amount->locale-string'.
* test-suite/tests/i18n.test ("monetary-amount->locale-string"): New
test prefix.
commit a0919aefee7512686c3374876df2c549fd47e071
Author: Ludovic Courtès <address@hidden>
Date: Fri Feb 3 14:05:31 2012 +0100
i18n: Use Gnulib's `nl_langinfo' module.
* configure.ac: Remove checks for <langinfo.h> and <nl_types.h>, and
`nl_langinfo'.
* libguile/i18n.c: Remove #ifdefs for HAVE_LANGINFO_H, HAVE_NL_TYPES_H,
HAVE_NL_ITEM, and HAVE_LANGINFO_CODESET.
(SCM_VALIDATE_OPTIONAL_LOCALE_COPY): Use `SCM_UNBNDP'.
* m4/gnulib-cache.m4 (gl_MODULES): Add `nl_langinfo'.
* module/ice-9/i18n.scm (define-vector-langinfo-mapping): Remove
`defaults' parameter; assume (provided? 'nl-langinfo) is always true.
Update users accordingly.
(define-simple-langinfo-mapping): Likewise.
(define-monetary-langinfo-mapping): Likewise, but do not assume
LOCAL-ITEM and INTL-ITEM are always defined.
-----------------------------------------------------------------------
Summary of changes:
configure.ac | 16 +-----
doc/ref/misc-modules.texi | 29 ++++++++++-
lib/Makefile.am | 2 +-
libguile/i18n.c | 41 +--------------
m4/gnulib-cache.m4 | 3 +-
module/ice-9/format.scm | 21 ++++++++-
module/ice-9/i18n.scm | 91 ++++++++++++++++-------------------
module/language/tree-il/analyze.scm | 8 +++-
test-suite/tests/format.test | 28 ++++++++++-
test-suite/tests/i18n.test | 56 ++++++++++++++++++++-
test-suite/tests/tree-il.test | 26 ++++++++++
11 files changed, 210 insertions(+), 111 deletions(-)
diff --git a/configure.ac b/configure.ac
index 5ee942c..66d735e 100644
--- a/configure.ac
+++ b/configure.ac
@@ -652,24 +652,13 @@ AC_SUBST([SCM_I_GSC_HAVE_STRUCT_DIRENT64])
# machine/fpu.h - on Tru64 5.1b, the declaration of fesetround(3) is in
# this file instead of <fenv.h>
# process.h - mingw specific
-# langinfo.h, nl_types.h - SuS v2
# sched.h - missing on MinGW
#
AC_CHECK_HEADERS([complex.h fenv.h io.h libc.h limits.h memory.h process.h
string.h \
sys/dir.h sys/ioctl.h sys/select.h \
sys/time.h sys/timeb.h sys/times.h sys/stdtypes.h sys/types.h \
sys/utime.h time.h unistd.h utime.h pwd.h grp.h sys/utsname.h \
-direct.h langinfo.h nl_types.h machine/fpu.h poll.h sched.h])
-
-# Reasons for testing:
-# nl_item - lacking on Cygwin
-AC_CHECK_TYPES([nl_item], [], [],
- [[#ifdef HAVE_LANGINFO_H
- # include <langinfo.h>
- #endif
- #ifdef HAVE_NL_TYPES_H
- # include <nl_types.h>
- #endif]])
+direct.h machine/fpu.h poll.h sched.h])
# "complex double" is new in C99, and "complex" is only a keyword if
# <complex.h> is included
@@ -764,11 +753,10 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
# isblank - available as a GNU extension or in C99
# _NSGetEnviron - Darwin specific
# strcoll_l, newlocale - GNU extensions (glibc), also available on Darwin
-# nl_langinfo - X/Open, not available on Windows.
# utimensat: posix.1-2008
# sched_getaffinity, sched_setaffinity: GNU extensions (glibc)
#
-AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid fesetround
ftime ftruncate fchown getcwd geteuid getsid gettimeofday gmtime_r ioctl lstat
mkdir mknod nice pipe _pipe poll readdir_r readdir64_r readlink rename rmdir
select setegid seteuid setlocale setpgid setsid sigaction siginterrupt stat64
strftime strptime symlink sync sysconf tcgetpgrp tcsetpgrp times uname waitpid
strdup system usleep atexit on_exit chown link fcntl ttyname getpwent getgrent
kill getppid getpgrp fork setitimer getitimer strchr strcmp index bcopy memcpy
rindex truncate unsetenv isblank _NSGetEnviron strcoll strcoll_l newlocale
nl_langinfo utimensat sched_getaffinity sched_setaffinity])
+AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid fesetround
ftime ftruncate fchown getcwd geteuid getsid gettimeofday gmtime_r ioctl lstat
mkdir mknod nice pipe _pipe poll readdir_r readdir64_r readlink rename rmdir
select setegid seteuid setlocale setpgid setsid sigaction siginterrupt stat64
strftime strptime symlink sync sysconf tcgetpgrp tcsetpgrp times uname waitpid
strdup system usleep atexit on_exit chown link fcntl ttyname getpwent getgrent
kill getppid getpgrp fork setitimer getitimer strchr strcmp index bcopy memcpy
rindex truncate unsetenv isblank _NSGetEnviron strcoll strcoll_l newlocale
utimensat sched_getaffinity sched_setaffinity])
# Reasons for testing:
# netdb.h - not in mingw
diff --git a/doc/ref/misc-modules.texi b/doc/ref/misc-modules.texi
index 2a6630c..022b7cb 100644
--- a/doc/ref/misc-modules.texi
+++ b/doc/ref/misc-modules.texi
@@ -269,7 +269,7 @@ Integer. Parameters: @var{minwidth}, @var{padchar},
@var{commachar},
@var{commawidth}.
Output an integer argument as a decimal, hexadecimal, octal or binary
-integer (respectively).
+integer (respectively), in a locale-independent way.
@example
(format #t "~d" 123) @print{} 123
@@ -297,7 +297,9 @@ minimum), it's padded on the left with the @var{padchar}
parameter
@end example
@nicode{~:d} adds commas (or the @var{commachar} parameter) every
-three digits (or the @var{commawidth} parameter many).
+three digits (or the @var{commawidth} parameter many). However, when
+your intent is to write numbers in a way that follows typographical
+conventions, using @nicode{~h} is recommended.
@example
(format #t "~:d" 1234567) @print{} 1,234,567
@@ -404,6 +406,29 @@ printed instead of the value.
(format #t "~5,,,'xf" 12345) @print{} xxxxx
@end example
address@hidden @nicode{~h}
+Localized address@hidden @nicode{~h} format specifier first
+appeared in Guile version 2.0.6.}. Parameters: @var{width},
address@hidden, @var{padchar}.
+
+Like @nicode{~f}, output an exact or floating point number, but do so
+according to the current locale, or according to the given locale object
+when the @code{:} modifier is used (@pxref{Number Input and Output,
address@hidden>locale-string}}).
+
address@hidden
+(format #t "~h" 12345.5678) ; with "C" as the current locale
address@hidden 12345.5678
+
+(format #t "~14,,'*:h" 12345.5678
+ (make-locale LC_ALL "en_US"))
address@hidden ***12,345.5678
+
+(format #t "~,2:h" 12345.5678
+ (make-locale LC_NUMERIC "fr_FR"))
address@hidden 12 345,56
address@hidden example
+
@item @nicode{~e}
Exponential float. Parameters: @var{width}, @var{mantdigits},
@var{expdigits}, @var{intdigits}, @var{overflowchar}, @var{padchar},
diff --git a/lib/Makefile.am b/lib/Makefile.am
index 17fb5b4..ab5f2d1 100644
--- a/lib/Makefile.am
+++ b/lib/Makefile.am
@@ -21,7 +21,7 @@
# the same distribution terms as the rest of that program.
#
# Generated by gnulib-tool.
-# Reproduce by: gnulib-tool --import --dir=. --local-dir=gnulib-local
--lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests
--aux-dir=build-aux --lgpl=3 --no-conditional-dependencies --libtool
--macro-prefix=gl --no-vc-files accept alignof alloca-opt announce-gen
autobuild bind byteswap canonicalize-lgpl ceil close connect dirfd duplocale
environ extensions flock floor fpieee frexp full-read full-write func gendocs
getaddrinfo getpeername getsockname getsockopt git-version-gen
gitlog-to-changelog gnu-web-doc-update gnupload havelib iconv_open-utf
inet_ntop inet_pton isinf isnan ldexp lib-symbol-versions lib-symbol-visibility
libunistring listen localcharset locale log1p maintainer-makefile malloc-gnu
malloca nproc open pipe2 putenv recv recvfrom regex rename send sendto setenv
setsockopt shutdown socket stat-time stdlib strftime striconveh string sys_stat
trunc verify vsnprintf warnings wchar
+# Reproduce by: gnulib-tool --import --dir=. --local-dir=gnulib-local
--lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests
--aux-dir=build-aux --lgpl=3 --no-conditional-dependencies --libtool
--macro-prefix=gl --no-vc-files accept alignof alloca-opt announce-gen
autobuild bind byteswap canonicalize-lgpl ceil close connect dirfd duplocale
environ extensions flock floor fpieee frexp full-read full-write func gendocs
getaddrinfo getpeername getsockname getsockopt git-version-gen
gitlog-to-changelog gnu-web-doc-update gnupload havelib iconv_open-utf
inet_ntop inet_pton isinf isnan ldexp lib-symbol-versions lib-symbol-visibility
libunistring listen localcharset locale log1p maintainer-makefile malloc-gnu
malloca nl_langinfo nproc open pipe2 putenv recv recvfrom regex rename send
sendto setenv setsockopt shutdown socket stat-time stdlib strftime striconveh
string sys_stat trunc verify vsnprintf warnings wchar
AUTOMAKE_OPTIONS = 1.5 gnits subdir-objects
diff --git a/libguile/i18n.c b/libguile/i18n.c
index 5a53bfa..057711f 100644
--- a/libguile/i18n.c
+++ b/libguile/i18n.c
@@ -59,16 +59,8 @@
#include "libguile/posix.h" /* for `scm_i_locale_mutex' */
-#ifdef HAVE_LANGINFO_H
-# include <langinfo.h>
-#endif
-#ifdef HAVE_NL_TYPES_H
-# include <nl_types.h>
-#endif
-#ifndef HAVE_NL_ITEM
-/* Cygwin has <langinfo.h> but lacks <nl_types.h> and `nl_item'. */
-typedef int nl_item;
-#endif
+/* Use Gnulib's header, which also provides `nl_item' & co. */
+#include <langinfo.h>
#ifndef HAVE_SETLOCALE
static inline char *
@@ -223,7 +215,7 @@ SCM_GLOBAL_VARIABLE (scm_global_locale, "%global-locale");
#define SCM_VALIDATE_OPTIONAL_LOCALE_COPY(_pos, _arg, _c_locale) \
do \
{ \
- if (!scm_is_eq ((_arg), SCM_UNDEFINED)) \
+ if (!SCM_UNBNDP (_arg)) \
SCM_VALIDATE_LOCALE_COPY (_pos, _arg, _c_locale); \
else \
(_c_locale) = NULL; \
@@ -1481,14 +1473,11 @@ SCM_DEFINE (scm_nl_langinfo, "nl-langinfo", 1, 1, 0,
"Reference Manual}).")
#define FUNC_NAME s_scm_nl_langinfo
{
-#ifdef HAVE_NL_LANGINFO
SCM result;
nl_item c_item;
char *c_result;
scm_t_locale c_locale;
-#ifdef HAVE_LANGINFO_CODESET
char *codeset;
-#endif
SCM_VALIDATE_INT_COPY (2, item, c_item);
SCM_VALIDATE_OPTIONAL_LOCALE_COPY (2, locale, c_locale);
@@ -1505,9 +1494,7 @@ SCM_DEFINE (scm_nl_langinfo, "nl-langinfo", 1, 1, 0,
{
#ifdef USE_GNU_LOCALE_API
c_result = nl_langinfo_l (c_item, c_locale);
-#ifdef HAVE_LANGINFO_CODESET
codeset = nl_langinfo_l (CODESET, c_locale);
-#endif /* HAVE_LANGINFO_CODESET */
#else /* !USE_GNU_LOCALE_API */
/* We can't use `RUN_IN_LOCALE_SECTION ()' here because the locale
mutex is already taken. */
@@ -1532,9 +1519,7 @@ SCM_DEFINE (scm_nl_langinfo, "nl-langinfo", 1, 1, 0,
else
{
c_result = nl_langinfo (c_item);
-#ifdef HAVE_LANGINFO_CODESET
codeset = nl_langinfo (CODESET);
-#endif /* HAVE_LANGINFO_CODESET */
restore_locale_settings (&lsec_prev_locale);
free_locale_settings (&lsec_prev_locale);
@@ -1544,9 +1529,7 @@ SCM_DEFINE (scm_nl_langinfo, "nl-langinfo", 1, 1, 0,
else
{
c_result = nl_langinfo (c_item);
-#ifdef HAVE_LANGINFO_CODESET
codeset = nl_langinfo (CODESET);
-#endif /* HAVE_LANGINFO_CODESET */
}
c_result = strdup (c_result);
@@ -1659,26 +1642,14 @@ SCM_DEFINE (scm_nl_langinfo, "nl-langinfo", 1, 1, 0,
#endif
default:
-#ifdef HAVE_LANGINFO_CODESET
result = scm_from_stringn (c_result, strlen (c_result),
codeset,
SCM_FAILED_CONVERSION_QUESTION_MARK);
-#else /* !HAVE_LANGINFO_CODESET */
- /* This may be incorrectly encoded if the locale differs
- from the c_locale. */
- result = scm_from_locale_string (c_result);
-#endif /* !HAVE_LANGINFO_CODESET */
free (c_result);
}
}
return result;
-#else
- scm_syserror_msg (FUNC_NAME, "`nl-langinfo' not supported on your system",
- SCM_EOL, ENOSYS);
-
- return SCM_BOOL_F;
-#endif
}
#undef FUNC_NAME
@@ -1686,8 +1657,6 @@ SCM_DEFINE (scm_nl_langinfo, "nl-langinfo", 1, 1, 0,
static inline void
define_langinfo_items (void)
{
-#ifdef HAVE_LANGINFO_H
-
#define DEFINE_NLITEM_CONSTANT(_item) \
scm_c_define (# _item, scm_from_int (_item))
@@ -1852,8 +1821,6 @@ define_langinfo_items (void)
#endif
#undef DEFINE_NLITEM_CONSTANT
-
-#endif /* HAVE_NL_TYPES_H */
}
@@ -1862,10 +1829,8 @@ scm_init_i18n ()
{
SCM global_locale_smob;
-#ifdef HAVE_NL_LANGINFO
scm_add_feature ("nl-langinfo");
define_langinfo_items ();
-#endif
#include "libguile/i18n.x"
diff --git a/m4/gnulib-cache.m4 b/m4/gnulib-cache.m4
index 4ab00dd..7b6644a 100644
--- a/m4/gnulib-cache.m4
+++ b/m4/gnulib-cache.m4
@@ -27,7 +27,7 @@
# Specification in the form of a command-line invocation:
-# gnulib-tool --import --dir=. --local-dir=gnulib-local --lib=libgnu
--source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests
--aux-dir=build-aux --lgpl=3 --no-conditional-dependencies --libtool
--macro-prefix=gl --no-vc-files accept alignof alloca-opt announce-gen
autobuild bind byteswap canonicalize-lgpl ceil close connect dirfd duplocale
environ extensions flock floor fpieee frexp full-read full-write func gendocs
getaddrinfo getpeername getsockname getsockopt git-version-gen
gitlog-to-changelog gnu-web-doc-update gnupload havelib iconv_open-utf
inet_ntop inet_pton isinf isnan ldexp lib-symbol-versions lib-symbol-visibility
libunistring listen localcharset locale log1p maintainer-makefile malloc-gnu
malloca nproc open pipe2 putenv recv recvfrom regex rename send sendto setenv
setsockopt shutdown socket stat-time stdlib strftime striconveh string sys_stat
trunc verify vsnprintf warnings wchar
+# gnulib-tool --import --dir=. --local-dir=gnulib-local --lib=libgnu
--source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests
--aux-dir=build-aux --lgpl=3 --no-conditional-dependencies --libtool
--macro-prefix=gl --no-vc-files accept alignof alloca-opt announce-gen
autobuild bind byteswap canonicalize-lgpl ceil close connect dirfd duplocale
environ extensions flock floor fpieee frexp full-read full-write func gendocs
getaddrinfo getpeername getsockname getsockopt git-version-gen
gitlog-to-changelog gnu-web-doc-update gnupload havelib iconv_open-utf
inet_ntop inet_pton isinf isnan ldexp lib-symbol-versions lib-symbol-visibility
libunistring listen localcharset locale log1p maintainer-makefile malloc-gnu
malloca nl_langinfo nproc open pipe2 putenv recv recvfrom regex rename send
sendto setenv setsockopt shutdown socket stat-time stdlib strftime striconveh
string sys_stat trunc verify vsnprintf warnings wchar
# Specification in the form of a few gnulib-tool.m4 macro invocations:
gl_LOCAL_DIR([gnulib-local])
@@ -80,6 +80,7 @@ gl_MODULES([
maintainer-makefile
malloc-gnu
malloca
+ nl_langinfo
nproc
open
pipe2
diff --git a/module/ice-9/format.scm b/module/ice-9/format.scm
index c62348d..d038ace 100644
--- a/module/ice-9/format.scm
+++ b/module/ice-9/format.scm
@@ -1,5 +1,5 @@
;;;; "format.scm" Common LISP text output formatter for SLIB
-;;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+;;; Copyright (C) 2010, 2011, 2012 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
@@ -31,6 +31,7 @@
(define-module (ice-9 format)
#:autoload (ice-9 pretty-print) (pretty-print truncated-print)
+ #:autoload (ice-9 i18n) (%global-locale number->locale-string)
#:replace (format))
(define format:version "3.0")
@@ -272,6 +273,24 @@
((#\D) ; Decimal
(format:out-num-padded modifier (next-arg) params 10)
(anychar-dispatch))
+ ((#\H) ; Localized number
+ (let* ((num (next-arg))
+ (locale (case modifier
+ ((colon) (next-arg))
+ (else %global-locale)))
+ (argc (length params))
+ (width (format:par params argc 0 #f "width"))
+ (decimals (format:par params argc 1 #t "decimals"))
+ (padchar (integer->char
+ (format:par params argc 2 format:space-ch
+ "padchar")))
+ (str (number->locale-string num decimals
+ locale)))
+ (format:out-str (if (and width
+ (< (string-length str) width))
+ (string-pad str width padchar)
+ str)))
+ (anychar-dispatch))
((#\X) ; Hexadecimal
(format:out-num-padded modifier (next-arg) params 16)
(anychar-dispatch))
diff --git a/module/ice-9/i18n.scm b/module/ice-9/i18n.scm
index ce04aa3..c574a7e 100644
--- a/module/ice-9/i18n.scm
+++ b/module/ice-9/i18n.scm
@@ -1,6 +1,6 @@
;;;; i18n.scm --- internationalization support -*- coding: utf-8 -*-
-;;;; Copyright (C) 2006, 2007, 2009, 2010 Free Software Foundation, Inc.
+;;;; Copyright (C) 2006, 2007, 2009, 2010, 2012 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,13 +101,10 @@
;;;
;; Helper macro: Define a procedure named NAME that maps its argument to
-;; NL-ITEMS (when `nl-langinfo' is provided) or DEFAULTS (when `nl-langinfo'
-;; is not provided).
-(define-macro (define-vector-langinfo-mapping name nl-items defaults)
+;; NL-ITEMS (when `nl-langinfo' is provided).
+(define-macro (define-vector-langinfo-mapping name nl-items)
(let* ((item-count (length nl-items))
- (defines (if (provided? 'nl-langinfo)
- `(define %nl-items (vector #f ,@nl-items))
- `(define %defaults (vector #f ,@defaults))))
+ (defines `(define %nl-items (vector #f ,@nl-items)))
(make-body (lambda (result)
`(if (and (integer? item) (exact? item))
(if (and (>= item 1) (<= item ,item-count))
@@ -116,28 +113,21 @@
(throw 'wrong-type-arg "wrong argument type"
item)))))
`(define (,name item . locale)
,defines
- ,(make-body (if (provided? 'nl-langinfo)
- '(apply nl-langinfo (vector-ref %nl-items item) locale)
- '(vector-ref %defaults item))))))
+ ,(make-body '(apply nl-langinfo (vector-ref %nl-items item) locale)))))
(define-vector-langinfo-mapping locale-day-short
- (ABDAY_1 ABDAY_2 ABDAY_3 ABDAY_4 ABDAY_5 ABDAY_6 ABDAY_7)
- ("Sun" "Mon" "Tue" "Wed" "Thu" "Fri" "Sat"))
+ (ABDAY_1 ABDAY_2 ABDAY_3 ABDAY_4 ABDAY_5 ABDAY_6 ABDAY_7))
(define-vector-langinfo-mapping locale-day
- (DAY_1 DAY_2 DAY_3 DAY_4 DAY_5 DAY_6 DAY_7)
- ("Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"))
+ (DAY_1 DAY_2 DAY_3 DAY_4 DAY_5 DAY_6 DAY_7))
(define-vector-langinfo-mapping locale-month-short
(ABMON_1 ABMON_2 ABMON_3 ABMON_4 ABMON_5 ABMON_6
- ABMON_7 ABMON_8 ABMON_9 ABMON_10 ABMON_11 ABMON_12)
- ("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"))
+ ABMON_7 ABMON_8 ABMON_9 ABMON_10 ABMON_11 ABMON_12))
(define-vector-langinfo-mapping locale-month
- (MON_1 MON_2 MON_3 MON_4 MON_5 MON_6 MON_7 MON_8 MON_9 MON_10 MON_11 MON_12)
- ("January" "February" "March" "April" "May" "June" "July" "August"
- "September" "October" "November" "December"))
+ (MON_1 MON_2 MON_3 MON_4 MON_5 MON_6 MON_7 MON_8 MON_9 MON_10 MON_11 MON_12))
@@ -145,36 +135,34 @@
;;; Date and time.
;;;
-;; Helper macro: Define a procedure NAME that gets langinfo item ITEM.
-(define-macro (define-simple-langinfo-mapping name item default)
- (let ((body (if (and (provided? 'nl-langinfo) (defined? item))
- `(apply nl-langinfo ,item locale)
- default)))
- `(define (,name . locale)
- ,body)))
+;; Define a procedure NAME that gets langinfo item ITEM. Gnulib's
+;; `nl_langinfo' guarantees that all these items are supported.
+(define-syntax-rule (define-simple-langinfo-mapping name item)
+ (define* (name #:optional (locale %global-locale))
+ (nl-langinfo item locale)))
(define-simple-langinfo-mapping locale-am-string
- AM_STR "AM")
+ AM_STR)
(define-simple-langinfo-mapping locale-pm-string
- PM_STR "PM")
+ PM_STR)
(define-simple-langinfo-mapping locale-date+time-format
- D_T_FMT "%a %b %e %H:%M:%S %Y")
+ D_T_FMT)
(define-simple-langinfo-mapping locale-date-format
- D_FMT "%m/%d/%y")
+ D_FMT)
(define-simple-langinfo-mapping locale-time-format
- T_FMT "%H:%M:%S")
+ T_FMT)
(define-simple-langinfo-mapping locale-time+am/pm-format
- T_FMT_AMPM "%I:%M:%S %p")
+ T_FMT_AMPM)
(define-simple-langinfo-mapping locale-era
- ERA "")
+ ERA)
(define-simple-langinfo-mapping locale-era-year
- ERA_YEAR "")
+ ERA_YEAR)
(define-simple-langinfo-mapping locale-era-date+time-format
- ERA_D_T_FMT "")
+ ERA_D_T_FMT)
(define-simple-langinfo-mapping locale-era-date-format
- ERA_D_FMT "")
+ ERA_D_FMT)
(define-simple-langinfo-mapping locale-era-time-format
- ERA_T_FMT "")
+ ERA_T_FMT)
@@ -182,13 +170,18 @@
;;; Monetary information.
;;;
+;; Define a procedure NAME that gets item LOCAL-ITEM or INTL-ITEM,
+;; depending on whether the caller asked for the international version
+;; or not. Since Gnulib's `nl_langinfo' module doesn't guarantee that
+;; all these items are available, use DEFAULT/LOCAL and DEFAULT/INTL as
+;; default values when the system does not support them.
(define-macro (define-monetary-langinfo-mapping name local-item intl-item
default/local default/intl)
(let ((body
- (let ((intl (if (and (provided? 'nl-langinfo) (defined? intl-item))
+ (let ((intl (if (defined? intl-item)
`(apply nl-langinfo ,intl-item locale)
default/intl))
- (local (if (and (provided? 'nl-langinfo) (defined? local-item))
+ (local (if (defined? local-item)
`(apply nl-langinfo ,local-item locale)
default/local)))
`(if intl? ,intl ,local))))
@@ -205,15 +198,15 @@
2 2)
(define-simple-langinfo-mapping locale-monetary-positive-sign
- POSITIVE_SIGN "+")
+ POSITIVE_SIGN)
(define-simple-langinfo-mapping locale-monetary-negative-sign
- NEGATIVE_SIGN "-")
+ NEGATIVE_SIGN)
(define-simple-langinfo-mapping locale-monetary-decimal-point
- MON_DECIMAL_POINT "")
+ MON_DECIMAL_POINT)
(define-simple-langinfo-mapping locale-monetary-thousands-separator
- MON_THOUSANDS_SEP "")
+ MON_THOUSANDS_SEP)
(define-simple-langinfo-mapping locale-monetary-digit-grouping
- MON_GROUPING '())
+ MON_GROUPING)
(define-monetary-langinfo-mapping locale-currency-symbol-precedes-positive?
P_CS_PRECEDES INT_P_CS_PRECEDES
@@ -359,11 +352,11 @@ locale is used."
;;;
(define-simple-langinfo-mapping locale-digit-grouping
- GROUPING '())
+ GROUPING)
(define-simple-langinfo-mapping locale-decimal-point
- RADIXCHAR ".")
+ RADIXCHAR)
(define-simple-langinfo-mapping locale-thousands-separator
- THOUSEP "")
+ THOUSEP)
(define* (number->locale-string number
#:optional (fraction-digits #t)
@@ -409,9 +402,9 @@ number of fractional digits to be displayed."
;;;
(define-simple-langinfo-mapping locale-yes-regexp
- YESEXPR "^[yY]")
+ YESEXPR)
(define-simple-langinfo-mapping locale-no-regexp
- NOEXPR "^[nN]")
+ NOEXPR)
;; `YESSTR' and `NOSTR' are considered deprecated so we don't provide them.
diff --git a/module/language/tree-il/analyze.scm
b/module/language/tree-il/analyze.scm
index 777507c..9bcc92f 100644
--- a/module/language/tree-il/analyze.scm
+++ b/module/language/tree-il/analyze.scm
@@ -1,6 +1,6 @@
;;; TREE-IL -> GLIL compiler
-;; Copyright (C) 2001, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2008, 2009, 2010, 2011, 2012 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
@@ -1328,6 +1328,12 @@ accurate information is missing from a given `tree-il'
element."
;; We don't have enough info to determine the exact number
;; of args, but we could determine a lower bound (TODO).
(values 'any 'any))
+ ((#\h #\H)
+ (let ((argc (if (memq #\: params) 2 1)))
+ (loop (cdr chars) 'literal '()
+ conditions end-group
+ (+ argc min-count)
+ (+ argc max-count))))
(else (loop (cdr chars) 'literal '()
conditions end-group
(+ 1 min-count) (+ 1 max-count)))))
diff --git a/test-suite/tests/format.test b/test-suite/tests/format.test
index 24ad835..a411b49 100644
--- a/test-suite/tests/format.test
+++ b/test-suite/tests/format.test
@@ -1,7 +1,7 @@
;;;; format.test --- test suite for Guile's CL-ish format -*- scheme -*-
;;;; Matthias Koeppe <address@hidden> --- June 2001
;;;;
-;;;; Copyright (C) 2001, 2003, 2004, 2006, 2010, 2011 Free Software
Foundation, Inc.
+;;;; Copyright (C) 2001, 2003, 2004, 2006, 2010, 2011, 2012 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
@@ -19,6 +19,7 @@
(define-module (test-format)
#:use-module (test-suite lib)
+ #:use-module (ice-9 i18n)
#:use-module (ice-9 format))
@@ -97,6 +98,31 @@
(string=? "2.5" (format #f "~f" "02.5"))))
;;;
+;;; ~h
+;;;
+
+(setlocale LC_ALL "C")
+(with-test-prefix "~h localized number"
+
+ (pass-if "1234.5"
+ (string=? (format #f "~h" 1234.5) "1234.5"))
+
+ (pass-if "padding"
+ (string=? (format #f "~6h" 123.2) " 123.2"))
+
+ (pass-if "padchar"
+ (string=? (format #f "~8,,'*h" 123.2) "***123.2"))
+
+ (pass-if "decimals"
+ (string=? (format #f "~,2h" 123.4567)
+ "123.45"))
+
+ (pass-if "locale"
+ (string=? (format #f "~,3:h, ~a" 1234.5678
+ %global-locale "approximately")
+ "1234.567, approximately")))
+
+;;;
;;; ~{
;;;
diff --git a/test-suite/tests/i18n.test b/test-suite/tests/i18n.test
index d1b0a54..335f450 100644
--- a/test-suite/tests/i18n.test
+++ b/test-suite/tests/i18n.test
@@ -18,9 +18,10 @@
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
(define-module (test-suite i18n)
- :use-module (ice-9 i18n)
- :use-module (srfi srfi-1)
- :use-module (test-suite lib))
+ #:use-module (ice-9 i18n)
+ #:use-module (ice-9 format)
+ #:use-module (srfi srfi-1)
+ #:use-module (test-suite lib))
;; Start from a pristine locale state.
(setlocale LC_ALL "C")
@@ -94,6 +95,9 @@
(define %greek-utf8-locale-name
"el_GR.UTF-8")
+(define %american-english-locale-name
+ "en_US")
+
(define %french-locale
(false-if-exception
(make-locale (list LC_CTYPE LC_COLLATE LC_NUMERIC LC_TIME)
@@ -119,6 +123,11 @@
(make-locale LC_ALL
%turkish-utf8-locale-name)))
+(define %american-english-locale
+ (false-if-exception
+ (make-locale LC_ALL
+ %american-english-locale-name)))
+
(define (under-locale-or-unresolved locale thunk)
;; On non-GNU systems, an exception may be raised only when the locale is
;; actually used rather than at `make-locale'-time. Thus, we must guard
@@ -153,6 +162,10 @@
(define (under-greek-utf8-locale-or-unresolved thunk)
(under-locale-or-unresolved %greek-utf8-locale thunk))
+(define (under-american-english-locale-or-unresolved thunk)
+ (under-locale-or-unresolved %american-english-locale thunk))
+
+
(with-test-prefix "text collation (French)"
(pass-if "string-locale<?"
@@ -479,3 +492,40 @@
(let ((fr (make-locale LC_ALL %french-locale-name)))
(string=? "1 234,5"
(number->locale-string 1234.567 1 fr))))))))
+
+(with-test-prefix "format ~h"
+
+ (with-test-prefix "French"
+
+ (pass-if "12345.5678"
+ (under-french-locale-or-unresolved
+ (lambda ()
+ (string=? "12 345,6789"
+ (format #f "~:h" 12345.6789 %french-locale))))))
+
+ (with-test-prefix "English"
+
+ (pass-if "12345.5678"
+ (under-american-english-locale-or-unresolved
+ (lambda ()
+ (string=? "12,345.6789"
+ (format #f "~:h" 12345.6789
+ %american-english-locale)))))))
+
+(with-test-prefix "monetary-amount->locale-string"
+
+ (with-test-prefix "French"
+
+ (pass-if "integer"
+ (under-french-locale-or-unresolved
+ (lambda ()
+ (let ((fr (make-locale LC_ALL %french-locale-name)))
+ (string=? "123 456 +EUR"
+ (monetary-amount->locale-string 123456 #f fr))))))
+
+ (pass-if "fraction"
+ (under-french-locale-or-unresolved
+ (lambda ()
+ (let ((fr (make-locale LC_ALL %french-locale-name)))
+ (string=? "1 234,56 EUR "
+ (monetary-amount->locale-string 1234.567 #t fr))))))))
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index 37cd386..8e294a7 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -2243,6 +2243,32 @@
(number? (string-contains (car w)
"expected 1, got 2")))))
+ (pass-if "~h"
+ (null? (call-with-warnings
+ (lambda ()
+ (compile '((@ (ice-9 format) format) #t
+ "foo ~h ~a~%" 123.4 'bar)
+ #:opts %opts-w-format
+ #:to 'assembly)))))
+
+ (pass-if "~:h with locale object"
+ (null? (call-with-warnings
+ (lambda ()
+ (compile '((@ (ice-9 format) format) #t
+ "foo ~:h~%" 123.4 %global-locale)
+ #:opts %opts-w-format
+ #:to 'assembly)))))
+
+ (pass-if "~:h without locale object"
+ (let ((w (call-with-warnings
+ (lambda ()
+ (compile '((@ (ice-9 format) format) #t "foo ~,2:h" 123.4)
+ #:opts %opts-w-format
+ #:to 'assembly)))))
+ (and (= (length w) 1)
+ (number? (string-contains (car w)
+ "expected 2, got 1")))))
+
(with-test-prefix "conditionals"
(pass-if "literals"
(null? (call-with-warnings
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.5-22-gb4af80a,
Ludovic Courtès <=