aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorLars Ingebrigtsen2020-10-13 06:51:06 +0200
committerLars Ingebrigtsen2020-10-13 06:51:06 +0200
commit12175a339e2a2214fdd0ab4e16d8d8b1e92a78d3 (patch)
treec68e82a585d8a760b569b536d8951e18166a9d9d
parent45cb0403deeba1cc121147b1884e7fea6cd15338 (diff)
downloademacs-12175a339e2a2214fdd0ab4e16d8d8b1e92a78d3.tar.gz
emacs-12175a339e2a2214fdd0ab4e16d8d8b1e92a78d3.zip
Allow creating unibyte strings from Emacs modules
* doc/lispref/internals.texi (Module Values): Document make_unibyte_string (bug#34873). * src/emacs-module.c (module_make_unibyte_string): New function. (initialize_environment): Export it. * src/module-env-25.h: Define it. * test/data/emacs-module/mod-test.c (Fmod_test_return_unibyte): Test it. * test/src/emacs-module-tests.el (module/unibyte): Test it.
-rw-r--r--doc/lispref/internals.texi6
-rw-r--r--src/emacs-module.c13
-rw-r--r--src/module-env-25.h5
-rw-r--r--test/data/emacs-module/mod-test.c11
-rw-r--r--test/src/emacs-module-tests.el6
5 files changed, 41 insertions, 0 deletions
diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi
index fed9612e329..bb25983aa4b 100644
--- a/doc/lispref/internals.texi
+++ b/doc/lispref/internals.texi
@@ -1854,6 +1854,12 @@ raises the @code{overflow-error} error condition if @var{len} is
1854negative or exceeds the maximum length of an Emacs string. 1854negative or exceeds the maximum length of an Emacs string.
1855@end deftypefn 1855@end deftypefn
1856 1856
1857@deftypefn Function emacs_value make_unibyte_string (emacs_env *@var{env}, const char *@var{str}, ptrdiff_t @var{len})
1858This function is like @code{make_string}, but has no restrictions on
1859the values of the bytes in the C string, and can be used to pass
1860binary data to Emacs in the form of a unibyte string.
1861@end deftypefn
1862
1857The @acronym{API} does not provide functions to manipulate Lisp data 1863The @acronym{API} does not provide functions to manipulate Lisp data
1858structures, for example, create lists with @code{cons} and @code{list} 1864structures, for example, create lists with @code{cons} and @code{list}
1859(@pxref{Building Lists}), extract list members with @code{car} and 1865(@pxref{Building Lists}), extract list members with @code{car} and
diff --git a/src/emacs-module.c b/src/emacs-module.c
index 3581daad112..ba9de58de54 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -791,6 +791,18 @@ module_make_string (emacs_env *env, const char *str, ptrdiff_t len)
791} 791}
792 792
793static emacs_value 793static emacs_value
794module_make_unibyte_string (emacs_env *env, const char *str, ptrdiff_t length)
795{
796 MODULE_FUNCTION_BEGIN (NULL);
797 if (! (0 <= length && length <= STRING_BYTES_BOUND))
798 overflow_error ();
799 Lisp_Object lstr = make_uninit_string (length);
800 memcpy (SDATA (lstr), str, length);
801 SDATA (lstr)[length] = 0;
802 return lisp_to_value (env, lstr);
803}
804
805static emacs_value
794module_make_user_ptr (emacs_env *env, emacs_finalizer fin, void *ptr) 806module_make_user_ptr (emacs_env *env, emacs_finalizer fin, void *ptr)
795{ 807{
796 MODULE_FUNCTION_BEGIN (NULL); 808 MODULE_FUNCTION_BEGIN (NULL);
@@ -1464,6 +1476,7 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv)
1464 env->make_float = module_make_float; 1476 env->make_float = module_make_float;
1465 env->copy_string_contents = module_copy_string_contents; 1477 env->copy_string_contents = module_copy_string_contents;
1466 env->make_string = module_make_string; 1478 env->make_string = module_make_string;
1479 env->make_unibyte_string = module_make_unibyte_string;
1467 env->make_user_ptr = module_make_user_ptr; 1480 env->make_user_ptr = module_make_user_ptr;
1468 env->get_user_ptr = module_get_user_ptr; 1481 env->get_user_ptr = module_get_user_ptr;
1469 env->set_user_ptr = module_set_user_ptr; 1482 env->set_user_ptr = module_set_user_ptr;
diff --git a/src/module-env-25.h b/src/module-env-25.h
index 97c7787da34..01c06d5400d 100644
--- a/src/module-env-25.h
+++ b/src/module-env-25.h
@@ -102,6 +102,11 @@
102 const char *str, ptrdiff_t len) 102 const char *str, ptrdiff_t len)
103 EMACS_ATTRIBUTE_NONNULL(1, 2); 103 EMACS_ATTRIBUTE_NONNULL(1, 2);
104 104
105 /* Create a unibyte Lisp string from a string. */
106 emacs_value (*make_unibyte_string) (emacs_env *env,
107 const char *str, ptrdiff_t len)
108 EMACS_ATTRIBUTE_NONNULL(1, 2);
109
105 /* Embedded pointer type. */ 110 /* Embedded pointer type. */
106 emacs_value (*make_user_ptr) (emacs_env *env, 111 emacs_value (*make_user_ptr) (emacs_env *env,
107 void (*fin) (void *) EMACS_NOEXCEPT, 112 void (*fin) (void *) EMACS_NOEXCEPT,
diff --git a/test/data/emacs-module/mod-test.c b/test/data/emacs-module/mod-test.c
index da298d4e398..258a679b207 100644
--- a/test/data/emacs-module/mod-test.c
+++ b/test/data/emacs-module/mod-test.c
@@ -268,6 +268,16 @@ Fmod_test_string_a_to_b (emacs_env *env, ptrdiff_t nargs, emacs_value args[],
268} 268}
269 269
270 270
271/* Return a unibyte string. */
272static emacs_value
273Fmod_test_return_unibyte (emacs_env *env, ptrdiff_t nargs, emacs_value args[],
274 void *data)
275{
276 const char *string = "foo\x00zot";
277 return env->make_unibyte_string (env, string, 7);
278}
279
280
271/* Embedded pointers in lisp objects. */ 281/* Embedded pointers in lisp objects. */
272 282
273/* C struct (pointer to) that will be embedded. */ 283/* C struct (pointer to) that will be embedded. */
@@ -750,6 +760,7 @@ emacs_module_init (struct emacs_runtime *ert)
750 DEFUN ("mod-test-globref-reordered", Fmod_test_globref_reordered, 0, 0, NULL, 760 DEFUN ("mod-test-globref-reordered", Fmod_test_globref_reordered, 0, 0, NULL,
751 NULL); 761 NULL);
752 DEFUN ("mod-test-string-a-to-b", Fmod_test_string_a_to_b, 1, 1, NULL, NULL); 762 DEFUN ("mod-test-string-a-to-b", Fmod_test_string_a_to_b, 1, 1, NULL, NULL);
763 DEFUN ("mod-test-return-unibyte", Fmod_test_return_unibyte, 0, 0, NULL, NULL);
753 DEFUN ("mod-test-userptr-make", Fmod_test_userptr_make, 1, 1, NULL, NULL); 764 DEFUN ("mod-test-userptr-make", Fmod_test_userptr_make, 1, 1, NULL, NULL);
754 DEFUN ("mod-test-userptr-get", Fmod_test_userptr_get, 1, 1, NULL, NULL); 765 DEFUN ("mod-test-userptr-get", Fmod_test_userptr_get, 1, 1, NULL, NULL);
755 DEFUN ("mod-test-vector-fill", Fmod_test_vector_fill, 2, 2, NULL, NULL); 766 DEFUN ("mod-test-vector-fill", Fmod_test_vector_fill, 2, 2, NULL, NULL);
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index 1eebb418cf3..621229c62aa 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -500,4 +500,10 @@ See Bug#36226."
500 (should (eq (mod-test-identity 123) 123)) 500 (should (eq (mod-test-identity 123) 123))
501 (should-not (call-interactively #'mod-test-identity))) 501 (should-not (call-interactively #'mod-test-identity)))
502 502
503(ert-deftest module/unibyte ()
504 (let ((result (mod-test-return-unibyte)))
505 (should (stringp result))
506 (should (not (multibyte-string-p (mod-test-return-unibyte))))
507 (should (equal result "foo\x00zot"))))
508
503;;; emacs-module-tests.el ends here 509;;; emacs-module-tests.el ends here