From ece2d470c3ceeed8623fedff8d2662898e4df687 Mon Sep 17 00:00:00 2001 From: Jim Rees Date: Thu, 22 Mar 2018 09:50:34 -0400 Subject: [PATCH 1/8] Fixed from-file so that it produces more than just one line of output. --- lib/chibi/show/column.scm | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/lib/chibi/show/column.scm b/lib/chibi/show/column.scm index 826a21c0..10863fbf 100644 --- a/lib/chibi/show/column.scm +++ b/lib/chibi/show/column.scm @@ -464,15 +464,15 @@ cons)) "\n")))))) -(define (from-file path) - (fn () - (call-with-input-file path - (lambda (in) +(define (from-file path . ls) + (let-optionals* ls ((sep nl)) + (fn () + (let ((in (open-input-file path))) (let lp () (let ((line (read-line in))) (if (eof-object? line) - nothing - (each line + (begin (close-input-port in) nothing) + (each line sep (fn () (lp)))))))))) (define (line-numbers . o) From b947e4ef47c67d6f1f69c8a15257c13837d0c6e2 Mon Sep 17 00:00:00 2001 From: Jim Rees Date: Thu, 22 Mar 2018 10:41:52 -0400 Subject: [PATCH 2/8] Fixed trivial bug in padded/both where the "odd space" was being emitted on the left rather than the right as specified. Fixed trivial bug in padded/left where a string longer than the provided width would result in a call to make-string with a negative length. Fixed trivial bug in trimmed/lazy around an fn-binding for the output state variable. --- lib/chibi/show/show.scm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lib/chibi/show/show.scm b/lib/chibi/show/show.scm index 602736bf..d3c5e6a3 100644 --- a/lib/chibi/show/show.scm +++ b/lib/chibi/show/show.scm @@ -115,7 +115,7 @@ (right (if (even? diff) left (make-string (+ 1 diff/2) pad-char)))) - (each right str left)) + (each left str right)) (displayed str))))))) ;;> As \scheme{padded/both} but only applies padding on the right. @@ -136,7 +136,7 @@ (lambda (str) (fn (string-width pad-char) (let ((diff (- width (string-width str)))) - (each (make-string diff pad-char) str)))))) + (each (make-string (max 0 diff) pad-char) str)))))) ;; General buffered trim - capture the output apply a trimmer. (define (trimmed/buffered width producer proc) @@ -211,7 +211,7 @@ ;;> (e.g. \scheme{write-simple} on an infinite list). The nature of ;;> this procedure means only truncating on the right is meaningful. (define (trimmed/lazy width . ls) - (fn (orig-output string-width) + (fn ((orig-output output) string-width) (call-with-current-continuation (lambda (return) (let ((chars-written 0) From 406aacf4dd36ef42b4cb071a35d8136739849487 Mon Sep 17 00:00:00 2001 From: Jim Rees Date: Thu, 22 Mar 2018 11:06:55 -0400 Subject: [PATCH 3/8] try-fitted2/output* calls output on the argument string if it's determined the string will not exceed the column width. But output is the caller environment's output state variable. A better choice is output-default. In two places (length+ form) is replaced with (or (length+ form) +inf.0) so that arithmetic can be performed on the result. To support cyclic structures in pretty-simply (wrapped with trimmed/lazy), the call-with-output form in pp-with-indent needs to be wrapped with an appropriate trimmed/lazy. In pp-pair, call (pp (car ls)) instead of (pretty (car ls)). In pretty-simply, don't use call-with-output, that prevents (trimmed/lazy n (pretty-simply ...)) from working at all on cyclic input. --- lib/chibi/show/pretty.scm | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/lib/chibi/show/pretty.scm b/lib/chibi/show/pretty.scm index bfe9e734..5eda8165 100644 --- a/lib/chibi/show/pretty.scm +++ b/lib/chibi/show/pretty.scm @@ -63,7 +63,7 @@ ((> col width) (abort fail)) (else - (output str))))))))) + (output-default str))))))))) (fn-fork (with ((output output*) (port out)) @@ -151,7 +151,7 @@ => cdr) (else #f)))) (if (and (number? indent) (negative? indent)) - (max 0 (- (+ (length+ form) indent) 1)) + (max 0 (- (+ (or (length+ form) +inf.0) indent) 1)) indent))) (define (with-reset-shares shares proc) @@ -182,9 +182,11 @@ ;; reset in case we don't fit on the first line (reset-shares (with-reset-shares shares nothing))) (call-with-output - (each " " - (joined/shares - (lambda (x) (pp-flat x pp shares)) fixed shares " ")) + (trimmed/lazy (- width col2) + (each " " + (joined/shares + (lambda (x) (pp-flat x pp shares)) fixed shares " ")) + ) (lambda (first-line) (cond ((< (+ col2 (string-width first-line)) width) @@ -195,7 +197,7 @@ (cond ((not (or (null? tail) (pair? tail))) (each ". " (pp tail pp shares))) - ((> (length+ (cdr ls)) (or indent-rule 1)) + ((> (or (length+ (cdr ls)) +inf.0) (or indent-rule 1)) (each sep (joined/shares pp tail shares sep))) (else nothing))))) @@ -299,7 +301,7 @@ (cond ;; one element list, no lines to break ((null? (cdr ls)) - (each "(" (pretty (car ls)) ")")) + (each "(" (pp (car ls)) ")")) ;; quote or other abbrev ((and (pair? (cdr ls)) (null? (cddr ls)) (assq (car ls) syntax-abbrevs)) @@ -362,7 +364,5 @@ (define (pretty-simply obj) (fn () - (call-with-output - (each (pp obj (extract-shared-objects #f #f)) - fl) - displayed))) + (each (pp obj (extract-shared-objects #f #f)) + fl))) From b25e46b11bbff866962243a3d4e72e807314266d Mon Sep 17 00:00:00 2001 From: Jim Rees Date: Thu, 22 Mar 2018 22:19:39 -0400 Subject: [PATCH 4/8] Introduced a second version of sexp_double_to_ratio, named sexp_double_to_ratio_2, which converts without introducing round-off errors the way sexp_double_to_ratio does when it multiplies by 10. Changed sexp_inexact_to_exact to use this new function when a non-zero fractional part of the input exists. --- bignum.c | 35 +++++++++++++++++++++++++++++++++++ eval.c | 2 +- include/chibi/bignum.h | 1 + 3 files changed, 37 insertions(+), 1 deletion(-) diff --git a/bignum.c b/bignum.c index 757bc5de..b2e56a63 100644 --- a/bignum.c +++ b/bignum.c @@ -730,6 +730,41 @@ sexp sexp_double_to_ratio (sexp ctx, double f) { return res; } +// +// For conversion that does not introduce round-off error, +// no matter what FLT_RADIX is. +// +sexp sexp_double_to_ratio_2 (sexp ctx, double f) { + int sign,i; + sexp_gc_var3(res, whole, scale); + if (f == trunc(f)) + return sexp_bignum_normalize(sexp_double_to_bignum(ctx, f)); + sexp_gc_preserve3(ctx, res, whole, scale); + whole = sexp_double_to_bignum(ctx, trunc(f)); + res = sexp_fixnum_to_bignum(ctx, SEXP_ZERO); + scale = SEXP_ONE; + sign = (f < 0 ? -1 : 1); + f = fabs(f-trunc(f)); + while(f) { + res = sexp_bignum_fxmul(ctx, NULL, res, FLT_RADIX, 0); + scale = sexp_mul(ctx, scale, sexp_make_fixnum(FLT_RADIX)); + f *= FLT_RADIX; + i = trunc(f); + if (i) { + f -= i; + res = sexp_bignum_fxadd(ctx, res, i); + } + } + sexp_bignum_sign(res) = sign; + res = sexp_bignum_normalize(res); + scale = sexp_bignum_normalize(scale); + res = sexp_make_ratio(ctx, res, scale); + res = sexp_ratio_normalize(ctx, res, SEXP_FALSE); + res = sexp_add(ctx, res, whole); + sexp_gc_release3(ctx); + return res; +} + sexp sexp_ratio_add (sexp ctx, sexp a, sexp b) { sexp_gc_var3(res, num, den); sexp_gc_preserve3(ctx, res, num, den); diff --git a/eval.c b/eval.c index 6d6fccca..fada559f 100644 --- a/eval.c +++ b/eval.c @@ -1811,7 +1811,7 @@ sexp sexp_inexact_to_exact (sexp ctx, sexp self, sexp_sint_t n, sexp z) { res = sexp_xtype_exception(ctx, self, "exact: not a finite number", z); } else if (sexp_flonum_value(z) != trunc(sexp_flonum_value(z))) { #if SEXP_USE_RATIOS - res = sexp_double_to_ratio(ctx, sexp_flonum_value(z)); + res = sexp_double_to_ratio_2(ctx, sexp_flonum_value(z)); #else res = sexp_xtype_exception(ctx, self, "exact: not an integer", z); #endif diff --git a/include/chibi/bignum.h b/include/chibi/bignum.h index f554f55b..bd5b9791 100644 --- a/include/chibi/bignum.h +++ b/include/chibi/bignum.h @@ -44,6 +44,7 @@ SEXP_API sexp sexp_quotient (sexp ctx, sexp a, sexp b); SEXP_API sexp sexp_remainder (sexp ctx, sexp a, sexp b); #if SEXP_USE_RATIOS SEXP_API sexp sexp_double_to_ratio (sexp ctx, double f); +SEXP_API sexp sexp_double_to_ratio_2 (sexp ctx, double f); SEXP_API double sexp_ratio_to_double (sexp rat); SEXP_API sexp sexp_make_ratio (sexp ctx, sexp num, sexp den); SEXP_API sexp sexp_ratio_normalize (sexp ctx, sexp rat, sexp in); From 17eb19e43d1780b721cb1375d0a47744311b2906 Mon Sep 17 00:00:00 2001 From: Jim Rees Date: Fri, 23 Mar 2018 10:36:37 -0400 Subject: [PATCH 5/8] Changed sexp_double_to_bignum to extract "digits" in base-16 rather than base 10 so no round-off errors occur at each step. This is assuming FLT_RADIX is 2,4,8 or 16. --- bignum.c | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/bignum.c b/bignum.c index b2e56a63..2d6dbef7 100644 --- a/bignum.c +++ b/bignum.c @@ -67,6 +67,8 @@ sexp sexp_make_unsigned_integer (sexp ctx, sexp_luint_t x) { #define double_trunc_10s_digit(f) (trunc((f)/10.0)*10.0) #define double_10s_digit(f) ((f)-double_trunc_10s_digit(f)) +#define double_16s_digit(f) fmod(f,16.0) + sexp sexp_double_to_bignum (sexp ctx, double f) { int sign; sexp_gc_var3(res, scale, tmp); @@ -74,10 +76,10 @@ sexp sexp_double_to_bignum (sexp ctx, double f) { res = sexp_fixnum_to_bignum(ctx, SEXP_ZERO); scale = sexp_fixnum_to_bignum(ctx, SEXP_ONE); sign = (f < 0 ? -1 : 1); - for (f=fabs(f); f >= 1.0; f=trunc(f/10)) { - tmp = sexp_bignum_fxmul(ctx, NULL, scale, (sexp_uint_t)double_10s_digit(f), 0); + for (f=fabs(f); f >= 1.0; f=trunc(f/16)) { + tmp = sexp_bignum_fxmul(ctx, NULL, scale, (sexp_uint_t)double_16s_digit(f), 0); res = sexp_bignum_add(ctx, res, res, tmp); - scale = sexp_bignum_fxmul(ctx, NULL, scale, 10, 0); + scale = sexp_bignum_fxmul(ctx, NULL, scale, 16, 0); } sexp_bignum_sign(res) = sign; sexp_gc_release3(ctx); From 88e8d8946059c632756ab5448fefb96ae4bf09a1 Mon Sep 17 00:00:00 2001 From: Jim Rees Date: Fri, 23 Mar 2018 12:22:03 -0400 Subject: [PATCH 6/8] Fixed integer-log-base to use exact arithmetic so rounding doesn't cause a wrong result to things like (numeric (- (* 36 36 36) 1) 36). Fixed a bug in numeric that caused comma-sep and dec-sep to get initialized wrongly. Fixed maybe-trim-zeros to leave behind at least a ".0" on inexact numbers that otherwise would have been output without the decimal point. This is for consistency with number->string which is used when the radix is 10. In gen-general, fixed a bug in the digit-generating loop for the whole part of the number. Previously, an integer that should have looked like 5003 would be emitted as 5300. Switched the order of application of maybe-round and maybe-trim-zeros so that a number that should round to .0000000000000001 doesn't get emitted as 0.1. In gen-positive-real, fixed the ratio case to not call number->string with a radix that might not be in {2,8,10,16}. Also in gen-positive-real, fixed the call to number->string to include the radix which was missing previously. Fixed wrap-sign to correctly handle the case of -0.0. In numeric/si, always emit the supplied separator even if the number is too small for an SI-suffix to be emitted. The examples in the SRFI document depend on this. --- lib/chibi/show/write.scm | 65 ++++++++++++++++++++++++++-------------- 1 file changed, 42 insertions(+), 23 deletions(-) diff --git a/lib/chibi/show/write.scm b/lib/chibi/show/write.scm index 6c455500..554b3c5b 100644 --- a/lib/chibi/show/write.scm +++ b/lib/chibi/show/write.scm @@ -97,7 +97,10 @@ (define (integer-log a base) (if (zero? a) 0 - (exact (ceiling (/ (log (+ a 1)) (log base)))))) + ;; (exact (ceiling (/ (log (+ a 1)) (log base)))) + (do ((ndigits 1 (+ ndigits 1)) + (p base (* p base))) + ((> p a) ndigits)))) ;; The original fmt algorithm was based on "Printing Floating-Point ;; Numbers Quickly and Accurately" by Burger and Dybvig @@ -116,13 +119,13 @@ (comma unspec) (commasep unspec) (decsep unspec)) (fn (radix precision sign-rule comma-rule comma-sep decimal-sep decimal-align) - (let ((radix (default rad radix)) - (precision (default prec precision)) - (sign-rule (default sgn sign-rule)) - (comma-rule (default comma comma-rule)) - (comma-sep (default comma-sep commasep)) - (dec-sep (default decsep - (or decimal-sep (if (eqv? comma-sep #\.) #\, #\.))))) + (let* ((radix (default rad radix)) + (precision (default prec precision)) + (sign-rule (default sgn sign-rule)) + (comma-rule (default comma comma-rule)) + (comma-sep (default commasep comma-sep)) + (dec-sep (default decsep + (or decimal-sep (if (eqv? comma-sep #\.) #\, #\.))))) ;; General formatting utilities. (define (get-scale q) (expt radix (- (integer-log q radix) 1))) @@ -155,23 +158,26 @@ (and prev (odd? prev))))) (round-up ls) ls))) - (define (maybe-trim-zeros i res) + (define (maybe-trim-zeros i res inexact?) (if (and (not precision) (positive? i)) (let lp ((res res)) (cond ((and (pair? res) (eqv? 0 (car res))) (lp (cdr res))) - ((and (pair? res) (eqv? dec-sep (car res))) (cdr res)) + ((and (pair? res) (eqv? dec-sep (car res))) + (if inexact? + (cons 0 res) ; "1.0" + (cdr res))) ; "1" (else res))) res)) ;; General slow loop to generate digits one at a time, for ;; non-standard radixes or writing rationals with a fixed ;; precision. - (define (gen-general n) - (let* ((p (exact n)) + (define (gen-general n-orig) + (let* ((p (exact n-orig)) (n (numerator p)) (d (denominator p))) (let lp ((n n) - (i (- (integer-log p radix))) + (i (if (zero? p) -1 (- (integer-log p radix)))) (res '())) (cond ;; Use a fixed precision if specified, otherwise generate @@ -182,8 +188,8 @@ res)) (q (quotient n d))) (cond - ((>= q radix) - (let* ((scale (get-scale q)) + ((< i -1) + (let* ((scale (expt radix (- -1 i))) (digit (quotient q scale)) (n2 (- n (* d digit scale)))) (lp n2 (+ i 1) (cons digit res)))) @@ -194,7 +200,7 @@ (else (list->string (map char-digit - (reverse (maybe-round n d (maybe-trim-zeros i res)))))))))) + (reverse (maybe-trim-zeros i (maybe-round n d res) (inexact? n-orig)))))))))) ;; Generate a fixed precision decimal result by post-editing the ;; result of string->number. (define (gen-fixed n) @@ -242,11 +248,11 @@ (precision (gen-fixed n)) ((and (exact? n) (not (integer? n))) - (string-append (number->string (numerator n) radix) + (string-append (gen-positive-real (numerator n)) "/" - (number->string (denominator n) radix))) + (gen-positive-real (denominator n)))) ((memv radix (if (exact? n) '(2 8 10 16) '(10))) - (number->string n)) + (number->string n radix)) (else (gen-general n)))) ;; Insert commas according to the current comma-rule. @@ -272,14 +278,26 @@ (if comma-rule (insert-commas s1) s1))) ;; Wrap the sign of a real number, forcing a + prefix or using ;; parentheses (n) for negatives according to sign-rule. + + (define-syntax is-neg-zero? + (syntax-rules () + ((_ n) + (is-neg-zero? (-0.0) n)) + ((_ (0.0) n) ; -0.0 is not distinguished? + #f) + ((_ (-0.0) n) + (eqv? -0.0 n)))) + (define (negative?* n) + (or (negative? n) + (is-neg-zero? n))) (define (wrap-sign n sign-rule) (cond - ((negative? n) + ((negative?* n) (if (char? sign-rule) (string-append (string sign-rule) - (wrap-comma (abs n)) + (wrap-comma (- n)) (string (char-mirror sign-rule))) - (string-append "-" (wrap-comma (abs n))))) + (string-append "-" (wrap-comma (- n))))) ((eq? #t sign-rule) (string-append "+" (wrap-comma n))) (else @@ -335,7 +353,8 @@ (each (if (integer? n2) (number->string (exact n2)) (inexact n2)) - (if (zero? k) "" separator) + ;; (if (zero? k) "" separator) + separator (vector-ref names k))))))) ;; Force a number into a fixed width, print as #'s if doesn't fit. From b3100857fd4afe83897a947aadfffac3e66f8b97 Mon Sep 17 00:00:00 2001 From: Jim Rees Date: Mon, 26 Mar 2018 06:44:37 -0400 Subject: [PATCH 7/8] Fixed escaped to support the documented double-quoting functionality when esc-char is #f. --- lib/chibi/show/write.scm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lib/chibi/show/write.scm b/lib/chibi/show/write.scm index 554b3c5b..8e21bd02 100644 --- a/lib/chibi/show/write.scm +++ b/lib/chibi/show/write.scm @@ -41,8 +41,9 @@ (let-optionals* o ((quot #\") (esc #\\) (rename (lambda (x) #f))) - (let ((quot-str (if (char? quot) (string quot) quot)) - (esc-str (if (char? esc) (string esc) esc))) + (let ((esc-str (cond ((char? esc) (string esc)) + ((not esc) (string quot)) + (else esc)))) (fn (output) (define (output* str) (let ((start (string-cursor-start str)) From 9b72412e4e65fe8a71f9f825e183bf2c2062a618 Mon Sep 17 00:00:00 2001 From: Jim Rees Date: Mon, 26 Mar 2018 12:04:38 -0400 Subject: [PATCH 8/8] Added additional show-tests which demonstrate recent bugs & fixes. --- lib/chibi/show-test.sld | 150 +++++++++++++++++++++++++++++++++++++++- 1 file changed, 147 insertions(+), 3 deletions(-) diff --git a/lib/chibi/show-test.sld b/lib/chibi/show-test.sld index e33196c4..b9e0977c 100644 --- a/lib/chibi/show-test.sld +++ b/lib/chibi/show-test.sld @@ -1,6 +1,7 @@ (define-library (chibi show-test) (export run-tests) - (import (scheme base) (scheme char) (scheme read) + (import (scheme base) (scheme char) (scheme read) (scheme file) + (only (srfi 1) circular-list) (chibi test) (chibi show) (chibi show base) (chibi show color) (chibi show column) (chibi show pretty) @@ -26,6 +27,9 @@ (test "ABC" (show #f (upcased "abc"))) (test "abc" (show #f (downcased "ABC"))) + (test "a b" (show #f "a" (space-to 5) "b")) + (test "ab" (show #f "a" (space-to 0) "b")) + (test "abc def" (show #f "abc" (tab-to) "def")) (test "abc def" (show #f "abc" (tab-to 5) "def")) (test "abcdef" (show #f "abc" (tab-to 3) "def")) @@ -33,6 +37,8 @@ (test "abc\ndef\n" (show #f "abc" fl "def" nl fl)) (test "abc\ndef\n" (show #f "abc" fl "def" fl fl)) + (test "ab" (show #f "a" nothing "b")) + ;; numbers (test "-1" (show #f -1)) @@ -142,6 +148,100 @@ (test "100,000.00" (show #f (with ((comma-rule 3) (precision 2)) (numeric 100000)))) + ;; radix argument: + (test "0" (show #f (numeric 0 2))) + (test "0" (show #f (numeric 0 10))) + (test "0" (show #f (numeric 0 36))) + + (test "0.0" (show #f (numeric 0.0 2))) + (test "0.0" (show #f (numeric 0.0 10))) + (test "0.0" (show #f (numeric 0.0 36))) + + (test "1" (show #f (numeric 1 2))) + (test "1" (show #f (numeric 1 10))) + (test "1" (show #f (numeric 1 36))) + + (test "1.0" (show #f (numeric 1.0 2))) + (test "1.0" (show #f (numeric 1.0 10))) + (test "1.0" (show #f (numeric 1.0 36))) + + (test "0" (show #f (numeric 0.0 10 0))) + (test "0" (show #f (numeric 0.0 9 0))) + (test "3/4" (show #f (numeric #e.75))) + + (test "0.0000000000000001" (show #f (numeric 1e-25 36))) + (test "100000000000000000000000000000000000000000000000000000000000000000000000000000000.0" + (show #f (numeric (expt 2.0 80) 2))) + + ;; numeric, radix=2 + (test "10" (show #f (numeric 2 2))) + (test "10.0" (show #f (numeric 2.0 2))) + (test "11/10" (show #f (numeric 3/2 2))) + (test "1001" (show #f (numeric 9 2))) + (test "1001.0" (show #f (numeric 9.0 2))) + (test "1001.01" (show #f (numeric 9.25 2))) + + ;; numeric, radix=3 + (test "11" (show #f (numeric 4 3))) + (test "10.0" (show #f (numeric 3.0 3))) + (test "11/10" (show #f (numeric 4/3 3))) + (test "1001" (show #f (numeric 28 3))) + (test "1001.0" (show #f (numeric 28.0 3))) + (test "1001.01" (show #f (numeric #i253/9 3 2))) + + ;; radix 36 + (test "zzz" (show #f (numeric (- (* 36 36 36) 1) 36))) + + ;; Precision: + (test "1.1250" (show #f (numeric 9/8 10 4))) + (test "1.125" (show #f (numeric 9/8 10 3))) + (test "1.12" (show #f (numeric 9/8 10 2))) + (test "1.1" (show #f (numeric 9/8 10 1))) + (test "1" (show #f (numeric 9/8 10 0))) + + (test "1.1250" (show #f (numeric #i9/8 10 4))) + (test "1.125" (show #f (numeric #i9/8 10 3))) + (test "1.12" (show #f (numeric #i9/8 10 2))) + (test "1.1" (show #f (numeric #i9/8 10 1))) + (test "1" (show #f (numeric #i9/8 10 0))) + + ;; precision-show, base-4 + (test "1.1230" (show #f (numeric 91/64 4 4))) + (test "1.123" (show #f (numeric 91/64 4 3))) + (test "1.13" (show #f (numeric 91/64 4 2))) + (test "1.2" (show #f (numeric 91/64 4 1))) + (test "1" (show #f (numeric 91/64 4 0))) + + (test "1.1230" (show #f (numeric #i91/64 4 4))) + (test "1.123" (show #f (numeric #i91/64 4 3))) + (test "1.13" (show #f (numeric #i91/64 4 2))) + (test "1.2" (show #f (numeric #i91/64 4 1))) + (test "1" (show #f (numeric #i91/64 4 0))) + + ;; sign + (test "+1" (show #f (numeric 1 10 #f #t))) + (test "+1" (show #f (with ((sign-rule #t)) (numeric 1)))) + (test "-0.0" (show #f (with ((sign-rule #t)) (numeric -0.0)))) + (test "+0.0" (show #f (with ((sign-rule #t)) (numeric +0.0)))) + + ;; comma + (test "1,234,567" (show #f (numeric 1234567 10 #f #f 3))) + (test "567" (show #f (numeric 567 10 #f #f 3))) + (test "1,23,45,67" (show #f (numeric 1234567 10 #f #f 2))) + + ;; comma-sep + (test "1|234|567" (show #f (numeric 1234567 10 #f #f 3 #\|))) + (test "1&234&567" (show #f (with ((comma-sep #\&)) (numeric 1234567 10 #f #f 3)))) + (test "1*234*567" (show #f (with ((comma-sep #\&)) (numeric 1234567 10 #f #f 3 #\*)))) + (test "567" (show #f (numeric 567 10 #f #f 3 #\|))) + (test "1,23,45,67" (show #f (numeric 1234567 10 #f #f 2))) + + ;; decimal + (test "1_5" (show #f (with ((decimal-sep #\_)) (numeric 1.5)))) + (test "1,5" (show #f (with ((comma-sep #\.)) (numeric 1.5)))) + (test "1,5" (show #f (numeric 1.5 10 #f #f #f #\.))) + (test "1%5" (show #f (numeric 1.5 10 #f #f #f #\. #\%))) + (cond-expand (complex (test "1+2i" (show #f (string->number "1+2i"))) @@ -151,6 +251,7 @@ (show #f (with ((precision 2)) (string->number "3.14159+2i")))))) (test "608" (show #f (numeric/si 608))) + (test "608 B" (show #f (numeric/si 608 1000 " ") "B")) (test "3.9Ki" (show #f (numeric/si 3986))) (test "4kB" (show #f (numeric/si 3986 1000) "B")) (test "1.2Mm" (show #f (numeric/si 1.23e6 1000) "m")) @@ -160,12 +261,14 @@ (test "123m" (show #f (numeric/si 1.23e2 1000) "m")) (test "12.3m" (show #f (numeric/si 1.23e1 1000) "m")) (test "1.2m" (show #f (numeric/si 1.23 1000) "m")) + (test "1.2 m" (show #f (numeric/si 1.23 1000 " ") "m")) (test "123mm" (show #f (numeric/si 0.123 1000) "m")) (test "12.3mm" (show #f (numeric/si 1.23e-2 1000) "m")) ;? (test "1.2mm" (show #f (numeric/si 1.23e-3 1000) "m")) (test "123µm" (show #f (numeric/si 1.23e-4 1000) "m")) ;? (test "12.3µm" (show #f (numeric/si 1.23e-5 1000) "m")) ;? (test "1.2µm" (show #f (numeric/si 1.23e-6 1000) "m")) + (test "1.2 µm" (show #f (numeric/si 1.23e-6 1000 " ") "m")) (test "1,234,567" (show #f (numeric/comma 1234567))) @@ -177,7 +280,9 @@ (test "abc " (show #f (padded 5 "abc"))) (test " abc" (show #f (padded/left 5 "abc"))) + (test "abcdefghi" (show #f (padded/left 5 "abcdefghi"))) (test " abc " (show #f (padded/both 5 "abc"))) + (test " abc " (show #f (padded/both 6 "abc"))) (test "abcde" (show #f (padded 5 "abcde"))) (test "abcdef" (show #f (padded 5 "abcdef"))) @@ -204,6 +309,9 @@ (test "abc :suffix" (show #f (trimmed/lazy 3 "abcde") " :suffix")) (test "abc :suffix" (show #f (trimmed/lazy 3 "abc\nde") " :suffix")) + (test "abc" (show #f (trimmed/lazy 10 (trimmed/lazy 3 "abcdefghijklmnopqrstuvwxyz")))) + (test "abc" (show #f (trimmed/lazy 3 (trimmed/lazy 10 "abcdefghijklmnopqrstuvwxyz")))) + (test "abcde" (show #f (with ((ellipsis "...")) (trimmed 5 "abcde")))) (test "ab..." @@ -286,9 +394,21 @@ (test "hi, bob!" (show #f (escaped "hi, bob!"))) (test "hi, \\\"bob!\\\"" (show #f (escaped "hi, \"bob!\""))) + (test "hi, \\'bob\\'" (show #f (escaped "hi, 'bob'" #\'))) + (test "hi, ''bob''" (show #f (escaped "hi, 'bob'" #\' #\'))) + (test "hi, ''bob''" (show #f (escaped "hi, 'bob'" #\' #f))) + (test "line1\\nline2\\nkapow\\a\\n" + (show #f (escaped "line1\nline2\nkapow\a\n" + #\" #\\ + (lambda (c) (case c ((#\newline) #\n) ((#\alarm) #\a) (else #f)))))) + (test "bob" (show #f (maybe-escaped "bob" char-whitespace?))) (test "\"hi, bob!\"" - (show #f (maybe-escaped "hi, bob!" char-whitespace?))) + (show #f (maybe-escaped "hi, bob!" char-whitespace?))) + (test "\"foo\\\"bar\\\"baz\"" (show #f (maybe-escaped "foo\"bar\"baz" char-whitespace?))) + (test "'hi, ''bob'''" (show #f (maybe-escaped "hi, 'bob'" (lambda (c) #f) #\' #f))) + (test "\\" (show #f (maybe-escaped "\\" (lambda (c) #f) #\' #f))) + (test "''''" (show #f (maybe-escaped "'" (lambda (c) #f) #\' #f))) ;; shared structures @@ -426,6 +546,18 @@ (ones ',ones)) (append zeros ones)))))) + ;; pretty-simply + (let* ((d (let ((d (list 'a 'b #f))) + (list-set! d 2 d) + (list d))) + (ca (circular-list 'a))) + (test "((a b (a b (a b" (show #f (trimmed/lazy 15 (pretty-simply '((a b (a b (a b (a b))))))))) + (test "((a b\n (a b\n" (show #f (trimmed/lazy 15 (pretty-simply d)))) + (test "'(a a\n a\n " (show #f (trimmed/lazy 15 (pretty-simply `(quote ,ca))))) + (test "(foo\n (a a\n " (show #f (trimmed/lazy 15 (pretty-simply `(foo ,ca))))) + (test "(with-x \n (a a" (show #f (trimmed/lazy 15 (pretty-simply `(with-x ,ca))))) + ) + ;; columns (test "abc\ndef\n" @@ -594,6 +726,18 @@ def | 6 (test "〜日本語〜" (show #f (with ((pad-char #\〜)) (padded/both 5 "日本語")))) (test "日本語" - (show #f (as-unicode (with ((pad-char #\〜)) (padded/both 5 "日本語"))))) + (show #f (as-unicode (with ((pad-char #\〜)) (padded/both 5 "日本語"))))) + + ;; from-file + ;; for reference, filesystem-test relies on creating files under /tmp + (let* ((tmp-file "/tmp/chibi-show-test-0123456789") + (content-string "first line\nsecond line\nthird line")) + (with-output-to-file tmp-file (lambda () (write-string content-string))) + (test (string-append content-string "\n") + (show #f (from-file tmp-file))) + (test + " 1 first line\n 2 second line\n 3 third line\n" + (show #f (columnar 4 'right 'infinite (line-numbers) " " (from-file tmp-file)))) + (delete-file tmp-file)) (test-end))))