[Guile-commits] GNU Guile branch, master, updated. release_1-9-11-258-gb6dcf01

[Ludovic Courtès]

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=b6dcf01abc85d2093986528d26ff4e3256d3f837

The branch, master has been updated
       via  b6dcf01abc85d2093986528d26ff4e3256d3f837 (commit)
       via  fa2a89a6d174a863ffc5d4d5b3e90d542a9962aa (commit)
       via  61d1d4a83afb55a524b548a0f07b11dae177281a (commit)
      from  802b47bdc6232f3726860ce8ae17e4b422061620 (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 b6dcf01abc85d2093986528d26ff4e3256d3f837
Author: Andreas Rottmann <address@hidden>
Date:   Sun Aug 15 16:52:00 2010 +0200

    Link test-srfi-1 to libguile as well
    
    With an installed copy of libguile in place, test-srfi-1 would be run
    using that instead of the in-tree libguile.
    
    * test-suite/standalone/Makefile.am (test_srfi_1_LDADD): Add libguile.
    
    Signed-off-by: Ludovic Courtès <address@hidden>

commit fa2a89a6d174a863ffc5d4d5b3e90d542a9962aa
Author: Ludovic Courtès <address@hidden>
Date:   Sun Aug 15 16:42:33 2010 +0200

    Add `string->pointer' and `pointer->string' to the FFI.
    
    * libguile/foreign.c (scm_string_to_pointer, scm_pointer_to_string): New
      functions.
    
    * libguile/foreign.h (scm_string_to_pointer, scm_pointer_to_string): New
      declarations.
    
    * module/system/foreign.scm: Export `string->pointer' and
      `pointer->string'.
    
    * test-suite/tests/foreign.test ("pointer<->string"): New test prefix.
    
    * doc/ref/api-foreign.texi (Void Pointers and Byte Access): Add
      `string->pointer' and `pointer->string'.

commit 61d1d4a83afb55a524b548a0f07b11dae177281a
Author: Ludovic Courtès <address@hidden>
Date:   Fri Aug 6 15:36:51 2010 +0200

    Add `number->locale-string' tests.
    
    * test-suite/tests/i18n.test ("number->locale-string"): New test prefix.

-----------------------------------------------------------------------

Summary of changes:
 doc/ref/api-foreign.texi          |   16 +++++++++
 libguile/foreign.c                |   63 ++++++++++++++++++++++++++++--------
 libguile/foreign.h                |    5 ++-
 module/system/foreign.scm         |    5 ++-
 test-suite/standalone/Makefile.am |    3 +-
 test-suite/tests/foreign.test     |   12 +++++++
 test-suite/tests/i18n.test        |   43 ++++++++++++++++++++++++-
 7 files changed, 129 insertions(+), 18 deletions(-)

diff --git a/doc/ref/api-foreign.texi b/doc/ref/api-foreign.texi
index d7ff689..bcb8798 100644
--- a/doc/ref/api-foreign.texi
+++ b/doc/ref/api-foreign.texi
@@ -598,6 +598,22 @@ Assuming @var{pointer} points to a memory region that 
holds a pointer,
 return this pointer.
 @end deffn
 
address@hidden {Scheme Procedure} string->pointer string
+Return a foreign pointer to a nul-terminated copy of @var{string} in the
+current locale encoding.  The C string is freed when the returned
+foreign pointer becomes unreachable.
+
+This is the Scheme equivalent of @code{scm_to_locale_string}.
address@hidden deffn
+
address@hidden {Scheme Procedure} pointer->string pointer
+Return the string representing the C nul-terminated string
+pointed to by @var{pointer}.  The C string is assumed to be
+in the current locale encoding.
+
+This is the Scheme equivalent of @code{scm_from_locale_string}.
address@hidden deffn
+
 Going back to the @code{scm_numptob} example above, here is how we can
 read its value as a C @code{long} integer:
 
diff --git a/libguile/foreign.c b/libguile/foreign.c
index 90607e8..33af172 100644
--- a/libguile/foreign.c
+++ b/libguile/foreign.c
@@ -162,18 +162,6 @@ SCM_DEFINE (scm_pointer_address, "pointer-address", 1, 0, 
0,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_dereference_pointer, "dereference-pointer", 1, 0, 0,
-           (SCM pointer),
-           "Assuming @var{pointer} points to a memory region that\n"
-           "holds a pointer, return this pointer.")
-#define FUNC_NAME s_scm_dereference_pointer
-{
-  SCM_VALIDATE_POINTER (1, pointer);
-
-  return scm_from_pointer (* (void **) SCM_POINTER_VALUE (pointer), NULL);
-}
-#undef FUNC_NAME
-
 SCM_DEFINE (scm_pointer_to_bytevector, "pointer->bytevector", 2, 2, 0,
            (SCM pointer, SCM len, SCM offset, SCM uvec_type),
            "Return a bytevector aliasing the @var{len} bytes pointed\n"
@@ -299,8 +287,6 @@ SCM_DEFINE (scm_set_pointer_finalizer_x, 
"set-pointer-finalizer!", 2, 0, 0,
 }
 #undef FUNC_NAME
 
-
-
 void
 scm_i_pointer_print (SCM pointer, SCM port, scm_print_state *pstate)
 {
@@ -310,6 +296,55 @@ scm_i_pointer_print (SCM pointer, SCM port, 
scm_print_state *pstate)
 }
 
 
+/* Non-primitive helpers functions.  These procedures could be
+   implemented in terms of the primitives above but would be inefficient
+   (heap allocation overhead, Scheme/C round trips, etc.)  */
+
+SCM_DEFINE (scm_dereference_pointer, "dereference-pointer", 1, 0, 0,
+           (SCM pointer),
+           "Assuming @var{pointer} points to a memory region that\n"
+           "holds a pointer, return this pointer.")
+#define FUNC_NAME s_scm_dereference_pointer
+{
+  SCM_VALIDATE_POINTER (1, pointer);
+
+  return scm_from_pointer (* (void **) SCM_POINTER_VALUE (pointer), NULL);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_string_to_pointer, "string->pointer", 1, 0, 0,
+           (SCM string),
+           "Return a foreign pointer to a nul-terminated copy of\n"
+           "@var{string} in the current locale encoding.  The C\n"
+           "string is freed when the returned foreign pointer\n"
+           "becomes unreachable.\n\n"
+            "This is the Scheme equivalent of @code{scm_to_locale_string}.")
+#define FUNC_NAME s_scm_string_to_pointer
+{
+  SCM_VALIDATE_STRING (1, string);
+
+  /* XXX: Finalizers slow down libgc; they could be avoided if
+     `scm_to_string' & co. were able to use libgc-allocated memory.  */
+
+  return scm_from_pointer (scm_to_locale_string (string), free);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_pointer_to_string, "pointer->string", 1, 0, 0,
+           (SCM pointer),
+           "Return the string representing the C nul-terminated string\n"
+           "pointed to by @var{pointer}.  The C string is assumed to be\n"
+           "in the current locale encoding.\n\n"
+           "This is the Scheme equivalent of @code{scm_from_locale_string}.")
+#define FUNC_NAME s_scm_pointer_to_string
+{
+  SCM_VALIDATE_POINTER (1, pointer);
+
+  return scm_from_locale_string (SCM_POINTER_VALUE (pointer));
+}
+#undef FUNC_NAME
+
+
 
 SCM_DEFINE (scm_alignof, "alignof", 1, 0, 0, (SCM type),
             "Return the alignment of @var{type}, in bytes.\n\n"
diff --git a/libguile/foreign.h b/libguile/foreign.h
index cdd3b3c..f5fac51 100644
--- a/libguile/foreign.h
+++ b/libguile/foreign.h
@@ -69,10 +69,13 @@ SCM_API SCM scm_set_pointer_finalizer_x (SCM pointer, SCM 
finalizer);
 SCM_API SCM scm_bytevector_to_pointer (SCM bv, SCM offset);
 
 SCM_INTERNAL SCM scm_make_pointer (SCM address, SCM finalizer);
-SCM_INTERNAL SCM scm_dereference_pointer (SCM pointer);
 SCM_INTERNAL void scm_i_pointer_print (SCM pointer, SCM port,
                                        scm_print_state *pstate);
 
+SCM_INTERNAL SCM scm_dereference_pointer (SCM pointer);
+SCM_INTERNAL SCM scm_string_to_pointer (SCM string);
+SCM_INTERNAL SCM scm_pointer_to_string (SCM pointer);
+
 
 
 /* Foreign functions */
diff --git a/module/system/foreign.scm b/module/system/foreign.scm
index 121db60..e9a4a7c 100644
--- a/module/system/foreign.scm
+++ b/module/system/foreign.scm
@@ -33,12 +33,15 @@
             null-pointer?
             make-pointer
             pointer-address
-            dereference-pointer
 
             pointer->bytevector
             bytevector->pointer
             set-pointer-finalizer!
 
+            dereference-pointer
+            string->pointer
+            pointer->string
+
             make-foreign-function
             make-c-struct parse-c-struct))
 
diff --git a/test-suite/standalone/Makefile.am 
b/test-suite/standalone/Makefile.am
index a748c1e..68c8360 100644
--- a/test-suite/standalone/Makefile.am
+++ b/test-suite/standalone/Makefile.am
@@ -167,7 +167,8 @@ TESTS += test-extensions
 test_srfi_1_SOURCES = test-srfi-1.c
 test_srfi_1_CFLAGS = ${test_cflags}
 test_srfi_1_LDADD =    \
-  ${top_builddir}/srfi/address@hidden@.la
+  ${top_builddir}/srfi/address@hidden@.la \
+  ${top_builddir}/libguile/address@hidden@.la
 check_PROGRAMS += test-srfi-1
 TESTS += test-srfi-1
 
diff --git a/test-suite/tests/foreign.test b/test-suite/tests/foreign.test
index eb12360..d93565e 100644
--- a/test-suite/tests/foreign.test
+++ b/test-suite/tests/foreign.test
@@ -79,6 +79,18 @@
                      bytes)))))
 
 
+(with-test-prefix "pointer<->string"
+
+  (pass-if "bijection"
+    (let ((s "hello, world"))
+      (string=? s (pointer->string (string->pointer s)))))
+
+  (pass-if "bijection [latin1]"
+    (with-latin1-locale
+      (let ((s "Szép jó napot!"))
+        (string=? s (pointer->string (string->pointer s)))))))
+
+
 (with-test-prefix "structs"
 
   (pass-if "parse-c-struct"
diff --git a/test-suite/tests/i18n.test b/test-suite/tests/i18n.test
index 1cb48e7..f0c9757 100644
--- a/test-suite/tests/i18n.test
+++ b/test-suite/tests/i18n.test
@@ -1,6 +1,6 @@
 ;;;; i18n.test --- Exercise the i18n API.  -*- coding: utf-8; mode: scheme; -*-
 ;;;;
-;;;; Copyright (C) 2006, 2007, 2009 Free Software Foundation, Inc.
+;;;; Copyright (C) 2006, 2007, 2009, 2010 Free Software Foundation, Inc.
 ;;;; Ludovic Courtès
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
@@ -363,3 +363,44 @@
                     (string-ci=? result "Tuesday"))))
            (lambda ()
              (setlocale LC_ALL "C")))))))
+
+
+;;;
+;;; Numbers.
+;;;
+
+(with-test-prefix "number->locale-string"
+
+  ;; We assume the global locale is "C" at this point.
+
+  (with-test-prefix "C"
+
+    (pass-if "no thousand separator"
+      ;; Unlike in English, the "C" locale has no thousand separator.
+      ;; If this doesn't hold, the following tests will fail.
+      (string=? "" (locale-thousands-separator)))
+
+    (pass-if "integer"
+      (string=? "123456" (number->locale-string 123456)))
+
+    (pass-if "fraction"
+      (string=? "1234.567" (number->locale-string 1234.567)))
+
+    (pass-if "fraction, 1 digit"
+      (string=? "1234.5" (number->locale-string 1234.567 1))))
+
+  (with-test-prefix "French"
+
+    (under-french-locale-or-unresolved
+     (lambda ()
+       (let ((fr (make-locale LC_ALL %french-locale-name)))
+
+        (pass-if "integer"
+          (string=? "123 456" (number->locale-string 123456 #t fr)))
+
+        (pass-if "fraction"
+          (string=? "1 234,567" (number->locale-string 1234.567 #t fr)))
+
+        (pass-if "fraction, 1 digit"
+          (string=? "1 234,5"
+                    (number->locale-string 1234.567 1 fr))))))))


hooks/post-receive
-- 
GNU Guile