Skip to content

Instantly share code, notes, and snippets.

@Hamayama Hamayama/test_format.scm
Last active Nov 6, 2017

Embed
What would you like to do?
Gauche の format ~f のテスト
;;
;; 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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.