diff options
| author | Lars Ingebrigtsen | 2020-10-13 06:51:06 +0200 |
|---|---|---|
| committer | Lars Ingebrigtsen | 2020-10-13 06:51:06 +0200 |
| commit | 12175a339e2a2214fdd0ab4e16d8d8b1e92a78d3 (patch) | |
| tree | c68e82a585d8a760b569b536d8951e18166a9d9d | |
| parent | 45cb0403deeba1cc121147b1884e7fea6cd15338 (diff) | |
| download | emacs-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.texi | 6 | ||||
| -rw-r--r-- | src/emacs-module.c | 13 | ||||
| -rw-r--r-- | src/module-env-25.h | 5 | ||||
| -rw-r--r-- | test/data/emacs-module/mod-test.c | 11 | ||||
| -rw-r--r-- | test/src/emacs-module-tests.el | 6 |
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 | |||
| 1854 | negative or exceeds the maximum length of an Emacs string. | 1854 | negative 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}) | ||
| 1858 | This function is like @code{make_string}, but has no restrictions on | ||
| 1859 | the values of the bytes in the C string, and can be used to pass | ||
| 1860 | binary data to Emacs in the form of a unibyte string. | ||
| 1861 | @end deftypefn | ||
| 1862 | |||
| 1857 | The @acronym{API} does not provide functions to manipulate Lisp data | 1863 | The @acronym{API} does not provide functions to manipulate Lisp data |
| 1858 | structures, for example, create lists with @code{cons} and @code{list} | 1864 | structures, 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 | ||
| 793 | static emacs_value | 793 | static emacs_value |
| 794 | module_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 | |||
| 805 | static emacs_value | ||
| 794 | module_make_user_ptr (emacs_env *env, emacs_finalizer fin, void *ptr) | 806 | module_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. */ | ||
| 272 | static emacs_value | ||
| 273 | Fmod_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 |