Author: yamakenz
Date: Fri Aug 10 19:26:01 2007
New Revision: 4818
Added:
sigscheme-trunk/test-c/test-array2list.c
Modified:
sigscheme-trunk/NEWS
sigscheme-trunk/QALog
sigscheme-trunk/src/sigscheme.c
sigscheme-trunk/src/sigscheme.h
sigscheme-trunk/test-c/Makefile.am
Log:
* src/sigscheme.h
- (scm_array2list, scm_null_term_array2list, scm_list2null_term_array): New
function decl
* src/sigscheme.c
- (scm_array2list, scm_null_term_array2list, scm_list2null_term_array): New
function
* test-c/test-array2list.c
- New file
- Add tests for the new functions
* test-c/Makefile.am
- Add test-array2list.c
* NEWS
* QALog
- Update
Modified: sigscheme-trunk/NEWS
==============================================================================
--- sigscheme-trunk/NEWS (original)
+++ sigscheme-trunk/NEWS Fri Aug 10 19:26:01 2007
@@ -18,6 +18,9 @@
- New syntax let-optionals* compatible with Gauche, for optional argument
processing
+ - New C interface functions scm_array2list(), scm_null_term_array2list() and
+ scm_list2null_term_array()
+
- %%require-module and scm_require_module(). 'use' and scm_use() have been
deprecated and will be removed in SigScheme 0.9.0
Modified: sigscheme-trunk/QALog
==============================================================================
--- sigscheme-trunk/QALog (original)
+++ sigscheme-trunk/QALog Fri Aug 10 19:26:01 2007
@@ -710,7 +710,7 @@
file: sigscheme.c
category: core
-spec by eyes: [EMAIL PROTECTED], [EMAIL PROTECTED], [EMAIL PROTECTED],
[EMAIL PROTECTED], [EMAIL PROTECTED], [EMAIL PROTECTED], [EMAIL PROTECTED]
+spec by eyes: [EMAIL PROTECTED], [EMAIL PROTECTED], [EMAIL PROTECTED],
[EMAIL PROTECTED], [EMAIL PROTECTED], [EMAIL PROTECTED], [EMAIL PROTECTED],
[EMAIL PROTECTED]
spec by tests:
general review: [EMAIL PROTECTED]
64-bit by eyes: [EMAIL PROTECTED]
@@ -1107,6 +1107,11 @@
Log
---
+2007-08-11 YamaKen <yamaken AT bp.iij4u.or.jp>
+ * sigscheme.c
+ - QA done again @r4818 for array<->list conversion functions. The 3
+ functions are fully tested with test-array2list.c
+
2007-08-09 YamaKen <yamaken AT bp.iij4u.or.jp>
* storage-gc.c
* storage-compact.h
Modified: sigscheme-trunk/src/sigscheme.c
==============================================================================
--- sigscheme-trunk/src/sigscheme.c (original)
+++ sigscheme-trunk/src/sigscheme.c Fri Aug 10 19:26:01 2007
@@ -401,6 +401,69 @@
}
#endif /* SCM_USE_EVAL_C_STRING */
+SCM_EXPORT ScmObj
+scm_array2list(void **ary, size_t size, ScmObj (*conv)(void *))
+{
+ void **p;
+ ScmObj elm, lst;
+ ScmQueue q;
+ DECLARE_INTERNAL_FUNCTION("scm_array2list");
+
+ SCM_ASSERT(ary);
+ SCM_ASSERT(size <= SCM_INT_T_MAX);
+
+ lst = SCM_NULL;
+ SCM_QUEUE_POINT_TO(q, lst);
+ for (p = &ary[0]; p < &ary[size]; p++) {
+ elm = (conv) ? (*conv)(*p) : (ScmObj)(*p);
+ SCM_QUEUE_ADD(q, elm);
+ }
+
+ return lst;
+}
+
+SCM_EXPORT ScmObj
+scm_null_term_array2list(void **ary, ScmObj (*conv)(void *))
+{
+ void **p, *term;
+ ScmObj elm, lst;
+ ScmQueue q;
+ DECLARE_INTERNAL_FUNCTION("scm_null_term_array2list");
+
+ SCM_ASSERT(ary);
+
+ term = (conv) ? NULL : (void *)SCM_EOF;
+
+ lst = SCM_NULL;
+ SCM_QUEUE_POINT_TO(q, lst);
+ for (p = &ary[0]; *p != term; p++) {
+ elm = (conv) ? (*conv)(*p) : (ScmObj)(*p);
+ SCM_QUEUE_ADD(q, elm);
+ }
+
+ return lst;
+}
+
+SCM_EXPORT void **
+scm_list2null_term_array(ScmObj lst, void *(*conv)(ScmObj))
+{
+ scm_int_t len;
+ void **ary, **p;
+ ScmObj elm;
+ DECLARE_INTERNAL_FUNCTION("scm_list2null_term_array");
+
+ len = scm_length(lst);
+ if (!SCM_LISTLEN_PROPERP(len))
+ ERR("proper list required");
+
+ p = ary = scm_malloc((len + 1) * sizeof(void *));
+ FOR_EACH (elm, lst)
+ *p++ = (conv) ? (*conv)(elm) : (void *)elm;
+ *p = NULL;
+
+ return ary;
+}
+
static void
argv_err(char **argv, const char *err_msg)
{
Modified: sigscheme-trunk/src/sigscheme.h
==============================================================================
--- sigscheme-trunk/src/sigscheme.h (original)
+++ sigscheme-trunk/src/sigscheme.h Fri Aug 10 19:26:01 2007
@@ -1248,6 +1248,10 @@
#if SCM_USE_EVAL_C_STRING
SCM_EXPORT ScmObj scm_eval_c_string(const char *exp);
#endif
+SCM_EXPORT ScmObj scm_array2list(void **ary, size_t size,
+ ScmObj (*conv)(void *));
+SCM_EXPORT ScmObj scm_null_term_array2list(void **ary, ScmObj (*conv)(void *));
+SCM_EXPORT void **scm_list2null_term_array(ScmObj lst, void *(*conv)(ScmObj));
/* module.c */
SCM_EXPORT void scm_provide(ScmObj feature);
Modified: sigscheme-trunk/test-c/Makefile.am
==============================================================================
--- sigscheme-trunk/test-c/Makefile.am (original)
+++ sigscheme-trunk/test-c/Makefile.am Fri Aug 10 19:26:01 2007
@@ -12,7 +12,7 @@
test-global.c \
test-gc.c test-gc-protect.c test-gc-protect-stack.c \
test-storage.c test-storage-compact.c \
- test-strcasecmp.c test-length.c test-format.c
+ test-strcasecmp.c test-length.c test-format.c test-array2list.c
SUFFIXES= -coll.o -coll.c
@@ -34,7 +34,8 @@
test-global-coll \
test-gc-coll test-gc-protect-coll test-gc-protect-stack-coll \
test-storage-coll test-storage-compact-coll \
- test-strcasecmp-coll test-length-coll test-format-coll
+ test-strcasecmp-coll test-length-coll test-format-coll \
+ test-array2list-coll
XFAIL_TESTS =
check_PROGRAMS= $(TESTS) test-minishell
else
Added: sigscheme-trunk/test-c/test-array2list.c
==============================================================================
--- (empty file)
+++ sigscheme-trunk/test-c/test-array2list.c Fri Aug 10 19:26:01 2007
@@ -0,0 +1,190 @@
+/*===========================================================================
+ * Filename : test-array2list.c
+ * About : test for list C array <-> Scheme list conversion functions
+ *
+ * Copyright (c) 2007 SigScheme Project <uim-en AT googlegroups.com>
+ *
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ * 3. Neither the name of authors nor the names of its contributors
+ * may be used to endorse or promote products derived from this software
+ * without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
+ * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
+ * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+ * PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
+ * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+===========================================================================*/
+
+#include <assert.h>
+
+#include "sscm-test.h"
+#include "sigschemeinternal.h"
+
+
+static char *char_ary[] = {
+ "abc",
+ "def",
+ "gh",
+ NULL
+};
+
+static char *null_ary[] = {
+ NULL
+};
+
+
+static ScmObj
+make_str(void *str)
+{
+ return MAKE_STRING_COPYING((char *)str, SCM_STRLEN_UNKNOWN);
+}
+
+static void *
+refer_c_str(ScmObj str)
+{
+ return SCM_STRING_STR(str);
+}
+
+TST_CASE("scm_array2list()")
+{
+ void **ary;
+
+ ary = (void **)char_ary;
+
+ TST_TN_EQ_INT(0, scm_length(scm_array2list(ary, 0, make_str)));
+ TST_TN_TRUE ( NULLP(scm_array2list(ary, 0, make_str)));
+
+ TST_TN_EQ_INT(1, scm_length(scm_array2list(ary, 1, make_str)));
+ TST_TN_TRUE (EQUALP(scm_eval_c_string("'(\"abc\")"),
+ scm_array2list(ary, 1, make_str)));
+
+ TST_TN_EQ_INT(2, scm_length(scm_array2list(ary, 2, make_str)));
+ TST_TN_TRUE (EQUALP(scm_eval_c_string("'(\"abc\" \"def\")"),
+ scm_array2list(ary, 2, make_str)));
+
+ TST_TN_EQ_INT(3, scm_length(scm_array2list(ary, 3, make_str)));
+ TST_TN_TRUE (EQUALP(scm_eval_c_string("'(\"abc\" \"def\" \"gh\")"),
+ scm_array2list(ary, 3, make_str)));
+}
+
+TST_CASE("scm_array2list() without conversion")
+{
+ ScmObj obj_ary[4];
+ void **ary;
+
+ obj_ary[0] = make_str(char_ary[0]);
+ obj_ary[1] = make_str(char_ary[1]);
+ obj_ary[2] = make_str(char_ary[2]);
+ obj_ary[3] = SCM_EOF;
+ ary = (void **)obj_ary;
+
+ TST_TN_EQ_INT(0, scm_length(scm_array2list(ary, 0, NULL)));
+ TST_TN_TRUE ( NULLP(scm_array2list(ary, 0, NULL)));
+
+ TST_TN_EQ_INT(1, scm_length(scm_array2list(ary, 1, NULL)));
+ TST_TN_TRUE (EQUALP(scm_eval_c_string("'(\"abc\")"),
+ scm_array2list(ary, 1, NULL)));
+
+ TST_TN_EQ_INT(2, scm_length(scm_array2list(ary, 2, NULL)));
+ TST_TN_TRUE (EQUALP(scm_eval_c_string("'(\"abc\" \"def\")"),
+ scm_array2list(ary, 2, NULL)));
+
+ TST_TN_EQ_INT(3, scm_length(scm_array2list(ary, 3, NULL)));
+ TST_TN_TRUE (EQUALP(scm_eval_c_string("'(\"abc\" \"def\" \"gh\")"),
+ scm_array2list(ary, 3, NULL)));
+}
+
+TST_CASE("scm_null_term_array2list()")
+{
+ void **ary;
+
+ ary = (void **)null_ary;
+
+ TST_TN_EQ_INT(0, scm_length(scm_null_term_array2list(ary, make_str)));
+ TST_TN_TRUE (NULLP(scm_null_term_array2list(ary, make_str)));
+
+ ary = (void **)char_ary;
+
+ TST_TN_EQ_INT(3, scm_length(scm_null_term_array2list(ary, make_str)));
+ TST_TN_TRUE (EQUALP(scm_eval_c_string("'(\"abc\" \"def\" \"gh\")"),
+ scm_null_term_array2list(ary, make_str)));
+}
+
+TST_CASE("scm_null_term_array2list() without conversion")
+{
+ ScmObj obj_ary[4];
+ void **ary;
+
+ obj_ary[0] = SCM_EOF;
+ ary = (void **)obj_ary;
+
+ TST_TN_EQ_INT(0, scm_length(scm_null_term_array2list(ary, NULL)));
+ TST_TN_TRUE (NULLP(scm_null_term_array2list(ary, NULL)));
+
+ obj_ary[0] = make_str(char_ary[0]);
+ obj_ary[1] = make_str(char_ary[1]);
+ obj_ary[2] = make_str(char_ary[2]);
+ obj_ary[3] = SCM_EOF;
+ ary = (void **)obj_ary;
+
+ TST_TN_EQ_INT(3, scm_length(scm_null_term_array2list(ary, NULL)));
+ TST_TN_TRUE (EQUALP(scm_eval_c_string("'(\"abc\" \"def\" \"gh\")"),
+ scm_null_term_array2list(ary, NULL)));
+}
+
+TST_CASE("scm_list2null_term_array()")
+{
+ const char *list1 = "'(\"abc\")";
+ const char *list3 = "'(\"abc\" \"def\" \"gh\")";
+ void **ary;
+
+ ary = scm_list2null_term_array(SCM_NULL, refer_c_str);
+ TST_TN_EQ_PTR(NULL, ary[0]);
+
+ ary = scm_list2null_term_array(scm_eval_c_string(list1), refer_c_str);
+ TST_TN_EQ_STR("abc", ary[0]);
+ TST_TN_EQ_PTR(NULL, ary[1]);
+
+ ary = scm_list2null_term_array(scm_eval_c_string(list3), refer_c_str);
+ TST_TN_EQ_STR("abc", ary[0]);
+ TST_TN_EQ_STR("def", ary[1]);
+ TST_TN_EQ_STR("gh", ary[2]);
+ TST_TN_EQ_PTR(NULL, ary[3]);
+}
+
+TST_CASE("scm_list2null_term_array() without conversion")
+{
+ const char *list1 = "'(\"abc\")";
+ const char *list3 = "'(\"abc\" \"def\" \"gh\")";
+ void **ary;
+
+ ary = scm_list2null_term_array(SCM_NULL, NULL);
+ TST_TN_EQ_PTR(NULL, ary[0]);
+
+ ary = scm_list2null_term_array(scm_eval_c_string(list1), NULL);
+ TST_TN_TRUE(EQUALP(CONST_STRING("abc"), (ScmObj)ary[0]));
+ TST_TN_EQ_PTR(NULL, ary[1]);
+
+ ary = scm_list2null_term_array(scm_eval_c_string(list3), NULL);
+ TST_TN_TRUE(EQUALP(CONST_STRING("abc"), (ScmObj)ary[0]));
+ TST_TN_TRUE(EQUALP(CONST_STRING("def"), (ScmObj)ary[1]));
+ TST_TN_TRUE(EQUALP(CONST_STRING("gh"), (ScmObj)ary[2]));
+ TST_TN_EQ_PTR(NULL, ary[3]);
+}
