From ed0ba77f1cff4820da69c6229018e06b9efad1b5 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Wed, 27 Mar 2002 11:13:27 +0000 Subject: [PATCH] r1682: More tests in XPTest --- VERSION | 3 +- .../postgresql-socket-api.cl | 39 ++++++++++--------- test-suite/xptest-clsql.cl | 15 ++++++- 3 files changed, 36 insertions(+), 21 deletions(-) diff --git a/VERSION b/VERSION index e453650..44d8132 100644 --- a/VERSION +++ b/VERSION @@ -1,2 +1,3 @@ -0.5.3 +0.6.0-pre + diff --git a/interfaces/postgresql-socket/postgresql-socket-api.cl b/interfaces/postgresql-socket/postgresql-socket-api.cl index 0be635e..0c64353 100644 --- a/interfaces/postgresql-socket/postgresql-socket-api.cl +++ b/interfaces/postgresql-socket/postgresql-socket-api.cl @@ -9,7 +9,7 @@ ;;;; ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: postgresql-socket-api.cl,v 1.10 2002/03/27 10:48:12 kevin Exp $ +;;;; $Id: postgresql-socket-api.cl,v 1.11 2002/03/27 11:13:27 kevin Exp $ ;;;; ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; and Copyright (c) 1999-2001 by Pierre R. Mai @@ -644,27 +644,28 @@ connection, if it is still open." (unless before-decimal (error "Unexpected value")))) - (dotimes (i length) - (setq char (read-byte socket)) -;; (format t "~&len:~D, i:~D, char:~D, minusp:~A, decimalp:~A" length i char minusp decimalp) - (let ((weight (ascii-digit char))) - (cond - ((and weight (not decimalp)) ;; before decimal point - (setq before-decimal (+ weight (* 10 before-decimal)))) - ((and weight decimalp) ;; after decimal point - (setq after-decimal (+ weight (* 10 after-decimal))) - (incf decimal-count)) - ((and (= char +char-code-period+)) - (setq decimalp t)) - ((or (= char +char-code-lower-e+) ;; E is for exponent - (= char +char-code-upper-e+)) - (setq exponent (read-integer-from-socket socket (- length i 1))) - (setq exponent (or exponent 0)) - (setq i length)) + (block loop + (dotimes (i length) + (setq char (read-byte socket)) + ;; (format t "~&len:~D, i:~D, char:~D, minusp:~A, decimalp:~A" length i char minusp decimalp) + (let ((weight (ascii-digit char))) + (cond + ((and weight (not decimalp)) ;; before decimal point + (setq before-decimal (+ weight (* 10 before-decimal)))) + ((and weight decimalp) ;; after decimal point + (setq after-decimal (+ weight (* 10 after-decimal))) + (incf decimal-count)) + ((and (= char +char-code-period+)) + (setq decimalp t)) + ((or (= char +char-code-lower-e+) ;; E is for exponent + (= char +char-code-upper-e+)) + (setq exponent (read-integer-from-socket socket (- length i 1))) + (setq exponent (or exponent 0)) + (return-from loop)) (t (break "Unexpected value")) ) - )) + ))) (setq result (* (+ (coerce before-decimal 'double-float) (* after-decimal (expt 10 (- decimal-count)))) diff --git a/test-suite/xptest-clsql.cl b/test-suite/xptest-clsql.cl index 998607a..6d08227 100644 --- a/test-suite/xptest-clsql.cl +++ b/test-suite/xptest-clsql.cl @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Mar 2002 ;;;; -;;;; $Id: xptest-clsql.cl,v 1.5 2002/03/27 10:56:02 kevin Exp $ +;;;; $Id: xptest-clsql.cl,v 1.6 2002/03/27 11:13:27 kevin Exp $ ;;;; ;;;; The XPTest package can be downloaded from ;;;; http://alpha.onshored.com/lisp-software/ @@ -80,6 +80,19 @@ (loop for row across (map-query 'vector #'list "select * from test_clsql" :database db :types nil) do (test-table-row row nil)) + (loop for row in (map-query 'list #'list "select * from test_clsql" + :database db :types nil) + do (test-table-row row nil)) + (loop for row in (map-query 'list #'list "select * from test_clsql" + :database db :types :auto) + do (test-table-row row :auto)) + (when (map-query nil #'list "select * from test_clsql" + :database db :types :auto) + (failure "Expected NIL result from map-query nil")) + (do-query ((int float str) "select * from test_clsql") + (test-table-row (list int float str) nil)) + (do-query ((int float str) "select * from test_clsql" :types :auto) + (test-table-row (list int float str) :auto)) (drop-test-table db) ) (disconnect :database db))))) -- 2.34.1