* [WIP: PATCH 0/2] memory leak + uselocale
@ 2020-10-13 19:11 Miguel Ángel Arruga Vivas
2020-10-13 19:14 ` [WIP: PATCH 1/2] memory leak Miguel Ángel Arruga Vivas
2020-10-13 19:15 ` [WIP: PATCH 2/2] uselocale Miguel Ángel Arruga Vivas
0 siblings, 2 replies; 3+ messages in thread
From: Miguel Ángel Arruga Vivas @ 2020-10-13 19:11 UTC (permalink / raw)
To: guile-devel
[-- Attachment #1: Type: text/plain, Size: 3148 bytes --]
Hi, everybody,
I've been looking into giving some updates to certain interfaces that
may be useful and uselocale was one of the first I thought---not the
first, but the first for which I send a patch.
Currently, i18n.c reads:
/* XXX: We don't define it as `LC_GLOBAL_LOCALE' because of bugs as of
glibc <= 2.11 not (yet) worked around by Gnulib. See
http://sourceware.org/bugzilla/show_bug.cgi?id=11009 for details. */
I've checked the bug, and I think that the current behaviour of libc is
completely compliant with POSIX. The only two positive mentions to
LC_GLOBAL_LOCALE I've found are in uselocale[1] and duplocale[2]
specifications, and the third explicitly says that it is undefined
behaviour to provide it to newlocale[3] or freelocale[4]. I consider
that they provide a complete framework for the use of this special
object.
In addition, exposing that kind of interface to the Scheme world seems
quite forced, from my point of view. I propose an interface for
uselocale that deduplicates the information from the unique return
value, that is mandatory in the cold cold C world, to *two* values:
first a boolean, that indicates if there is/was a thread-specific locale
installed, and the locale in use before the call as the second value.
If it's called without parameters just returns the value, while the
following call:
(uselocale #f)
Is equivalent to the cryptic:
setlocale (LC_GLOBAL_LOCALE);
The usual interface:
(uselocale anything-not-false)
Provides a locale object that will be installed in the current locale,
or fails if the type is not the adecuate or other system reason, of
course. The returned value is always a smob that must enter the GC
world, so the call to duplocale is needed anyway.
Nonetheless, one of the main use cases would be the guarded execution
idiom, so I also expose an interface called 'with-thread-locale'. The
current implementation is in C with dynamic-wind underneath and a simple
macro over it, but the documentation contains a possible implementation
in Scheme too.
It's only implemented it under USE_GNU_LOCALE_API and needs more work to
be completely ready, as probably the function should be moved to the
posix module (?), but the code it's working---as always, on my machine.
And as a secondary ramification, looking into the other condition (when
USE_GNU_LOCALE_API is not defined) I found something that seems to be a
memory leak, but I don't know where to test it---I don't know which
systems don't define it, nothing I have running right now at least.
The order of the patches is the inverse of the mail, as I wrote the
first before finishing the second, sorry if that causes any confusion.
What do you think? Any ideas or points I may have missed? Suggestions?
Happy hacking!
Miguel
--
[1] https://pubs.opengroup.org/onlinepubs/9699919799.2016edition/functions/uselocale.html
[2] https://pubs.opengroup.org/onlinepubs/9699919799.2016edition/functions/duplocale.html
[3] https://pubs.opengroup.org/onlinepubs/9699919799.2016edition/functions/newlocale.html
[4] https://pubs.opengroup.org/onlinepubs/9699919799.2016edition/functions/freelocale.html
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 658 bytes --]
^ permalink raw reply [flat|nested] 3+ messages in thread
* [WIP: PATCH 1/2] memory leak
2020-10-13 19:11 [WIP: PATCH 0/2] memory leak + uselocale Miguel Ángel Arruga Vivas
@ 2020-10-13 19:14 ` Miguel Ángel Arruga Vivas
2020-10-13 19:15 ` [WIP: PATCH 2/2] uselocale Miguel Ángel Arruga Vivas
1 sibling, 0 replies; 3+ messages in thread
From: Miguel Ángel Arruga Vivas @ 2020-10-13 19:14 UTC (permalink / raw)
To: guile-devel
[-- Attachment #1.1: Type: text/plain, Size: 44 bytes --]
Here it's the patch about the memory leak.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: 0001-mml.patch --]
[-- Type: text/x-patch, Size: 1697 bytes --]
From 888f31dfedc1292cff9fce2d2ef20f986c2fb669 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Miguel=20=C3=81ngel=20Arruga=20Vivas?=
<rosen644835@gmail.com>
Date: Mon, 12 Oct 2020 13:25:25 +0200
Subject: [PATCH 1/2] Fix memory leak after an error.
* libguile/i18n.c (get_current_locale_name): Use the intermediate
variable val to cleanup the copied strings in case of error.
---
libguile/i18n.c | 16 ++++++++++++----
1 file changed, 12 insertions(+), 4 deletions(-)
diff --git a/libguile/i18n.c b/libguile/i18n.c
index fc47fdfe5..7b80e7427 100644
--- a/libguile/i18n.c
+++ b/libguile/i18n.c
@@ -311,7 +311,10 @@ typedef struct
static int
get_current_locale_settings (scm_t_locale_settings *settings)
{
+ int error;
const char *locale_name;
+ scm_t_locale_settings val;
+ memset (&val, 0, sizeof (val));
#define SCM_DEFINE_LOCALE_CATEGORY(_name) \
{ \
@@ -319,21 +322,26 @@ get_current_locale_settings (scm_t_locale_settings *settings)
if (locale_name == NULL) \
goto handle_error; \
\
- settings-> _name = strdup (locale_name); \
- if (settings-> _name == NULL) \
+ val. _name = strdup (locale_name); \
+ if (val. _name == NULL) \
goto handle_oom; \
}
#include "locale-categories.h"
#undef SCM_DEFINE_LOCALE_CATEGORY
+ memcpy(settings, &val, sizeof (val));
return 0;
handle_error:
- return EINVAL;
+ error = EINVAL;
+ goto cleanup;
handle_oom:
- return ENOMEM;
+ error = ENOMEM;
+ cleanup:
+ free_locale_settings(&val);
+ return error;
}
/* Restore locale settings SETTINGS. On success, return zero. */
--
2.28.0
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 658 bytes --]
^ permalink raw reply related [flat|nested] 3+ messages in thread
* [WIP: PATCH 2/2] uselocale
2020-10-13 19:11 [WIP: PATCH 0/2] memory leak + uselocale Miguel Ángel Arruga Vivas
2020-10-13 19:14 ` [WIP: PATCH 1/2] memory leak Miguel Ángel Arruga Vivas
@ 2020-10-13 19:15 ` Miguel Ángel Arruga Vivas
1 sibling, 0 replies; 3+ messages in thread
From: Miguel Ángel Arruga Vivas @ 2020-10-13 19:15 UTC (permalink / raw)
To: guile-devel
[-- Attachment #1.1: Type: text/plain, Size: 33 bytes --]
This one is the uselocale code.
[-- Attachment #1.2: 0002-uselocale.patch --]
[-- Type: text/x-patch, Size: 11437 bytes --]
From 55cdc6b3ac8642be524b1b1b8b4ee29f14b64b10 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Miguel=20=C3=81ngel=20Arruga=20Vivas?=
<rosen644835@gmail.com>
Date: Mon, 12 Oct 2020 14:02:40 +0200
Subject: [PATCH 2/2] Add support for thread-local locale when available.
* libguile/i18n.c (scm_uselocale): New interface for uselocale.
(internal_uselocale): New internal function.
(scm_with_thread_locale): New function.
(scm_init_i18n): Add feature "uselocale". Remove comment about
LC_GLOBAL_LOCALE, as it is not exposed directly to Scheme code.
* libguile/i18n.h (scm_uselocale, scm_with_thread_locale): New
prototypes.
* module/ice-9/i18n.scm (with-thread-locale): New macro.
* test-suite/tests/i18n.test: Add tests for uselocale feature.
* test-suite/tests/time.test: Likewise. These tests were adapted from
previous examples.
---
libguile/i18n.c | 130 ++++++++++++++++++++++++++++++++++++-
libguile/i18n.h | 3 +
module/ice-9/i18n.scm | 12 ++++
test-suite/tests/i18n.test | 49 ++++++++++++++
test-suite/tests/time.test | 37 ++++++++++-
5 files changed, 225 insertions(+), 6 deletions(-)
diff --git a/libguile/i18n.c b/libguile/i18n.c
index 7b80e7427..b8a14741e 100644
--- a/libguile/i18n.c
+++ b/libguile/i18n.c
@@ -33,6 +33,7 @@
#include "chars.h"
#include "dynwind.h"
#include "extensions.h"
+#include "eval.h" /* for `scm_call_0' */
#include "feature.h"
#include "gsubr.h"
#include "list.h"
@@ -1886,6 +1887,126 @@ define_langinfo_items (void)
#undef DEFINE_NLITEM_CONSTANT
}
+\f
+/* Thread-specific locale. */
+
+#ifdef USE_GNU_LOCALE_API
+
+SCM_DEFINE (scm_uselocale, "uselocale", 0, 1, 0, (SCM locale),
+ "This procedure checks and/or modifies the locale used\n"
+ "by the current thread @emph{without} modifying the\n"
+ "output port status.\n\n"
+ "It's responsibility of the user to not rely on the\n"
+ "globally accessible input and output ports, which usually\n"
+ "usually is a bad idea in a multi-threaded scenario.\n\n"
+ "The behaviour is determined by @var{locale}:\n\n"
+ "@table @r\n"
+ "@item @var{locale} is not provided\n"
+ "Only retrieve the locale used by the current thread.\n"
+ "@item @var{locale} is @code{#f}\n"
+ "Remove the locale installed in the current thread, if\n"
+ "there was one installed, and use the global locale.\n"
+ "@item @var{locale} is a valid @code{<locale>} object.\n"
+ "Install the provided locale to be used by the current\n"
+ "thread.\n"
+ "@end table\n\n"
+ "This procedure return two values:\n\n"
+ "@enumerate\n"
+ "@item\n"
+ "A boolean indicating whether thread has a thread-specific\n"
+ "locale installed or not.\n"
+ "@item\n"
+ "The locale in use by the thread before the call.\n"
+ "@end enumerate")
+#define FUNC_NAME s_scm_uselocale
+{
+ SCM is_thr_local, ret;
+ scm_t_locale c_locale, current;
+
+ scm_dynwind_begin (0);
+
+ if (SCM_UNBNDP (locale))
+ c_locale = (scm_t_locale) 0;
+ else if (scm_is_false (locale))
+ c_locale = LC_GLOBAL_LOCALE;
+ else
+ SCM_VALIDATE_LOCALE_COPY(1, locale, c_locale);
+
+ current = uselocale (c_locale);
+
+ if (current == (scm_t_locale) 0)
+ SCM_SYSERROR;
+
+ if (current == LC_GLOBAL_LOCALE)
+ is_thr_local = SCM_BOOL_F;
+ else
+ is_thr_local = SCM_BOOL_T;
+
+ current = duplocale (current);
+
+ if (current == (scm_t_locale) 0)
+ SCM_SYSERROR;
+
+ scm_dynwind_unwind_handler ((void (*)(void *))freelocale, current, 0);
+
+ SCM_NEWSMOB (ret, scm_tc16_locale_smob_type, current);
+
+ scm_dynwind_end ();
+ return scm_values_2 (is_thr_local, ret);
+}
+#undef FUNC_NAME
+
+static void
+internal_uselocale (void *locale)
+#define FUNC_NAME "<internal-uselocale>"
+{
+ if (uselocale ((scm_t_locale) locale) == (scm_t_locale) 0)
+ SCM_SYSERROR;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE(scm_with_thread_locale, "%with-thread-locale",
+ 2, 0, 0,
+ (SCM locale, SCM thunk),
+ "Execute @var{thunk} with the thread-specific locale\n"
+ "set to @var{locale}.\n\n"
+ "It's behaviour is equivalent to the following Scheme\n"
+ "code:\n\n"
+ "@example\n"
+ "(define (%with-thread-locale locale thunk)\n"
+ " (let (at-exit)\n"
+ " (define (in-guard)\n"
+ " (define-values (is-tl locale) (uselocale locale))\n"
+ " (set! at-exit (and is-tl locale)))\n"
+ " (define (out-guard)\n"
+ " (uselocale at-exit))\n"
+ " (dynamic-wind in-guard thunk out-guard)))\n"
+ "@end example")
+#define FUNC_NAME s_scm_with_thread_locale
+{
+ SCM ret;
+ scm_t_locale c_locale, c_current;
+
+ scm_dynwind_begin (0);
+
+ SCM_VALIDATE_LOCALE_COPY(1, locale, c_locale);
+
+ c_current = uselocale (c_locale);
+ if (c_current == (scm_t_locale) 0)
+ SCM_SYSERROR;
+
+ scm_dynwind_rewind_handler (internal_uselocale, c_locale, 0);
+ scm_dynwind_unwind_handler (internal_uselocale, c_current,
+ SCM_F_WIND_EXPLICITLY);
+
+ ret = scm_call_0 (thunk);
+ scm_dynwind_end ();
+ return ret;
+}
+#undef FUNC_NAME
+
+#endif /* USE_GNU_LOCALE_API */
+
\f
void
scm_init_i18n ()
@@ -1895,12 +2016,15 @@ scm_init_i18n ()
scm_add_feature ("nl-langinfo");
define_langinfo_items ();
+#ifdef USE_GNU_LOCALE_API
+ scm_add_feature ("uselocale");
+#endif
+
#include "i18n.x"
/* Initialize the global locale object with a special `locale' SMOB. */
- /* XXX: We don't define it as `LC_GLOBAL_LOCALE' because of bugs as of
- glibc <= 2.11 not (yet) worked around by Gnulib. See
- http://sourceware.org/bugzilla/show_bug.cgi?id=11009 for details. */
+ /* LC_GLOBAL_LOCALE is only exposed indirectly through uselocale
+ interface when this is available. */
SCM_NEWSMOB (global_locale_smob, scm_tc16_locale_smob_type, NULL);
SCM_VARIABLE_SET (scm_global_locale, global_locale_smob);
}
diff --git a/libguile/i18n.h b/libguile/i18n.h
index 8ce1ce8e6..0538453ab 100644
--- a/libguile/i18n.h
+++ b/libguile/i18n.h
@@ -46,6 +46,9 @@ SCM_API SCM scm_locale_string_to_inexact (SCM str, SCM locale);
SCM_INTERNAL SCM scm_nl_langinfo (SCM item, SCM locale);
+SCM_API SCM scm_uselocale (SCM locale);
+SCM_API SCM scm_with_thread_locale (SCM locale, SCM thunk);
+
SCM_INTERNAL void scm_init_i18n (void);
SCM_INTERNAL void scm_bootstrap_i18n (void);
diff --git a/module/ice-9/i18n.scm b/module/ice-9/i18n.scm
index 319d5a23c..8eb931acf 100644
--- a/module/ice-9/i18n.scm
+++ b/module/ice-9/i18n.scm
@@ -35,6 +35,10 @@
make-locale locale?
%global-locale
+ ;; thread-specific locale
+ uselocale
+ with-thread-locale
+
;; text collation
string-locale<? string-locale>?
string-locale-ci<? string-locale-ci>? string-locale-ci=?
@@ -91,6 +95,14 @@
(load-extension (string-append "libguile-" (effective-version))
"scm_init_i18n"))
+\f
+;; Define the macro with-thread-locale when the implementation is
+;; available.
+(define-syntax with-thread-locale
+ (syntax-rules ()
+ ((_ locale exp exp* ...)
+ (%with-thread-locale locale (lambda () exp exp* ...)))))
+
\f
;;;
;;; Charset/encoding.
diff --git a/test-suite/tests/i18n.test b/test-suite/tests/i18n.test
index 427aef4f5..f76af4ea6 100644
--- a/test-suite/tests/i18n.test
+++ b/test-suite/tests/i18n.test
@@ -20,6 +20,7 @@
(define-module (test-suite i18n)
#:use-module (ice-9 i18n)
+ #:use-module (ice-9 threads)
#:use-module (ice-9 format)
#:use-module (srfi srfi-1)
#:use-module (test-suite lib))
@@ -726,3 +727,51 @@
(lambda ()
(let ((fr (make-locale LC_ALL %french-locale-name)))
(monetary-amount->locale-string .00003 #t fr)))))))
+\f
+;;;
+;;; Thread local facilities.
+;;;
+
+(with-test-prefix "uselocale"
+ (define (check-provided features)
+ (for-each (lambda (feature)
+ (or (provided? feature) (throw 'unsupported)))
+ features))
+
+ (pass-if "main thread use global locale"
+ (check-provided '(uselocale))
+
+ (not (uselocale)))
+
+ (pass-if "fresh thread use global locale"
+ (check-provided '(uselocale threads))
+
+ (join-thread (begin-thread (not (uselocale)))))
+
+ (pass-if "fresh thread install locale"
+ (check-provided '(uselocale threads))
+ (unless %c-locale (throw 'unresolved))
+
+ (join-thread
+ (begin-thread
+ (uselocale %c-locale)
+ (uselocale))))
+
+ (pass-if "clean thread locale"
+ (check-provided '(uselocale threads))
+ (unless %c-locale (throw 'unresolved))
+ (join-thread
+ (begin-thread
+ (uselocale %c-locale)
+ (uselocale #f)
+ (not (uselocale)))))
+
+ (with-test-prefix "with-thread-locale"
+
+ (pass-if "locale"
+ (check-provided '(uselocale threads))
+ (unless %c-locale (throw 'unresolved))
+
+ (join-thread
+ (begin-thread
+ (with-thread-locale %c-locale (uselocale)))))))
diff --git a/test-suite/tests/time.test b/test-suite/tests/time.test
index 0291b6bdf..0758e3940 100644
--- a/test-suite/tests/time.test
+++ b/test-suite/tests/time.test
@@ -19,7 +19,8 @@
(define-module (test-suite test-time)
#:use-module (test-suite lib)
- #:use-module (ice-9 threads))
+ #:use-module (ice-9 threads)
+ #:use-module (ice-9 i18n))
;;;
;;; gmtime
@@ -240,7 +241,22 @@
(pass-if-equal "strftime fr_FR.iso88591" ;<https://bugs.gnu.org/35920>
" 1 février 1970"
(with-locale "fr_FR.iso88591"
- (strftime "%e %B %Y" (gmtime (* 31 24 3600)))))))
+ (strftime "%e %B %Y" (gmtime (* 31 24 3600))))))
+
+ (with-test-prefix "uselocale"
+ (define (strftime-tl loc fmt tm)
+ (unless (and (provided? 'threads) (provided? 'uselocale))
+ (throw 'unsupported))
+ (join-thread
+ (begin-thread
+ (with-thread-locale (make-locale LC_ALL loc) (strftime fmt tm)))))
+
+ (pass-if-equal "fr_FR.utf8"
+ " 1 février 1970"
+ (strftime-tl "fr_FR.utf8" "%e %B %Y" (gmtime (* 31 24 3600))))
+ (pass-if-equal "fr_FR.iso88591"
+ " 1 février 1970"
+ (strftime-tl "fr_FR.iso88591" "%e %B %Y" (gmtime (* 31 24 3600))))))
;;;
;;; strptime
@@ -295,4 +311,19 @@
(putenv "TZ=EST+5")
(tzset)
(let ((tm (car (strptime "%s" "86400"))))
- (eqv? (* 5 3600) (tm:gmtoff tm))))))
+ (eqv? (* 5 3600) (tm:gmtoff tm)))))
+
+ (with-test-prefix "uselocale"
+ (define (strptime-tl loc fmt str)
+ (unless (and (provided? 'threads) (provided? 'uselocale))
+ (throw 'unsupported))
+ (join-thread
+ (begin-thread
+ (with-thread-locale (make-locale LC_ALL loc)
+ (let ((tm (car (strptime fmt str))))
+ (list (tm:mday tm)
+ (+ 1 (tm:mon tm))
+ (+ 1900 (tm:year tm))))))))
+ (pass-if-equal "strftime fr_FR.utf8"
+ '(1 2 1999)
+ (strptime-tl "fr_FR.utf8" "%e %B %Y" " 1 février 1999"))))
--
2.28.0
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 658 bytes --]
^ permalink raw reply related [flat|nested] 3+ messages in thread
end of thread, other threads:[~2020-10-13 19:15 UTC | newest]
Thread overview: 3+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-10-13 19:11 [WIP: PATCH 0/2] memory leak + uselocale Miguel Ángel Arruga Vivas
2020-10-13 19:14 ` [WIP: PATCH 1/2] memory leak Miguel Ángel Arruga Vivas
2020-10-13 19:15 ` [WIP: PATCH 2/2] uselocale Miguel Ángel Arruga Vivas
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).