Gauche の format ~f のテスト

test_format.scm

;;
;; testing format ~f
;;

(use gauche.test)
(use math.const) ; for pi

(test-start "format ~f")

(define-syntax expr-test
  (syntax-rules ()
    ((_ txt ans expr)
     (test* (string-append txt (if (equal? txt "") "" " ")
                           ": " (format "~s" 'expr)) ans expr))
    ((_ txt ans expr chk)
     (test* (string-append txt (if (equal? txt "") "" " ")
                           ": " (format "~s" 'expr)) ans expr chk))))

(define (nearly=? a b)
  (let* ((a1 (x->number a))
         (b1 (x->number b))
         (e1 (abs (- a1 b1))))
    ;(test-log "(a1 = ~s, b1 = ~s, e1 = ~s)" a1 b1 e1)
    (< e1 1.0e-10)))

; ~width,digits,scale,ovfchar,padchar[@|:]f

(test-section "normal")
(expr-test "" "0.0"        (format "~f"    0))
(expr-test "" "1.0"        (format "~f"    1))
(expr-test "" "123.0"      (format "~f"  123))
(expr-test "" "0.456"      (format "~f"    0.456))
(expr-test "" "123.456"    (format "~f"  123.456))
(expr-test "" "-1.0"       (format "~f"   -1))
(expr-test "" "-123.0"     (format "~f" -123))
(expr-test "" "-0.456"     (format "~f"   -0.456))
(expr-test "" "-123.456"   (format "~f" -123.456))

(test-section "width")
(expr-test "" "123.0"      (format "~4f"  123))
(expr-test "" "123.0"      (format "~5f"  123))
(expr-test "" " 123.0"     (format "~6f"  123))
(expr-test "" "  123.0"    (format "~7f"  123))
(expr-test "" "-123.0"     (format "~5f" -123))
(expr-test "" "-123.0"     (format "~6f" -123))
(expr-test "" " -123.0"    (format "~7f" -123))
(expr-test "" "  -123.0"   (format "~8f" -123))

(test-section "digits")
(expr-test "" "123.0"      (format "~,-1f"  123))
(expr-test "" "123."       (format "~,0f"   123))
(expr-test "" "123.0"      (format "~,1f"   123))
(expr-test "" "123.00"     (format "~,2f"   123))
(expr-test "" "0.12"       (format "~,2f"   0.123))
(expr-test "" "0.123"      (format "~,3f"   0.123))
(expr-test "" "0.1230"     (format "~,4f"   0.123))
(expr-test "" "-123.0"     (format "~,-1f" -123))
(expr-test "" "-123."      (format "~,0f"  -123))
(expr-test "" "-123.0"     (format "~,1f"  -123))
(expr-test "" "-123.00"    (format "~,2f"  -123))
(expr-test "" "-0.12"      (format "~,2f"  -0.123))
(expr-test "" "-0.123"     (format "~,3f"  -0.123))
(expr-test "" "-0.1230"    (format "~,4f"  -0.123))

(test-section "scale")
(expr-test "" "1234560.0"  (format "~,,4f"   123.456))
(expr-test "" "123456.0"   (format "~,,3f"   123.456))
(expr-test "" "12345.6"    (format "~,,2f"   123.456))
(expr-test "" "1234.56"    (format "~,,1f"   123.456))
(expr-test "" "123.456"    (format "~,,0f"   123.456))
(expr-test "" "12.3456"    (format "~,,-1f"  123.456) nearly=?) ; "12.345600000000001"
(expr-test "" "1.23456"    (format "~,,-2f"  123.456) nearly=?) ; "1.23456"
(expr-test "" "0.123456"   (format "~,,-3f"  123.456) nearly=?) ; "0.12345600000000001"
(expr-test "" "0.0123456"  (format "~,,-4f"  123.456) nearly=?) ; "0.012345600000000002"
(expr-test "" "-1234560.0" (format "~,,4f"  -123.456))
(expr-test "" "-123456.0"  (format "~,,3f"  -123.456))
(expr-test "" "-12345.6"   (format "~,,2f"  -123.456))
(expr-test "" "-1234.56"   (format "~,,1f"  -123.456))
(expr-test "" "-123.456"   (format "~,,0f"  -123.456))
(expr-test "" "-12.3456"   (format "~,,-1f" -123.456) nearly=?) ; "-12.345600000000001"
(expr-test "" "-1.23456"   (format "~,,-2f" -123.456) nearly=?) ; "-1.23456"
(expr-test "" "-0.123456"  (format "~,,-3f" -123.456) nearly=?) ; "-0.12345600000000001"
(expr-test "" "-0.0123456" (format "~,,-4f" -123.456) nearly=?) ; "-0.012345600000000002"

(test-section "ovfchar")
(expr-test "" "###"        (format "~3,,,'#f"  123))
(expr-test "" "####"       (format "~4,,,'#f"  123))
(expr-test "" "123.0"      (format "~5,,,'#f"  123))
(expr-test "" " 123.0"     (format "~6,,,'#f"  123))
(expr-test "" "####"       (format "~4,,,'#f" -123))
(expr-test "" "#####"      (format "~5,,,'#f" -123))
(expr-test "" "-123.0"     (format "~6,,,'#f" -123))
(expr-test "" " -123.0"    (format "~7,,,'#f" -123))

(test-section "padchar")
(expr-test "" "123.0"      (format "~4,,,,'*f"  123))
(expr-test "" "123.0"      (format "~5,,,,'*f"  123))
(expr-test "" "*123.0"     (format "~6,,,,'*f"  123))
(expr-test "" "**123.0"    (format "~7,,,,'*f"  123))
(expr-test "" "-123.0"     (format "~5,,,,'*f" -123))
(expr-test "" "-123.0"     (format "~6,,,,'*f" -123))
(expr-test "" "*-123.0"    (format "~7,,,,'*f" -123))
(expr-test "" "**-123.0"   (format "~8,,,,'*f" -123))

(test-section "plus sign")
(expr-test "" "+123.0"     (format "~@f"  123))
(expr-test "" "-123.0"     (format "~@f" -123))
(expr-test "" "*+123.0"    (format "~7,,,,'*@f" 123))
(expr-test "" "####"       (format "~4,,,'#@f"  123))

(test-section "rounding (banker's rounding)")
(expr-test "" "123.456"    (format "~,-1f"  123.456))
(expr-test "" "123."       (format "~,0f"   123.456))
(expr-test "" "123.5"      (format "~,1f"   123.456))
(expr-test "" "123.46"     (format "~,2f"   123.456))
(expr-test "" "-123.456"   (format "~,-1f" -123.456))
(expr-test "" "-123."      (format "~,0f"  -123.456))
(expr-test "" "-123.5"     (format "~,1f"  -123.456))
(expr-test "" "-123.46"    (format "~,2f"  -123.456))
(expr-test "" "123.0"      (format "~,1f"   123.05))
(expr-test "" "123.2"      (format "~,1f"   123.15))
(expr-test "" "124.0"      (format "~,1f"   123.95))
(expr-test "" "-123.0"     (format "~,1f"  -123.05))
(expr-test "" "-123.2"     (format "~,1f"  -123.15))
(expr-test "" "-124.0"     (format "~,1f"  -123.95))
(expr-test "" "1000.00"    (format "~,2f"   999.995))
(expr-test "" "-1000.00"   (format "~,2f"  -999.995))

(test-section "notational rounding (commercial rounding)")
(expr-test "" "123.456"    (format "~,-1:f"  123.456))
(expr-test "" "123."       (format "~,0:f"   123.456))
(expr-test "" "123.5"      (format "~,1:f"   123.456))
(expr-test "" "123.46"     (format "~,2:f"   123.456))
(expr-test "" "-123.456"   (format "~,-1:f" -123.456))
(expr-test "" "-123."      (format "~,0:f"  -123.456))
(expr-test "" "-123.5"     (format "~,1:f"  -123.456))
(expr-test "" "-123.46"    (format "~,2:f"  -123.456))
(expr-test "" "123.1"      (format "~,1:f"   123.05))
(expr-test "" "123.2"      (format "~,1:f"   123.15))
(expr-test "" "124.0"      (format "~,1:f"   123.95))
(expr-test "" "-123.1"     (format "~,1:f"  -123.05))
(expr-test "" "-123.2"     (format "~,1:f"  -123.15))
(expr-test "" "-124.0"     (format "~,1:f"  -123.95))
(expr-test "" "1000.00"    (format "~,2:f"   999.995))
(expr-test "" "-1000.00"   (format "~,2:f"  -999.995))

(test-section "misc")
(expr-test "" "+inf.0"     (format "~f" (/.  1 0)))
(expr-test "" "-inf.0"     (format "~f" (/. -1 0)))
(expr-test "" "+nan.0"     (format "~f" (/.  0 0)))
(expr-test "" "0.0"        (format "~f" (/.  0 +inf.0)))
(expr-test "" "-0.0"       (format "~f" (/.  0 -inf.0)))
(expr-test "" "31.41592653589793" (format "~f" (* pi 10)))
(expr-test "" "0.33333"    (format "~,5f"  1/3))
(expr-test "" "-0.33333"   (format "~,5f" -1/3))
(expr-test "" "0.142857142857" (format "~,12f"  1/7))
(expr-test "" "299999999.999999999" (format "~f" 299999999999999999/1000000000) nearly=?) ; "300000000.0"
(expr-test "" "1.797693e308"  (format "~f"  1.797693e308))
(expr-test "" "-1.797693e308" (format "~f" -1.797693e308))
(expr-test "" "2.225074e-308" (format "~f"  2.225074e-308))
(expr-test "" "5.01"       (format "~1,2f"   5.015))
(expr-test "" "5.02"       (format "~1,2:f"  5.015))
(expr-test "" "-5.01"      (format "~1,2f"  -5.015))
(expr-test "" "-5.02"      (format "~1,2:f" -5.015))
(expr-test "" "0.00"       (format "~1,2f"   0.003))
(expr-test "" "-0.00"      (format "~1,2f"  -0.003))
(expr-test "" "0.0"        (format "~1,1f"   0.04))
(expr-test "" "0.1"        (format "~1,1f"   0.05))
(expr-test "" "0.0"        (format "~1,1f"   0.005))
(expr-test "" "-0.0"       (format "~1,1f"  -0.04))
(expr-test "" "-0.1"       (format "~1,1f"  -0.05))
(expr-test "" "-0.0"       (format "~1,1f"  -0.005))
(expr-test "" "0."         (format "~1,0f"   0.5))
(expr-test "" "1."         (format "~1,0f"   0.51))
(expr-test "" "0."         (format "~1,0f"   0.09))
(expr-test "" "-0."        (format "~1,0f"  -0.5))
(expr-test "" "-1."        (format "~1,0f"  -0.51))
(expr-test "" "-0."        (format "~1,0f"  -0.09))

(test-section "error")
;(expr-test "" "1.0"        (format "~536870912f" 1) nearly=?) ; long time
;(expr-test "" "1.0"        (format "~,10000f" 1) nearly=?)    ; SEGV
(expr-test "" (test-error) (format "~,,536870912f" 1) nearly=?) ; "exponent too big"
;(expr-test "" "1.0"        (format "~,,536870911f" 1) nearly=?) ; long time
(expr-test "" (test-error) (format "~1,,,1f" 12345))   ; "character required"
(expr-test "" (test-error) (format "~10,,,,1f" 12345)) ; "character required"
(expr-test "" (test-error) (format "~,,,,$f" 12345))   ; "Invalid format directive character"

(test-end)