conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

fixes bug 176519: format does not detect too-many-arguments

This commit is contained in:
Abdulaziz Ghuloum 2007-12-15 07:32:02 -05:00
parent ab55602ed1
commit d6efe68274
2 changed files with 50 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
scheme/ikarus.writer.ss
View File

@ -716,54 +716,84 @@
(define formatter (define formatter
(lambda (who p fmt args) (lambda (who p fmt args)
;;; first check
(let f ([i 0] [args args])
(cond
[(fx= i (string-length fmt))
(unless (null? args)
(error who
(format
"extra arguments given for format string \x2036;~a\x2033;"
fmt)))]
[else
(let ([c (string-ref fmt i)])
(cond
[(eqv? c #\~)
(let ([i (fxadd1 i)])
(when (fx= i (string-length fmt))
(error who "invalid ~ at end of format string" fmt))
(let ([c (string-ref fmt i)])
(cond
[(memv c '(#\~ #\%)) (f (fxadd1 i) args)]
[(memv c '(#\a #\s))
(when (null? args)
(error who "insufficient arguments"))
(f (fxadd1 i) (cdr args))]
[(memv c '(#\b #\o #\x #\d))
(when (null? args)
(error who "insufficient arguments"))
(let ([a (car args)])
(cond
[(or (fixnum? a) (bignum? a) (ratnum? a))
(void)]
[(flonum? a)
(unless (eqv? c #\d)
(error who
(format "flonums cannot be printed with ~~~a" c)))]
[else
(error who "not a number" a)]))
(f (fxadd1 i) (cdr args))]
[else
(error who "invalid sequence character after ~" c)])))]
[else (f (fxadd1 i) args)]))]))
;;; then format
(let f ([i 0] [args args]) (let f ([i 0] [args args])
(unless (fx= i (string-length fmt)) (unless (fx= i (string-length fmt))
(let ([c (string-ref fmt i)]) (let ([c (string-ref fmt i)])
(cond (cond
[($char= c #\~) [(eqv? c #\~)
(let ([i (fxadd1 i)]) (let ([i (fxadd1 i)])
(when (fx= i (string-length fmt))
(error who "invalid ~ at end of format string" fmt))
(let ([c (string-ref fmt i)]) (let ([c (string-ref fmt i)])
(cond (cond
[($char= c #\~) [(eqv? c #\~)
(write-char #\~ p) (write-char #\~ p)
(f (fxadd1 i) args)] (f (fxadd1 i) args)]
[($char= c #\%) [(eqv? c #\%)
(write-char #\newline p) (write-char #\newline p)
(f (fxadd1 i) args)] (f (fxadd1 i) args)]
[($char= c #\a) [(eqv? c #\a)
(when (null? args)
(error who "insufficient arguments"))
(display-to-port (car args) p) (display-to-port (car args) p)
(f (fxadd1 i) (cdr args))] (f (fxadd1 i) (cdr args))]
[($char= c #\s) [(eqv? c #\s)
(when (null? args)
(error who "insufficient arguments"))
(write-to-port (car args) p) (write-to-port (car args) p)
(f (fxadd1 i) (cdr args))] (f (fxadd1 i) (cdr args))]
[(assv c '([#\b . 2] [#\o . 8] [#\x . 16] [#\d . 10])) [(assv c '([#\b . 2] [#\o . 8] [#\x . 16] [#\d . 10]))
=> =>
(lambda (x) (lambda (x)
(when (null? args)
(error who "insufficient arguments"))
(let ([a (car args)]) (let ([a (car args)])
(cond (cond
[(or (fixnum? a) (bignum? a) (ratnum? a)) [(or (fixnum? a) (bignum? a) (ratnum? a))
(display-to-port (number->string a (cdr x)) p)] (display-to-port (number->string a (cdr x)) p)]
[(flonum? a) [(flonum? a)
(unless (eqv? c #\d)
(error who
(format "flonums cannot be printed with ~~~a" c)))
(display-to-port (number->string a) p)] (display-to-port (number->string a) p)]
[else [else
(error who "not a number" a)])) (error who "BUG: not a number" a)]))
(f (fxadd1 i) (cdr args)))] (f (fxadd1 i) (cdr args)))]
[else [else (error who "BUG" c)])))]
(error who "invalid sequence character after ~" c)])))]
[else [else
(write-char c p) (write-char c p)
(f (fxadd1 i) args)])))) (f (fxadd1 i) args)]))))
;;; then flush
(flush-output-port p))) (flush-output-port p)))
(define fprintf (define fprintf

2
scheme/last-revision
View File

@ -1 +1 @@
1244 1246