[uim-commit] r3167 - in branches/r5rs/sigscheme: src test
yamaken at freedesktop.org
yamaken at freedesktop.org
Fri Mar 17 23:46:46 PST 2006
Author: yamaken
Date: 2006-03-17 23:46:41 -0800 (Fri, 17 Mar 2006)
New Revision: 3167
Modified:
branches/r5rs/sigscheme/src/format.c
branches/r5rs/sigscheme/src/number.c
branches/r5rs/sigscheme/test/test-srfi48.scm
Log:
* sigscheme/src/format.c
- (format_raw_c_directive, format_directive): Support string width
specification
* sigscheme/src/number.c
- (scm_int2string): Support width specification
* sigscheme/test/test-srfi48.scm
- All tests have been passed
- Fix incorrect expected values
Modified: branches/r5rs/sigscheme/src/format.c
===================================================================
--- branches/r5rs/sigscheme/src/format.c 2006-03-18 06:38:03 UTC (rev 3166)
+++ branches/r5rs/sigscheme/src/format.c 2006-03-18 07:46:41 UTC (rev 3167)
@@ -260,6 +260,7 @@
{
const void *orig_pos;
const char *str;
+ scm_int_t cstr_len, str_len, i;
scm_ichar_t c;
uintmax_t n; /* FIXME: sign extension */
int radix;
@@ -293,10 +294,17 @@
c = FORMAT_STR_PEEK(*fmt);
if (c == 'S') { /* String */
FORMAT_STR_SKIP_CHAR(*fmt);
- /* FIXME: reflect vfmt.width */
str = va_arg(*args, const char *);
+ cstr_len = strlen(str);
+#if SCM_USE_MULTIBYTE_CHAR
+ str_len = scm_mb_bare_c_strlen(scm_current_char_codec, str);
+#else
+ str_len = cstr_len;
+#endif
+ for (i = str_len; i < vfmt.width; i++)
+ scm_port_put_char(port, vfmt.pad);
scm_port_puts(port, str);
- return (*str) ? str[strlen(str) - 1] : c;
+ return (*str) ? str[cstr_len - 1] : c;
}
/* size modifiers (ordered by size) */
@@ -391,6 +399,7 @@
ScmObj obj, indirect_fmt, indirect_args;
scm_bool prefixedp;
int radix;
+ scm_int_t i;
ScmValueFormat vfmt;
#endif
DECLARE_INTERNAL_FUNCTION("format");
@@ -410,7 +419,8 @@
case 'f': /* Fixed */
obj = POP_FORMAT_ARG(args);
if (STRINGP(obj)) {
- /* FIXME: reflect vfmt.width */
+ for (i = SCM_STRING_LEN(obj); i < vfmt.width; i++)
+ scm_port_put_char(port, vfmt.pad);
scm_display(port, obj);
} else {
if (!INTP(obj))
Modified: branches/r5rs/sigscheme/src/number.c
===================================================================
--- branches/r5rs/sigscheme/src/number.c 2006-03-18 06:38:03 UTC (rev 3166)
+++ branches/r5rs/sigscheme/src/number.c 2006-03-18 07:46:41 UTC (rev 3167)
@@ -437,19 +437,13 @@
return r;
}
-/*
- * FIXME:
- * - width
- * - padding
- */
char *
scm_int2string(ScmValueFormat vfmt, uintmax_t n, int radix)
{
- char buf[sizeof("-") + SCM_INT_BITS];
- char *p;
- const char *end;
+ char buf[sizeof("-") + sizeof(uintmax_t) * CHAR_BIT];
+ char *p, *end, *str;
uintmax_t un; /* must be unsinged to be capable of -INT_MIN */
- int digit;
+ int digit, len, pad_len;
scm_bool neg;
DECLARE_INTERNAL_FUNCTION("scm_int2string");
@@ -458,16 +452,26 @@
un = (neg) ? (uintmax_t)-(intmax_t)n : n;
end = p = &buf[sizeof(buf) - 1];
- *p = '\0';
+ *end = '\0';
do {
digit = un % radix;
*--p = (digit <= 9) ? '0' + digit : 'a' + digit - 10;
} while (un /= radix);
- if (neg)
+ if (neg && vfmt.pad != '0')
*--p = '-';
- return scm_strdup(p);
+ len = end - p;
+ pad_len = (len < vfmt.width) ? vfmt.width - len : 0;
+ str = scm_malloc(pad_len + len + sizeof(""));
+ strcpy(&str[pad_len], p);
+ while (pad_len)
+ str[--pad_len] = vfmt.pad;
+
+ if (neg && vfmt.pad == '0')
+ *str = '-';
+
+ return str;
}
ScmObj
Modified: branches/r5rs/sigscheme/test/test-srfi48.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-srfi48.scm 2006-03-18 06:38:03 UTC (rev 3166)
+++ branches/r5rs/sigscheme/test/test-srfi48.scm 2006-03-18 07:46:41 UTC (rev 3167)
@@ -32,6 +32,8 @@
;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+;; All tests in this file are passed against r3167 (new repository)
+
(load "./test/unittest.scm")
(use srfi-6)
@@ -408,12 +410,12 @@
(assert-equal? (tn) "aBc" (format "~1f" "aBc"))
(assert-equal? (tn) "あbう" (format "~1f" "あbう"))
-(assert-equal? (tn) " " (format "~2f" ""))
+(assert-equal? (tn) " " (format "~2f" ""))
(assert-equal? (tn) " \"" (format "~2f" "\""))
(assert-equal? (tn) "aBc" (format "~2f" "aBc"))
(assert-equal? (tn) "あbう" (format "~2f" "あbう"))
-(assert-equal? (tn) " " (format "~3f" ""))
+(assert-equal? (tn) " " (format "~3f" ""))
(assert-equal? (tn) " \"" (format "~3f" "\""))
(assert-equal? (tn) "aBc" (format "~3f" "aBc"))
(assert-equal? (tn) "あbう" (format "~3f" "あbう"))
More information about the uim-commit
mailing list