unofficial mirror of guile-devel@gnu.org 
 help / color / mirror / Atom feed
* [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	[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	[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

unofficial mirror of guile-devel@gnu.org 

This inbox may be cloned and mirrored by anyone:

	git clone --mirror https://yhetil.org/guile-devel/0 guile-devel/git/0.git

	# If you have public-inbox 1.1+ installed, you may
	# initialize and index your mirror using the following commands:
	public-inbox-init -V2 guile-devel guile-devel/ https://yhetil.org/guile-devel \
		guile-devel@gnu.org
	public-inbox-index guile-devel

Example config snippet for mirrors.
Newsgroups are available over NNTP:
	nntp://news.yhetil.org/yhetil.lisp.guile.devel
	nntp://news.gmane.io/gmane.lisp.guile.devel


AGPL code for this site: git clone http://ou63pmih66umazou.onion/public-inbox.git