dbi.patch

diff --git a/lib/dbi.scm b/lib/dbi.scm
index e717908..5c52bc1 100644
--- a/lib/dbi.scm
+++ b/lib/dbi.scm
@@ -226,16 +226,21 @@
 ;; when called with binding values to the parameters.
 (define (dbi-prepare-sql conn sql)
   (let* ((tokens (sql-tokenize sql))
-         (num-params (count (lambda (elt)
-                              (match elt
-                                (('parameter (? integer?)) #t)
-                                (('parameter (? string? name))
-                                 (errorf <dbi-unsupported-error>
-                                         "Named parameter (:~a) isn't supported yet" name))
-                                (else #f)))
-                            tokens)))
+         (num-params (fold (lambda (elt r)
+                             (match elt
+                               (('parameter (? integer?))
+                                (cons (+ (car r) 1) (cdr r)))
+                               (('parameter (? string? name))
+                                (cons (car r) (+ (cdr r) 1)))
+                               (else r)))
+                           '(0 . 0)
+                           tokens)))
+    (unless (or (zero? (car num-params))
+                (zero? (cdr num-params)))
+      (error <dbi-parameter-error> "positional parameter and named parameter cannot be used together"))
     (lambda args
-      (unless (= (length args) num-params)
+      (unless (or (> (cdr num-params) 0)
+                  (= (car num-params) (length args)))
         (error <dbi-parameter-error>
                "wrong number of parameters given to an SQL:" sql))
       (call-with-output-string
@@ -274,18 +279,26 @@
          (loop (cdr tokens) args #f))
         (('parameter n)
          (unless delim (write-char #\space p))
-         (let* ((argval (car args))
-                (s (cond
-                    ((not argval) "NULL")
-                    ((string? argval)
-                     #`"',(dbi-escape-sql conn argval)'")
-                    ((symbol? argval)
-                     #`"',(dbi-escape-sql conn (symbol->string argval))'")
-                    ((real? argval) (number->string argval))
-                    (else (error <dbi-parameter-error>
-                                 "bad type of parameter for SQL:" argval)))))
-           (display s p))
-         (loop (cdr tokens) (cdr args) #f))
+         (let1 write-arg (^[argval]
+                           (let1 s (cond
+                                     ((not argval) "NULL")
+                                     ((string? argval)
+                                      #`"',(dbi-escape-sql conn argval)'")
+                                     ((symbol? argval)
+                                      #`"',(dbi-escape-sql conn (symbol->string argval))'")
+                                     ((real? argval) (number->string argval))
+                                     (else (error <dbi-parameter-error>
+                                                  "bad type of parameter for SQL:" argval)))
+                             (display s p)))
+           (cond
+             [(integer? n)
+              (write-arg (car args))
+              (loop (cdr tokens) (cdr args) #f)]
+             [(string? n)
+              (let1 argval (cond [(assoc n args) => cdr]
+                                 [else (errorf <dbi-parameter-error> "parameter ~a is not found" n)])
+                (write-arg argval)
+                (loop (cdr tokens) args #f))])))
         (('bitstring x)
          (unless delim (write-char #\space p))
          (format p "B'~a'" x)
diff --git a/test/dbidbd.scm b/test/dbidbd.scm
index cf6eeca..2191d06 100644
--- a/test/dbidbd.scm
+++ b/test/dbidbd.scm
@@ -47,6 +47,29 @@
   (test* "execute query" '("select * from foo where x = ''''")
          (coerce-to <list> (dbi-execute query "'")))
 
+  (test* "dbi-prepare (named parameter)" '<dbi-query>
+         (begin (set! query (dbi-prepare conn "select * from foo where x = :x and y = :y"))
+                (class-name (class-of query))))
+
+  (test* "execute query (named parameter)" '("select * from foo where x = 'zx' and y = 'zy'")
+         (coerce-to <list> (dbi-execute query '("x" . "zx") '("y" . "zy"))))
+
+  (test* "execute query (named parameter)" '("select * from foo where x = 'zx' and y = 'zy'")
+         (coerce-to <list> (dbi-execute query '("y" . "zy") '("x" . "zx"))))
+
+  (test* "execute query (named parameter)" '("select * from foo where x = 123 and y = 456")
+         (coerce-to <list> (dbi-execute query '("x" . 123) '("y" . 456))))
+
+  (test* "execute query (named parameter)" '("select * from foo where x = '''' and y = 456")
+         (coerce-to <list> (dbi-execute query '("x" . "'") '("y" . 456))))
+
+  (test* "dbi-prepare (named parameter)" '<dbi-query>
+         (begin (set! query (dbi-prepare conn "select * from foo where x = :x and x2 = :x"))
+                (class-name (class-of query))))
+
+  (test* "execute query (named parameter)" '("select * from foo where x = 'xx' and x2 = 'xx'")
+         (coerce-to <list> (dbi-execute query '("x" . "xx"))))
+
   (test* "dbi-do" '("insert into foo values(2,3)")
          (coerce-to <list> (dbi-do conn "insert into foo values (2, 3)")))
 
@@ -55,6 +78,11 @@
                     (dbi-do conn "insert into foo values (?, ?)" '()
                             "don't know" #f)))
 
+  (test* "dbi-do" '("insert into foo values('don''t know',NULL)")
+         (coerce-to <list>
+                    (dbi-do conn "insert into foo values (:x, :y)" '()
+                            '("x" . "don't know") '("y" . #f))))
+
   (test* "<dbi-parameter-error>" (test-error <dbi-parameter-error>)
          (dbi-execute (dbi-prepare (dbi-connect "dbi:null")
                                    "select * from foo where x = ?")
@@ -68,6 +96,29 @@
          (dbi-execute (dbi-prepare (dbi-connect "dbi:null")
                                    "select * from foo where x = 3")
                       4))
+
+  (test* "<dbi-parameter-error>" (test-error <dbi-parameter-error>)
+         (dbi-prepare (dbi-connect "dbi:null")
+                      "select * from foo where x = ? and y = :y"))
+
+  (test* "<dbi-parameter-error>" (test-error <dbi-parameter-error>)
+         (dbi-execute (dbi-prepare (dbi-connect "dbi:null")
+                                   "select * from foo where x = :x and y = :y")
+                      '("y" . 1)))
+
+  (test* "<dbi-parameter-error>" (test-error <dbi-parameter-error>)
+         (dbi-execute (dbi-prepare (dbi-connect "dbi:null")
+                                   "select * from foo where x = ?")
+                      '("x" . 1)))
+
+  (test* "<dbi-parameter-error>" (test-error <dbi-parameter-error>)
+         (dbi-execute (dbi-prepare (dbi-connect "dbi:null")
+                                   "select * from foo where x = :x")
+                      1))
+
+  (test* "<dbi-parameter-error>" (test-error <dbi-parameter-error>)
+         (dbi-execute (dbi-prepare (dbi-connect "dbi:null")
+                                   "select * from foo where x = :x")))
   )
 
 (test-section "testing conditions")