[uim-commit] r2876 - in branches/r5rs: sigscheme sigscheme/test uim
yamaken at freedesktop.org
yamaken at freedesktop.org
Mon Jan 9 12:16:56 PST 2006
Author: yamaken
Date: 2006-01-09 12:16:53 -0800 (Mon, 09 Jan 2006)
New Revision: 2876
Modified:
branches/r5rs/sigscheme/error.c
branches/r5rs/sigscheme/io.c
branches/r5rs/sigscheme/main.c
branches/r5rs/sigscheme/operations-nonstd.c
branches/r5rs/sigscheme/operations-srfi34.c
branches/r5rs/sigscheme/operations-srfi6.c
branches/r5rs/sigscheme/operations.c
branches/r5rs/sigscheme/read.c
branches/r5rs/sigscheme/sigscheme.c
branches/r5rs/sigscheme/sigscheme.h
branches/r5rs/sigscheme/sigschemeinternal.h
branches/r5rs/sigscheme/storage-compact.h
branches/r5rs/sigscheme/storage-fatty.h
branches/r5rs/sigscheme/storage.c
branches/r5rs/sigscheme/test/test-string.scm
branches/r5rs/uim/uim-compat-scm.c
branches/r5rs/uim/uim-scm.c
Log:
* This commit make string object creation efficient when the length is
already known. The codes still have a bug about handling null
character in string. It will be fixed soon
* sigscheme/sigscheme.h
- (SCM_MAKE_STRING, SCM_MAKE_STRING_COPYING,
SCM_MAKE_IMMUTABLE_STRING, SCM_MAKE_IMMUTABLE_STRING_COPYING,
SCM_CONST_STRING, SCM_STRLEN_UNKNOWN): New macro
* sigscheme/sigschemeinternal.h
- (CONST_STRING, STRLEN_UNKNOWN): New macro
* sigscheme/storage-fatty.h
- (scm_make_immutable_string, scm_make_immutable_string_copying,
scm_make_string, scm_make_string_copying): Add arg 'len'
* sigscheme/storage-compact.h
- (scm_make_immutable_string, scm_make_immutable_string_copying,
scm_make_string, scm_make_string_copying): Add arg 'len'
* sigscheme/storage.c
- (scm_make_immutable_string, scm_make_immutable_string_copying,
scm_make_string, scm_make_string_copying,
scm_make_string_internal): Add arg 'len'
* sigscheme/operations.c
- (scm_p_number2string, scm_p_substring, scm_p_string_append,
scm_p_string_copy): Make efficient with the new interface
- (scm_p_symbol2string, scm_p_make_string, scm_p_list2string,
scm_p_string_filld): Follow the API changes
* sigscheme/error.c
- (scm_init_error, scm_die, scm_error, scm_error_obj): Follow the
API changes
* sigscheme/operations-srfi34.c
- (scm_initialize_srfi34): Ditto
* sigscheme/operations-srfi6.c
- (scm_p_srfi6_get_output_string): Ditto
* sigscheme/io.c
- (scm_load_internal): Ditto
* sigscheme/operations-nonstd.c
- (scm_p_load_path, make_loaded_str): Ditto
* sigscheme/sigscheme.c
- (scm_initialize_internal, scm_s_use, scm_interpret_argv); Ditto
* sigscheme/main.c
- (main): Ditto
* sigscheme/read.c
- (read_string):
* Make efficient with the new interface
* Support null char in string
* uim/uim-scm.c
- (uim_scm_make_str): Follow the API changes
* uim/uim-compat-scm.c
- (uim_scm_c_strs_into_list, uim_scm_provide): Ditto
Modified: branches/r5rs/sigscheme/error.c
===================================================================
--- branches/r5rs/sigscheme/error.c 2006-01-09 18:48:35 UTC (rev 2875)
+++ branches/r5rs/sigscheme/error.c 2006-01-09 20:16:53 UTC (rev 2876)
@@ -81,8 +81,7 @@
/* allocate a cons cell as unique ID */
scm_gc_protect_with_init(&err_obj_tag, CONS(SCM_UNDEF, SCM_UNDEF));
- scm_gc_protect_with_init(&str_srfi34,
- MAKE_IMMUTABLE_STRING_COPYING("srfi-34"));
+ scm_gc_protect_with_init(&str_srfi34, CONST_STRING("srfi-34"));
srfi34_is_provided = scm_false;
cb_fatal_error = NULL;
@@ -298,7 +297,7 @@
asprintf(&reason, "%s: (file: %s, line: %d)", msg, filename, line);
ENSURE_ALLOCATED(reason);
/* reason will implicitly be freed via the object on GC */
- reason_holder = MAKE_IMMUTABLE_STRING(reason);
+ reason_holder = MAKE_IMMUTABLE_STRING(reason, STRLEN_UNKNOWN);
scm_fatal_error(reason);
/* NOTREACHED */
@@ -317,7 +316,8 @@
va_end(va);
ENSURE_ALLOCATED(reason);
- err_obj = scm_make_error_obj(MAKE_IMMUTABLE_STRING(reason), SCM_NULL);
+ err_obj = scm_make_error_obj(MAKE_IMMUTABLE_STRING(reason, STRLEN_UNKNOWN),
+ SCM_NULL);
scm_raise_error(err_obj);
/* NOTREACHED */
}
@@ -332,7 +332,8 @@
asprintf(&reason, "in %s: %s", func_name, msg);
ENSURE_ALLOCATED(reason);
- err_obj = scm_make_error_obj(MAKE_IMMUTABLE_STRING(reason), LIST_1(obj));
+ err_obj = scm_make_error_obj(MAKE_IMMUTABLE_STRING(reason, STRLEN_UNKNOWN),
+ LIST_1(obj));
scm_raise_error(err_obj);
/* NOTREACHED */
}
Modified: branches/r5rs/sigscheme/io.c
===================================================================
--- branches/r5rs/sigscheme/io.c 2006-01-09 18:48:35 UTC (rev 2875)
+++ branches/r5rs/sigscheme/io.c 2006-01-09 20:16:53 UTC (rev 2876)
@@ -592,7 +592,7 @@
if (!c_path)
ERR("scm_load_internal: file \"%s\" not found", filename);
- path = MAKE_IMMUTABLE_STRING(c_path);
+ path = MAKE_IMMUTABLE_STRING(c_path, STRLEN_UNKNOWN);
port = scm_p_open_input_file(path);
saved_codec = scm_current_char_codec;
Modified: branches/r5rs/sigscheme/main.c
===================================================================
--- branches/r5rs/sigscheme/main.c 2006-01-09 18:48:35 UTC (rev 2875)
+++ branches/r5rs/sigscheme/main.c 2006-01-09 20:16:53 UTC (rev 2876)
@@ -180,8 +180,7 @@
#endif
#if SCM_COMPAT_SIOD
- scm_gc_protect_with_init(&feature_id_siod,
- MAKE_IMMUTABLE_STRING_COPYING(FEATURE_ID_SIOD));
+ scm_gc_protect_with_init(&feature_id_siod, CONST_STRING(FEATURE_ID_SIOD));
#endif
if (filename) {
Modified: branches/r5rs/sigscheme/operations-nonstd.c
===================================================================
--- branches/r5rs/sigscheme/operations-nonstd.c 2006-01-09 18:48:35 UTC (rev 2875)
+++ branches/r5rs/sigscheme/operations-nonstd.c 2006-01-09 20:16:53 UTC (rev 2876)
@@ -111,7 +111,7 @@
{
DECLARE_FUNCTION("load-path", procedure_fixed_0);
- return MAKE_IMMUTABLE_STRING_COPYING(scm_lib_path);
+ return CONST_STRING(scm_lib_path);
}
void
@@ -177,7 +177,7 @@
loaded_str = scm_malloc(size);
snprintf(loaded_str, size, "*%s-loaded*", filename);
- return MAKE_IMMUTABLE_STRING(loaded_str);
+ return MAKE_IMMUTABLE_STRING(loaded_str, STRLEN_UNKNOWN);
}
/*
Modified: branches/r5rs/sigscheme/operations-srfi34.c
===================================================================
--- branches/r5rs/sigscheme/operations-srfi34.c 2006-01-09 18:48:35 UTC (rev 2875)
+++ branches/r5rs/sigscheme/operations-srfi34.c 2006-01-09 20:16:53 UTC (rev 2876)
@@ -129,12 +129,9 @@
for (var = &global_var_list[0]; *var; var++)
scm_gc_protect_with_init(*var, SCM_FALSE);
- errmsg_unhandled_exception
- = MAKE_IMMUTABLE_STRING_COPYING(ERRMSG_UNHANDLED_EXCEPTION);
- errmsg_handler_returned
- = MAKE_IMMUTABLE_STRING_COPYING(ERRMSG_HANDLER_RETURNED);
- errmsg_fallback_exhausted
- = MAKE_IMMUTABLE_STRING_COPYING(ERRMSG_FALLBACK_EXHAUSTED);
+ errmsg_unhandled_exception = CONST_STRING(ERRMSG_UNHANDLED_EXCEPTION);
+ errmsg_handler_returned = CONST_STRING(ERRMSG_HANDLER_RETURNED);
+ errmsg_fallback_exhausted = CONST_STRING(ERRMSG_FALLBACK_EXHAUSTED);
sym_error = scm_intern("error");
sym_raise = scm_intern("raise");
Modified: branches/r5rs/sigscheme/operations-srfi6.c
===================================================================
--- branches/r5rs/sigscheme/operations-srfi6.c 2006-01-09 18:48:35 UTC (rev 2875)
+++ branches/r5rs/sigscheme/operations-srfi6.c 2006-01-09 20:16:53 UTC (rev 2876)
@@ -118,7 +118,8 @@
SCM_ENSURE_LIVE_PORT(port);
cport = SCM_CHARPORT_DYNAMIC_CAST(ScmBaseCharPort, SCM_PORT_IMPL(port));
- return MAKE_STRING_COPYING(ScmOutputStrPort_str(cport->bport));
+ return MAKE_STRING_COPYING(ScmOutputStrPort_str(cport->bport),
+ STRLEN_UNKNOWN);
}
Modified: branches/r5rs/sigscheme/operations.c
===================================================================
--- branches/r5rs/sigscheme/operations.c 2006-01-09 18:48:35 UTC (rev 2875)
+++ branches/r5rs/sigscheme/operations.c 2006-01-09 20:16:53 UTC (rev 2876)
@@ -569,6 +569,7 @@
{
char buf[sizeof(int) * CHAR_BIT + sizeof("")];
char *p;
+ const char *end;
int n, r, digit;
scm_bool neg;
DECLARE_FUNCTION("number->string", procedure_variadic_1);
@@ -580,7 +581,7 @@
n = abs(n);
r = prepare_radix(SCM_MANGLE(name), args);
- p = &buf[sizeof(buf) - 1];
+ end = p = &buf[sizeof(buf) - 1];
*p = '\0';
do {
@@ -590,7 +591,7 @@
if (neg)
*--p = '-';
- return MAKE_STRING_COPYING(p);
+ return MAKE_STRING_COPYING(p, end - p);
}
ScmObj
@@ -1068,7 +1069,7 @@
ENSURE_SYMBOL(sym);
- return MAKE_IMMUTABLE_STRING_COPYING(SCM_SYMBOL_NAME(sym));
+ return CONST_STRING(SCM_SYMBOL_NAME(sym));
}
ScmObj
@@ -1247,7 +1248,7 @@
ENSURE_INT(length);
len = SCM_INT_VALUE(length);
if (len == 0)
- return MAKE_STRING_COPYING("");
+ return MAKE_STRING_COPYING("", 0);
if (len < 0)
ERR_OBJ("length must be a positive integer", length);
@@ -1423,21 +1424,21 @@
memcpy(new_str, SCM_MBS_GET_STR(mbs), SCM_MBS_GET_SIZE(mbs));
new_str[SCM_MBS_GET_SIZE(mbs)] = '\0';
- return MAKE_STRING(new_str);
+ return MAKE_STRING(new_str, c_end - c_start);
}
/* FIXME: support stateful encoding */
ScmObj
scm_p_string_append(ScmObj args)
{
- ScmObj rest, str, ret;
+ ScmObj rest, str;
size_t byte_len, mb_len;
char *new_str, *dst;
const char *src;
DECLARE_FUNCTION("string-append", procedure_variadic_0);
if (NULLP(args))
- return MAKE_STRING_COPYING("");
+ return MAKE_STRING_COPYING("", 0);
/* count total size of the new string */
byte_len = mb_len = 0;
@@ -1458,11 +1459,7 @@
}
*dst = '\0';
- ret = MAKE_STRING((char *)""); /* dummy string */
- SCM_STRING_SET_STR(ret, new_str);
- SCM_STRING_SET_LEN(ret, mb_len);
-
- return ret;
+ return MAKE_STRING(new_str, mb_len);
}
ScmObj
@@ -1497,7 +1494,7 @@
ENSURE_LIST(lst);
if (NULLP(lst))
- return MAKE_STRING_COPYING("");
+ return MAKE_STRING_COPYING("", 0);
/* TODO: make efficient */
sport = scm_p_srfi6_open_output_string();
@@ -1518,7 +1515,7 @@
ENSURE_STRING(str);
- return MAKE_STRING_COPYING(SCM_STRING_STR(str));
+ return MAKE_STRING_COPYING(SCM_STRING_STR(str), SCM_STRING_LEN(str));
}
ScmObj
@@ -1537,7 +1534,7 @@
str_len = SCM_STRING_LEN(str);
if (str_len == 0)
- return MAKE_STRING_COPYING("");
+ return MAKE_STRING_COPYING("", 0);
next = SCM_CHARCODEC_INT2STR(scm_current_char_codec, ch_str,
SCM_CHAR_VALUE(ch), SCM_MB_STATELESS);
Modified: branches/r5rs/sigscheme/read.c
===================================================================
--- branches/r5rs/sigscheme/read.c 2006-01-09 18:48:35 UTC (rev 2875)
+++ branches/r5rs/sigscheme/read.c 2006-01-09 20:16:53 UTC (rev 2876)
@@ -532,7 +532,7 @@
ScmObj obj;
const ScmSpecialCharInfo *info;
ScmCharCodec *codec;
- int c;
+ int c, len;
size_t offset;
char *p;
ScmLBuf(char) lbuf;
@@ -544,7 +544,10 @@
LBUF_INIT(lbuf, init_buf, sizeof(init_buf));
codec = scm_port_codec(port);
- for (offset = 0, p = LBUF_BUF(lbuf);; offset = p - LBUF_BUF(lbuf)) {
+ for (offset = 0, p = LBUF_BUF(lbuf), len = 0;
+ ;
+ offset = p - LBUF_BUF(lbuf), len++)
+ {
c = scm_port_get_char(port);
CDBG((SCM_DBG_PARSER, "read_string c = %c", c));
@@ -559,7 +562,7 @@
case '\"':
LBUF_EXTEND(lbuf, SCM_LBUF_F_STRING, offset + 1);
*p = '\0';
- obj = MAKE_IMMUTABLE_STRING_COPYING(LBUF_BUF(lbuf));
+ obj = MAKE_IMMUTABLE_STRING_COPYING(LBUF_BUF(lbuf), len);
LBUF_FREE(lbuf);
return obj;
Modified: branches/r5rs/sigscheme/sigscheme.c
===================================================================
--- branches/r5rs/sigscheme/sigscheme.c 2006-01-09 18:48:35 UTC (rev 2875)
+++ branches/r5rs/sigscheme/sigscheme.c 2006-01-09 20:16:53 UTC (rev 2876)
@@ -183,15 +183,15 @@
Fixing up
=======================================================================*/
/* to evaluate SigScheme-dependent codes conditionally */
- scm_provide(MAKE_IMMUTABLE_STRING_COPYING("sigscheme"));
+ scm_provide(CONST_STRING("sigscheme"));
#if SCM_STRICT_R5RS
- scm_provide(MAKE_IMMUTABLE_STRING_COPYING("strict-r5rs"));
+ scm_provide(CONST_STRING("strict-r5rs"));
#endif
#if SCM_STRICT_ARGCHECK
- scm_provide(MAKE_IMMUTABLE_STRING_COPYING("strict-argcheck"));
+ scm_provide(CONST_STRING("strict-argcheck"));
#endif
#if SCM_COMPAT_SIOD_BUGS
- scm_provide(MAKE_IMMUTABLE_STRING_COPYING("siod-bugs"));
+ scm_provide(CONST_STRING("siod-bugs"));
#endif
scm_initialized = scm_true;
}
@@ -280,7 +280,7 @@
for (mod = module_info_table; mod->name; mod++) {
if (strcmp(c_feature_str, mod->name) == 0) {
- feature_str = MAKE_IMMUTABLE_STRING_COPYING(c_feature_str);
+ feature_str = CONST_STRING(c_feature_str);
if (!scm_providedp(feature_str)) {
(*mod->initializer)();
scm_provide(feature_str);
@@ -383,7 +383,7 @@
specified_codec = scm_mb_find_codec(encoding);
if (!specified_codec) {
if (scm_initialized) {
- err_obj = MAKE_IMMUTABLE_STRING_COPYING(encoding);
+ err_obj = CONST_STRING(encoding);
scm_free_argv(argv);
ERR_OBJ("unsupported encoding", err_obj);
} else {
Modified: branches/r5rs/sigscheme/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/sigscheme.h 2006-01-09 18:48:35 UTC (rev 2875)
+++ branches/r5rs/sigscheme/sigscheme.h 2006-01-09 20:16:53 UTC (rev 2876)
@@ -389,11 +389,19 @@
#define SCM_MAKE_CONS(kar, kdr) SCM_SAL_MAKE_CONS((kar), (kdr))
#define SCM_MAKE_SYMBOL(name, val) SCM_SAL_MAKE_SYMBOL((name), (val))
#define SCM_MAKE_CHAR(val) SCM_SAL_MAKE_CHAR(val)
-#define SCM_MAKE_STRING(str) SCM_SAL_MAKE_STRING(str)
-#define SCM_MAKE_STRING_COPYING(str) SCM_SAL_MAKE_STRING_COPYING(str)
-#define SCM_MAKE_IMMUTABLE_STRING(str) SCM_SAL_MAKE_IMMUTABLE_STRING(str)
-#define SCM_MAKE_IMMUTABLE_STRING_COPYING(str) \
- SCM_SAL_MAKE_IMMUTABLE_STRING_COPYING(str)
+
+#define SCM_MAKE_STRING(str, len) \
+ SCM_SAL_MAKE_STRING((str), (len))
+#define SCM_MAKE_STRING_COPYING(str, len) \
+ SCM_SAL_MAKE_STRING_COPYING((str), (len))
+#define SCM_MAKE_IMMUTABLE_STRING(str, len) \
+ SCM_SAL_MAKE_IMMUTABLE_STRING((str), (len))
+#define SCM_MAKE_IMMUTABLE_STRING_COPYING(str, len) \
+ SCM_SAL_MAKE_IMMUTABLE_STRING_COPYING((str), (len))
+#define SCM_CONST_STRING(str) \
+ SCM_MAKE_IMMUTABLE_STRING_COPYING((str), SCM_STRLEN_UNKNOWN)
+#define SCM_STRLEN_UNKNOWN -1
+
/* SCM_MAKE_FUNC(enum ScmFuncTypeCode type, ScmFuncType func) */
#define SCM_MAKE_FUNC(type, func) SCM_SAL_MAKE_FUNC((type), (func))
#define SCM_MAKE_CLOSURE(exp, env) SCM_SAL_MAKE_CLOSURE((exp), (env))
Modified: branches/r5rs/sigscheme/sigschemeinternal.h
===================================================================
--- branches/r5rs/sigscheme/sigschemeinternal.h 2006-01-09 18:48:35 UTC (rev 2875)
+++ branches/r5rs/sigscheme/sigschemeinternal.h 2006-01-09 20:16:53 UTC (rev 2876)
@@ -177,10 +177,14 @@
#define MAKE_CONS SCM_MAKE_CONS
#define MAKE_SYMBOL SCM_MAKE_SYMBOL
#define MAKE_CHAR SCM_MAKE_CHAR
+
#define MAKE_STRING SCM_MAKE_STRING
#define MAKE_STRING_COPYING SCM_MAKE_STRING_COPYING
#define MAKE_IMMUTABLE_STRING SCM_MAKE_IMMUTABLE_STRING
#define MAKE_IMMUTABLE_STRING_COPYING SCM_MAKE_IMMUTABLE_STRING_COPYING
+#define CONST_STRING SCM_CONST_STRING
+#define STRLEN_UNKNOWN SCM_STRLEN_UNKNOWN
+
#define MAKE_FUNC SCM_MAKE_FUNC
#define MAKE_CLOSURE SCM_MAKE_CLOSURE
#define MAKE_VECTOR SCM_MAKE_VECTOR
@@ -231,6 +235,7 @@
#define ENSURE_PROPER_LIST_TERMINATION SCM_ENSURE_PROPER_LIST_TERMINATION
#define CHECK_PROPER_LIST_TERMINATION SCM_CHECK_PROPER_LIST_TERMINATION
+
/*
* Abbrev name for these constants are not provided since it involves some
* consistency problems and confusions. Use the canonical names always.
Modified: branches/r5rs/sigscheme/storage-compact.h
===================================================================
--- branches/r5rs/sigscheme/storage-compact.h 2006-01-09 18:48:35 UTC (rev 2875)
+++ branches/r5rs/sigscheme/storage-compact.h 2006-01-09 20:16:53 UTC (rev 2876)
@@ -668,10 +668,10 @@
ScmObj scm_make_char(int val);
#endif
ScmObj scm_make_symbol(char *name, ScmObj val);
-ScmObj scm_make_immutable_string(char *str);
-ScmObj scm_make_immutable_string_copying(const char *str);
-ScmObj scm_make_string(char *str);
-ScmObj scm_make_string_copying(const char *str);
+ScmObj scm_make_immutable_string(char *str, int len);
+ScmObj scm_make_immutable_string_copying(const char *str, int len);
+ScmObj scm_make_string(char *str, int len);
+ScmObj scm_make_string_copying(const char *str, int len);
ScmObj scm_make_func(enum ScmFuncTypeCode type, ScmFuncType func);
ScmObj scm_make_closure(ScmObj exp, ScmObj env);
ScmObj scm_make_vector(ScmObj *vec, int len);
Modified: branches/r5rs/sigscheme/storage-fatty.h
===================================================================
--- branches/r5rs/sigscheme/storage-fatty.h 2006-01-09 18:48:35 UTC (rev 2875)
+++ branches/r5rs/sigscheme/storage-fatty.h 2006-01-09 20:16:53 UTC (rev 2876)
@@ -173,10 +173,10 @@
ScmObj scm_make_int(int val);
ScmObj scm_make_symbol(char *name, ScmObj val);
ScmObj scm_make_char(int val);
-ScmObj scm_make_immutable_string(char *str);
-ScmObj scm_make_immutable_string_copying(const char *str);
-ScmObj scm_make_string(char *str);
-ScmObj scm_make_string_copying(const char *str);
+ScmObj scm_make_immutable_string(char *str, int len);
+ScmObj scm_make_immutable_string_copying(const char *str, int len);
+ScmObj scm_make_string(char *str, int len);
+ScmObj scm_make_string_copying(const char *str, int len);
ScmObj scm_make_func(enum ScmFuncTypeCode type, ScmFuncType func);
ScmObj scm_make_closure(ScmObj exp, ScmObj env);
ScmObj scm_make_vector(ScmObj *vec, int len);
Modified: branches/r5rs/sigscheme/storage.c
===================================================================
--- branches/r5rs/sigscheme/storage.c 2006-01-09 18:48:35 UTC (rev 2875)
+++ branches/r5rs/sigscheme/storage.c 2006-01-09 20:16:53 UTC (rev 2876)
@@ -83,7 +83,8 @@
File Local Function Declarations
=======================================*/
static void initialize_special_constants(void);
-static ScmObj scm_make_string_internal(char *str, scm_bool is_immutable);
+static ScmObj scm_make_string_internal(char *str, int len,
+ scm_bool is_immutable);
/*=======================================
Function Implementations
@@ -204,16 +205,19 @@
}
static ScmObj
-scm_make_string_internal(char *str, scm_bool is_immutable)
+scm_make_string_internal(char *str, int len, scm_bool is_immutable)
{
ScmObj obj;
SCM_ASSERT(str);
+ if (len == STRLEN_UNKNOWN)
+ len = scm_mb_bare_c_strlen(str);
+
obj = scm_alloc_cell();
SCM_ENTYPE_STRING(obj);
SCM_STRING_SET_STR(obj, str);
- SCM_STRING_SET_LEN(obj, (*str) ? scm_mb_bare_c_strlen(str) : 0);
+ SCM_STRING_SET_LEN(obj, len);
if (is_immutable)
SCM_STRING_SET_IMMUTABLE(obj);
@@ -224,27 +228,27 @@
}
ScmObj
-scm_make_immutable_string(char *str)
+scm_make_immutable_string(char *str, int len)
{
- return scm_make_string_internal(str, scm_true);
+ return scm_make_string_internal(str, len, scm_true);
}
ScmObj
-scm_make_immutable_string_copying(const char *str)
+scm_make_immutable_string_copying(const char *str, int len)
{
- return scm_make_string_internal(strdup(str), scm_true);
+ return scm_make_string_internal(strdup(str), len, scm_true);
}
ScmObj
-scm_make_string(char *str)
+scm_make_string(char *str, int len)
{
- return scm_make_string_internal(str, scm_false);
+ return scm_make_string_internal(str, len, scm_false);
}
ScmObj
-scm_make_string_copying(const char *str)
+scm_make_string_copying(const char *str, int len)
{
- return scm_make_string_internal(strdup(str), scm_false);
+ return scm_make_string_internal(strdup(str), len, scm_false);
}
ScmObj
Modified: branches/r5rs/sigscheme/test/test-string.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-string.scm 2006-01-09 18:48:35 UTC (rev 2875)
+++ branches/r5rs/sigscheme/test/test-string.scm 2006-01-09 20:16:53 UTC (rev 2876)
@@ -318,28 +318,29 @@
(assert-equal? "R5RS escape sequence" '(#\newline) (string->list "\n")) ;; 110
;; R6RS(SRFI-75) compliant
-(assert-equal? "R6RS escape sequence" (integer->string 0) "\x00") ;; 0
-(assert-equal? "R6RS escape sequence" (list->string '(#\nul)) "\x00") ;; 0
-(assert-equal? "R6RS escape sequence" '(#\nul) (string->list "\x00")) ;; 0
-(assert-equal? "R6RS escape sequence" (integer->string 7) "\a") ;; 97
-(assert-equal? "R6RS escape sequence" (list->string '(#\alarm)) "\a") ;; 97
-(assert-equal? "R6RS escape sequence" '(#\alarm) (string->list "\a")) ;; 97
-(assert-equal? "R6RS escape sequence" (integer->string 8) "\b") ;; 98
-(assert-equal? "R6RS escape sequence" (list->string '(#\backspace)) "\b") ;; 98
-(assert-equal? "R6RS escape sequence" '(#\backspace) (string->list "\b")) ;; 98
-(assert-equal? "R6RS escape sequence" (integer->string 12) "\f") ;; 102
-(assert-equal? "R6RS escape sequence" (list->string '(#\page)) "\f") ;; 102
-(assert-equal? "R6RS escape sequence" '(#\page) (string->list "\f")) ;; 102
-(assert-equal? "R6RS escape sequence" (integer->string 13) "\r") ;; 114
-(assert-equal? "R6RS escape sequence" (list->string '(#\return)) "\r") ;; 114
-(assert-equal? "R6RS escape sequence" '(#\return) (string->list "\r")) ;; 114
-(assert-equal? "R6RS escape sequence" (integer->string 9) "\t") ;; 116
-(assert-equal? "R6RS escape sequence" (list->string '(#\tab)) "\t") ;; 116
-(assert-equal? "R6RS escape sequence" '(#\tab) (string->list "\t")) ;; 116
-(assert-equal? "R6RS escape sequence" (integer->string 11) "\v") ;; 118
-(assert-equal? "R6RS escape sequence" (list->string '(#\vtab)) "\v") ;; 118
-(assert-equal? "R6RS escape sequence" '(#\vtab) (string->list "\v")) ;; 118
-(assert-equal? "R6RS escape sequence" (integer->string 124) "\|") ;; 124
+(tn "R6RS escape sequence")
+(assert-equal? (tn) (integer->string 0) "\x00") ;; 0
+(assert-equal? (tn) (list->string '(#\nul)) "\x00") ;; 0
+(assert-equal? (tn) '(#\nul) (string->list "\x00")) ;; 0
+(assert-equal? (tn) (integer->string 7) "\a") ;; 97
+(assert-equal? (tn) (list->string '(#\alarm)) "\a") ;; 97
+(assert-equal? (tn) '(#\alarm) (string->list "\a")) ;; 97
+(assert-equal? (tn) (integer->string 8) "\b") ;; 98
+(assert-equal? (tn) (list->string '(#\backspace)) "\b") ;; 98
+(assert-equal? (tn) '(#\backspace) (string->list "\b")) ;; 98
+(assert-equal? (tn) (integer->string 12) "\f") ;; 102
+(assert-equal? (tn) (list->string '(#\page)) "\f") ;; 102
+(assert-equal? (tn) '(#\page) (string->list "\f")) ;; 102
+(assert-equal? (tn) (integer->string 13) "\r") ;; 114
+(assert-equal? (tn) (list->string '(#\return)) "\r") ;; 114
+(assert-equal? (tn) '(#\return) (string->list "\r")) ;; 114
+(assert-equal? (tn) (integer->string 9) "\t") ;; 116
+(assert-equal? (tn) (list->string '(#\tab)) "\t") ;; 116
+(assert-equal? (tn) '(#\tab) (string->list "\t")) ;; 116
+(assert-equal? (tn) (integer->string 11) "\v") ;; 118
+(assert-equal? (tn) (list->string '(#\vtab)) "\v") ;; 118
+(assert-equal? (tn) '(#\vtab) (string->list "\v")) ;; 118
+(assert-equal? (tn) (integer->string 124) "\|") ;; 124
;; All these conventional escape sequences should cause parse error as defined
;; in SRFI-75: "Any other character in a string after a backslash is an
@@ -442,40 +443,41 @@
(assert-parse-error "conventional escape sequence" "\"\\~\"") ;; 126
;; raw control chars
-(assert-equal? "raw control char in string literal" (integer->string 0) " ") ;; 0
-(assert-equal? "raw control char in string literal" (integer->string 1) "") ;; 1
-(assert-equal? "raw control char in string literal" (integer->string 2) "") ;; 2
-(assert-equal? "raw control char in string literal" (integer->string 3) "") ;; 3
-(assert-equal? "raw control char in string literal" (integer->string 4) "") ;; 4
-(assert-equal? "raw control char in string literal" (integer->string 5) "") ;; 5
-(assert-equal? "raw control char in string literal" (integer->string 6) "") ;; 6
-(assert-equal? "raw control char in string literal" (integer->string 7) "") ;; 7
-(assert-equal? "raw control char in string literal" (integer->string 8) "") ;; 8 ;; DON'T EDIT THIS LINE!
-(assert-equal? "raw control char in string literal" (integer->string 9) " ") ;; 9
-(assert-equal? "raw control char in string literal" (integer->string 10) "
-") ;; 10 ;; DON'T EDIT THIS LINE!
-(assert-equal? "raw control char in string literal" (integer->string 11) " ") ;; 11
-(assert-equal? "raw control char in string literal" (integer->string 12) " ") ;; 12
-(assert-equal? "raw control char in string literal" (integer->string 13) "
") ;; 13 ;; DON'T EDIT THIS LINE!
-(assert-equal? "raw control char in string literal" (integer->string 14) "") ;; 14
-(assert-equal? "raw control char in string literal" (integer->string 15) "") ;; 15
-(assert-equal? "raw control char in string literal" (integer->string 16) "") ;; 16
-(assert-equal? "raw control char in string literal" (integer->string 17) "") ;; 17
-(assert-equal? "raw control char in string literal" (integer->string 18) "") ;; 18
-(assert-equal? "raw control char in string literal" (integer->string 19) "") ;; 19
-(assert-equal? "raw control char in string literal" (integer->string 20) "") ;; 20
-(assert-equal? "raw control char in string literal" (integer->string 21) "") ;; 21
-(assert-equal? "raw control char in string literal" (integer->string 22) "") ;; 22
-(assert-equal? "raw control char in string literal" (integer->string 23) "") ;; 23
-(assert-equal? "raw control char in string literal" (integer->string 24) "") ;; 24
-(assert-equal? "raw control char in string literal" (integer->string 25) "") ;; 25 ;; DON'T EDIT THIS LINE!
-(assert-equal? "raw control char in string literal" (integer->string 26) "") ;; 26
-(assert-equal? "raw control char in string literal" (integer->string 27) "") ;; 27
-(assert-equal? "raw control char in string literal" (integer->string 28) "
") ;; 28
-(assert-equal? "raw control char in string literal" (integer->string 29) "
") ;; 29
-(assert-equal? "raw control char in string literal" (integer->string 30) "
") ;; 30
-(assert-equal? "raw control char in string literal" (integer->string 31) " ") ;; 31
-(assert-equal? "raw control char in string literal" (integer->string 127) "") ;; 127
+(tn "raw control char in string literal")
+(assert-equal? (tn) (integer->string 0) " ") ;; 0
+(assert-equal? (tn) (integer->string 1) "") ;; 1
+(assert-equal? (tn) (integer->string 2) "") ;; 2
+(assert-equal? (tn) (integer->string 3) "") ;; 3
+(assert-equal? (tn) (integer->string 4) "") ;; 4
+(assert-equal? (tn) (integer->string 5) "") ;; 5
+(assert-equal? (tn) (integer->string 6) "") ;; 6
+(assert-equal? (tn) (integer->string 7) "") ;; 7
+(assert-equal? (tn) (integer->string 8) "") ;; 8 ;; DON'T EDIT THIS LINE!
+(assert-equal? (tn) (integer->string 9) " ") ;; 9
+(assert-equal? (tn) (integer->string 10) "
+") ;; 10 ;; DON'T EDIT THIS LINE!
+(assert-equal? (tn) (integer->string 11) " ") ;; 11
+(assert-equal? (tn) (integer->string 12) " ") ;; 12
+(assert-equal? (tn) (integer->string 13) "
") ;; 13 ;; DON'T EDIT THIS LINE!
+(assert-equal? (tn) (integer->string 14) "") ;; 14
+(assert-equal? (tn) (integer->string 15) "") ;; 15
+(assert-equal? (tn) (integer->string 16) "") ;; 16
+(assert-equal? (tn) (integer->string 17) "") ;; 17
+(assert-equal? (tn) (integer->string 18) "") ;; 18
+(assert-equal? (tn) (integer->string 19) "") ;; 19
+(assert-equal? (tn) (integer->string 20) "") ;; 20
+(assert-equal? (tn) (integer->string 21) "") ;; 21
+(assert-equal? (tn) (integer->string 22) "") ;; 22
+(assert-equal? (tn) (integer->string 23) "") ;; 23
+(assert-equal? (tn) (integer->string 24) "") ;; 24
+(assert-equal? (tn) (integer->string 25) "") ;; 25 ;; DON'T EDIT THIS LINE!
+(assert-equal? (tn) (integer->string 26) "") ;; 26
+(assert-equal? (tn) (integer->string 27) "") ;; 27
+(assert-equal? (tn) (integer->string 28) "
") ;; 28
+(assert-equal? (tn) (integer->string 29) "
") ;; 29
+(assert-equal? (tn) (integer->string 30) "
") ;; 30
+(assert-equal? (tn) (integer->string 31) " ") ;; 31
+(assert-equal? (tn) (integer->string 127) "") ;; 127
;; escaped raw control chars
;;(assert-parse-error "escaped raw control char in string literal" "\"\\ \"") ;; 0 ;; cannot read by string port
Modified: branches/r5rs/uim/uim-compat-scm.c
===================================================================
--- branches/r5rs/uim/uim-compat-scm.c 2006-01-09 18:48:35 UTC (rev 2875)
+++ branches/r5rs/uim/uim-compat-scm.c 2006-01-09 20:16:53 UTC (rev 2876)
@@ -187,7 +187,7 @@
for (i = n_strs - 1; 0 <= i; i--) {
c_str = strs[i];
- str = (uim_lisp)SCM_MAKE_STRING_COPYING(c_str);
+ str = uim_scm_make_str(c_str);
lst = (uim_lisp)SCM_CONS((ScmObj)str, (ScmObj)lst);
}
@@ -292,7 +292,7 @@
void
uim_scm_provide(const char *feature)
{
- scm_p_provide(SCM_MAKE_IMMUTABLE_STRING_COPYING(feature));
+ scm_p_provide(SCM_CONST_STRING(feature));
}
Modified: branches/r5rs/uim/uim-scm.c
===================================================================
--- branches/r5rs/uim/uim-scm.c 2006-01-09 18:48:35 UTC (rev 2875)
+++ branches/r5rs/uim/uim-scm.c 2006-01-09 20:16:53 UTC (rev 2876)
@@ -222,7 +222,7 @@
uim_lisp
uim_scm_make_str(const char *str)
{
- return (uim_lisp)SCM_MAKE_STRING_COPYING(str);
+ return (uim_lisp)SCM_MAKE_STRING_COPYING(str, SCM_STRLEN_UNKNOWN);
}
char *
More information about the uim-commit
mailing list