fixed pr9285, added tests

svn: r9197
This commit is contained in:
Eli Barzilay 2008-04-08 12:33:53 +00:00
parent 2888a16d0e
commit 26b283b953
2 changed files with 29 additions and 11 deletions

View File

@ -12,18 +12,22 @@
(require (for-syntax "stxcase-scheme.ss")) (require (for-syntax "stxcase-scheme.ss"))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (real->decimal-string n [digits 2]) (define (real->decimal-string n [digits 2])
(let* ([e (expt 10 digits)] (unless (exact-nonnegative-integer? digits)
[num (round (abs (* e (inexact->exact n))))]) (raise-type-error 'real->decimal-string "exact-nonnegative-integer" n))
(format "~a~a.~a" (if (zero? digits)
(if (negative? n) "-" "") (number->string (inexact->exact (round n)))
(quotient num e) (let* ([e (expt 10 digits)]
(let ([s (number->string (remainder num e))]) [num (round (abs (* e (inexact->exact n))))])
(if (= (string-length s) digits) (format "~a~a.~a"
s (if (negative? n) "-" "")
(string-append (make-string (- digits (string-length s)) #\0) (quotient num e)
s)))))) (let ([s (number->string (remainder num e))])
(if (= (string-length s) digits)
s
(string-append (make-string (- digits (string-length s)) #\0)
s)))))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Regexp helpers ;; Regexp helpers

View File

@ -5,6 +5,20 @@
;; to add when this library is there: (require scheme/string) ;; to add when this library is there: (require scheme/string)
(test "0" real->decimal-string 0 0)
(test "0" real->decimal-string 0.0 0)
(test "1" real->decimal-string 0.6 0)
(test "1" real->decimal-string 3/4 0)
(test "1" real->decimal-string 1.2 0)
(test "0" real->decimal-string -0.0 0) ; !
(test "-1" real->decimal-string -0.6 0)
(test "-1" real->decimal-string -3/4 0)
(test "-1" real->decimal-string -1.2 0)
(test "1.20" real->decimal-string 1.2)
(test "-1.20" real->decimal-string -1.2)
(test "1.00" real->decimal-string 0.99999999999)
(test "-1.00" real->decimal-string -0.99999999999)
(let ([s (list->string (let ([s (list->string
(let loop ([i 0]) (let loop ([i 0])
(if (= i 256) (if (= i 256)