string->pointer and pointer->string have optional encoding arg

* test-suite/tests/foreign.test ("pointer<->string"): Add test cases.

* libguile/foreign.c (scm_string_to_pointer, scm_pointer_to_string): Add
  optional encoding, and in the pointer->string case, length arguments.

* libguile/foreign.h: Update prototypes of internal functions.
  Shouldn't affect ABI as they are internal.

* doc/ref/api-foreign.texi (Void Pointers and Byte Access): Update
  docs.

diff --git a/doc/ref/api-foreign.texi b/doc/ref/api-foreign.texi
index b5fdd001b0004fbe6e411cb49ea3165a221846b5..2dd691675cf247f83dbae20639384c3e595894ea 100644 (file)
--- a/doc/ref/api-foreign.texi
+++ b/doc/ref/api-foreign.texi
@@ -626,20 +626,22 @@ Assuming @var{pointer} points to a memory region that holds a pointer,
 return this pointer.
 @end deffn
 
-@deffn {Scheme Procedure} string->pointer string
+@deffn {Scheme Procedure} string->pointer string [encoding]
 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.
+given @var{encoding}, defaulting to 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}.
+This is the Scheme equivalent of @code{scm_to_stringn}.
 @end deffn
 
-@deffn {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.
+@deffn {Scheme Procedure} pointer->string pointer [length] [encoding]
+Return the string representing the C string pointed to by @var{pointer}.
+If @var{length} is omitted or @code{-1}, the string is assumed to be
+nul-terminated.  Otherwise @var{length} is the number of bytes in memory
+pointed to by @var{pointer}.  The C string is assumed to be in the given
+@var{encoding}, defaulting to the current locale encoding.
 
-This is the Scheme equivalent of @code{scm_from_locale_string}.
+This is the Scheme equivalent of @code{scm_from_stringn}.
 @end deffn
 
 @cindex wrapped pointer types

diff --git a/libguile/foreign.c b/libguile/foreign.c
index dbfba87702845d867e8f8b5ae9382296ee5072fe..ae9e27a8d216014d7e6996f887b5068c82e57467 100644 (file)
--- a/libguile/foreign.c
+++ b/libguile/foreign.c
@@ -355,13 +355,13 @@ SCM_DEFINE (scm_dereference_pointer, "dereference-pointer", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_string_to_pointer, "string->pointer", 1, 0, 0,
-           (SCM string),
+SCM_DEFINE (scm_string_to_pointer, "string->pointer", 1, 1, 0,
+           (SCM string, SCM encoding),
            "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}.")
+           "@var{string} in the given @var{encoding}, defaulting to\n"
+            "the current locale encoding.  The C string is freed when\n"
+            "the returned foreign pointer becomes unreachable.\n\n"
+            "This is the Scheme equivalent of @code{scm_to_stringn}.")
 #define FUNC_NAME s_scm_string_to_pointer
 {
   SCM_VALIDATE_STRING (1, string);
@@ -369,21 +369,72 @@ SCM_DEFINE (scm_string_to_pointer, "string->pointer", 1, 0, 0,
   /* 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);
+  if (SCM_UNBNDP (encoding))
+    return scm_from_pointer (scm_to_locale_string (string), free);
+  else
+    {
+      char *enc;
+      SCM ret;
+      
+      SCM_VALIDATE_STRING (2, encoding);
+
+      enc = scm_to_locale_string (encoding);
+      scm_dynwind_begin (0);
+      scm_dynwind_free (enc);
+
+      ret = scm_from_pointer
+        (scm_to_stringn (string, NULL, enc,
+                         scm_i_get_conversion_strategy (SCM_BOOL_F)),
+         free);
+
+      scm_dynwind_end ();
+
+      return ret;
+    }
 }
 #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}.")
+SCM_DEFINE (scm_pointer_to_string, "pointer->string", 1, 2, 0,
+           (SCM pointer, SCM length, SCM encoding),
+           "Return the string representing the C string pointed to by\n"
+            "@var{pointer}.  If @var{length} is omitted or @code{-1}, the\n"
+            "string is assumed to be nul-terminated.  Otherwise\n"
+            "@var{length} is the number of bytes in memory pointed to by\n"
+            "@var{pointer}.  The C string is assumed to be in the given\n"
+            "@var{encoding}, defaulting to the current locale encoding.\n\n"
+           "This is the Scheme equivalent of @code{scm_from_stringn}.")
 #define FUNC_NAME s_scm_pointer_to_string
 {
+  size_t len;
+
   SCM_VALIDATE_POINTER (1, pointer);
 
-  return scm_from_locale_string (SCM_POINTER_VALUE (pointer));
+  if (SCM_UNBNDP (length)
+      || scm_is_true (scm_eqv_p (length, scm_from_int (-1))))
+    len = (size_t)-1;
+  else
+    len = scm_to_size_t (length);
+    
+  if (SCM_UNBNDP (encoding))
+    return scm_from_locale_stringn (SCM_POINTER_VALUE (pointer), len);
+  else
+    {
+      char *enc;
+      SCM ret;
+      
+      SCM_VALIDATE_STRING (3, encoding);
+
+      enc = scm_to_locale_string (encoding);
+      scm_dynwind_begin (0);
+      scm_dynwind_free (enc);
+
+      ret = scm_from_stringn (SCM_POINTER_VALUE (pointer), len, enc,
+                              scm_i_get_conversion_strategy (SCM_BOOL_F));
+
+      scm_dynwind_end ();
+
+      return ret;
+    }
 }
 #undef FUNC_NAME
 

diff --git a/libguile/foreign.h b/libguile/foreign.h
index b29001962714261b18bac979466b818d0526bf17..6c6f373060485fb69cad33983767b2cf432e33c0 100644 (file)
--- a/libguile/foreign.h
+++ b/libguile/foreign.h
@@ -72,8 +72,8 @@ 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);
+SCM_INTERNAL SCM scm_string_to_pointer (SCM string, SCM encoding);
+SCM_INTERNAL SCM scm_pointer_to_string (SCM pointer, SCM length, SCM encoding);
 
 \f
 

diff --git a/test-suite/tests/foreign.test b/test-suite/tests/foreign.test
index 1353e7dbbbe58b7aecc83ac094703fc28d16b0cf..60b466e1c12739f8b5f80058f6c04f0f46700949 100644 (file)
--- a/test-suite/tests/foreign.test
+++ b/test-suite/tests/foreign.test
@@ -153,7 +153,18 @@
   (pass-if "bijection [latin1]"
     (with-latin1-locale
       (let ((s "Szép jó napot!"))
-        (string=? s (pointer->string (string->pointer s)))))))
+        (string=? s (pointer->string (string->pointer s))))))
+
+  (pass-if "bijection, utf-8"
+    (let ((s "hello, world"))
+      (string=? s (pointer->string (string->pointer s "utf-8")
+                                   -1 "utf-8"))))
+
+  (pass-if "bijection, utf-8 [latin1]"
+    (let ((s "Szép jó napot!"))
+      (string=? s (pointer->string (string->pointer s "utf-8")
+                                   -1 "utf-8")))))
+
 
 \f
 (with-test-prefix "pointer->procedure"