From d6efe68274671886191da671123845c7e39118df Mon Sep 17 00:00:00 2001
From: Abdulaziz Ghuloum <aghuloum@cs.indiana.edu>
Date: Sat, 15 Dec 2007 07:32:02 -0500
Subject: [PATCH] fixes bug 176519: format does not detect too-many-arguments

---
 scheme/ikarus.writer.ss | 68 +++++++++++++++++++++++++++++------------
 scheme/last-revision    |  2 +-
 2 files changed, 50 insertions(+), 20 deletions(-)

diff --git a/scheme/ikarus.writer.ss b/scheme/ikarus.writer.ss
index b8bfc27..6e28834 100644
--- a/scheme/ikarus.writer.ss
+++ b/scheme/ikarus.writer.ss
@@ -716,54 +716,84 @@
   
   (define formatter
     (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])
         (unless (fx= i (string-length fmt))
           (let ([c (string-ref fmt i)])
             (cond
-              [($char= c #\~)
+              [(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
-                    [($char= c #\~) 
+                    [(eqv? c #\~) 
                      (write-char #\~ p)
                      (f (fxadd1 i) args)]
-                    [($char= c #\%) 
+                    [(eqv? c #\%) 
                      (write-char #\newline p)
                      (f (fxadd1 i) args)] 
-                    [($char= c #\a)
-                     (when (null? args)
-                       (error who "insufficient arguments"))
+                    [(eqv? c #\a)
                      (display-to-port (car args) p)
                      (f (fxadd1 i) (cdr args))]
-                    [($char= c #\s)
-                     (when (null? args)
-                       (error who "insufficient arguments"))
+                    [(eqv? c #\s)
                      (write-to-port (car args) p)
                      (f (fxadd1 i) (cdr args))]
                     [(assv c '([#\b . 2] [#\o . 8] [#\x . 16] [#\d . 10]))
                      =>
                      (lambda (x)
-                       (when (null? args)
-                         (error who "insufficient arguments"))
                        (let ([a (car args)])
                          (cond
                            [(or (fixnum? a) (bignum? a) (ratnum? a))
                             (display-to-port (number->string a (cdr x)) p)]
                            [(flonum? a)
-                            (unless (eqv? c #\d) 
-                              (error who 
-                                (format "flonums cannot be printed with ~~~a" c)))
                             (display-to-port (number->string a) p)]
                            [else 
-                            (error who "not a number" a)]))
+                            (error who "BUG: not a number" a)]))
                        (f (fxadd1 i) (cdr args)))]
-                    [else
-                     (error who "invalid sequence character after ~" c)])))]
+                    [else (error who "BUG" c)])))]
               [else 
                (write-char c p)
                (f (fxadd1 i) args)]))))
+      ;;; then flush
       (flush-output-port p)))
   
   (define fprintf
diff --git a/scheme/last-revision b/scheme/last-revision
index afe70ec..4c127d8 100644
--- a/scheme/last-revision
+++ b/scheme/last-revision
@@ -1 +1 @@
-1244
+1246