[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