diff options
author | Andy Wingo <wingo@pobox.com> | 2014-04-27 14:47:40 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2014-04-28 10:59:11 +0200 |
commit | a7ee7f7cbf1042cf9e4b4c4f3b28b6759ccbce4f (patch) | |
tree | b69c4d2e9ceb614fed11eae17131b8a35bfcfd89 /test-suite/standalone/test-foreign-object-c.c | |
parent | 48ad85fb56bc022ac10f42cf07b5657d75b5b696 (diff) | |
download | guile-a7ee7f7cbf1042cf9e4b4c4f3b28b6759ccbce4f.tar.gz |
New foreign object facility, to replace SMOBs
* libguile/foreign-object.c:
* libguile/foreign-object.h:
* module/system/foreign-object.scm:
* test-suite/standalone/test-foreign-object-c.c:
* test-suite/standalone/test-foreign-object-scm: New files.
* test-suite/standalone/Makefile.am:
* module/Makefile.am:
* libguile/Makefile.am: Add new files.
* libguile.h: Add foreign-object.h.
* libguile/init.c (scm_i_init_guile): Call scm_register_foreign_object.
Diffstat (limited to 'test-suite/standalone/test-foreign-object-c.c')
-rw-r--r-- | test-suite/standalone/test-foreign-object-c.c | 116 |
1 files changed, 116 insertions, 0 deletions
diff --git a/test-suite/standalone/test-foreign-object-c.c b/test-suite/standalone/test-foreign-object-c.c new file mode 100644 index 000000000..9cd8d6721 --- /dev/null +++ b/test-suite/standalone/test-foreign-object-c.c @@ -0,0 +1,116 @@ +/* test-foreign-object-c.c - exercise C foreign object interface */ + +/* Copyright (C) 2014 Free Software Foundation, Inc. + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public License + * as published by the Free Software Foundation; either version 3 of + * the License, or (at your option) any later version. + * + * This library is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA + * 02110-1301 USA + */ + +#ifdef HAVE_CONFIG_H +# include <config.h> +#endif + +#include <libguile.h> + +#include <stdlib.h> +#include <stdio.h> +#include <string.h> + +enum + { + CSTR_SLOT_ADDR, + CSTR_SLOT_LEN, + CSTR_SLOT_COUNT + }; + +static void +finalizer (SCM obj) +{ + scm_t_bits addr = scm_foreign_object_ref (obj, CSTR_SLOT_ADDR); + free ((void *) addr); +} + +static SCM +make_cstr_from_static (SCM type, const char *str) +{ + char *ours = strdup (str); + + if (!ours) + abort (); + + return scm_make_foreign_object_2 (type, (scm_t_bits) ours, strlen (ours)); +} + +static int +cstr_equals_static_p (SCM cstr, const char *str) +{ + const char *addr; + size_t len; + + addr = (const char *) scm_foreign_object_ref (cstr, CSTR_SLOT_ADDR); + len = scm_foreign_object_ref (cstr, CSTR_SLOT_LEN); + + if (strlen (str) != len) + return 0; + + return strncmp (addr, str, len) == 0; +} + +static void +test_scm_foreign_object (void) +{ + SCM type_name, slot_names, type, cstr; + + type_name = scm_from_utf8_symbol ("<cstr>"); + slot_names = scm_list_2 (scm_from_utf8_symbol ("addr"), + scm_from_utf8_symbol ("len")); + type = scm_make_foreign_object_type (type_name, slot_names, finalizer); + + cstr = make_cstr_from_static (type, "Hello, world!"); + scm_assert_foreign_object_type (type, cstr); + + if (!cstr_equals_static_p (cstr, "Hello, world!")) + { + fprintf (stderr, "fail: test-foreign-object 1\n"); + exit (EXIT_FAILURE); + } + + { + int i; + for (i = 0; i < 5000; i++) + cstr = make_cstr_from_static (type, "Hello, world!"); + cstr = SCM_BOOL_F; + } + + scm_gc (); + scm_gc (); + scm_gc (); + + /* Allow time for the finalizer thread to run. */ + scm_usleep (scm_from_uint (50 * 1000)); +} + +static void +tests (void *data, int argc, char **argv) +{ + test_scm_foreign_object (); +} + +int +main (int argc, char *argv[]) +{ + scm_boot_guile (argc, argv, tests, NULL); + return 0; +} |