[pg-cvs] CVS pg
emarsden
emarsden at common-lisp.net
Sun Sep 24 15:14:38 UTC 2006
Update of /project/pg/cvsroot/pg
In directory clnet:/tmp/cvs-serv8537
Modified Files:
pg-tests.lisp
Log Message:
Added numerous additional tests, for string support, various types of
errors signaled by PostgreSQL, integer overflow, transactions, arrays,
bit-tables, prepared statements using TEXT parameters.
--- /project/pg/cvsroot/pg/pg-tests.lisp 2005/07/17 13:49:43 1.10
+++ /project/pg/cvsroot/pg/pg-tests.lisp 2006/09/24 15:14:38 1.11
@@ -1,6 +1,6 @@
;;; pg-tests.lisp -- incomplete test suite
;;;
-;;; Author: Eric Marsden <emarsden at laas.fr>
+;;; Author: Eric Marsden <eric.marsden at free.fr>
;;
;;
;; These tests assume that a table named "test" is defined in the
@@ -22,13 +22,21 @@
;; !!! CHANGE THE VALUES HERE !!!
(defun call-with-test-connection (function)
- (with-pg-connection (conn "test" "pgdotlisp")
+ (with-pg-connection (conn "test" "pgdotlisp"
+ :host "localhost"
+ ;; :host "/var/run/postgresql/"
+ )
(funcall function conn)))
(defmacro with-test-connection ((conn) &body body)
`(call-with-test-connection
(lambda (,conn) , at body)))
+(defun check-single-return (conn sql expected &key (test #'eql))
+ (let ((res (pg-exec conn sql)))
+ (assert (funcall test expected (first (pg-result res :tuple 0))))))
+
+
(defun test-insert ()
(format *debug-io* "Testing INSERT & SELECT on integers ...~%")
(with-test-connection (conn)
@@ -43,10 +51,9 @@
i (* i i))
:do (pg-exec conn sql))
(setq created t)
- (setq res (pg-exec conn "SELECT count(val) FROM count_test"))
- (assert (eql 100 (first (pg-result res :tuple 0))))
- (setq res (pg-exec conn "SELECT sum(key) FROM count_test"))
- (assert (eql 5050 (first (pg-result res :tuple 0))))
+ (pg-exec conn "VACUUM count_test")
+ (check-single-return conn "SELECT count(val) FROM count_test" 100)
+ (check-single-return conn "SELECT sum(key) FROM count_test" 5050)
;; this iterator does the equivalent of the sum(key) SQL statement
;; above, but on the client side.
(pg-for-each conn "SELECT key FROM count_test"
@@ -71,10 +78,8 @@
:for sql = (format nil "INSERT INTO count_test_float VALUES(~d, ~f)"
i i)
:do (pg-exec conn sql))
- (setq res (pg-exec conn "SELECT count(val) FROM count_test_float"))
- (assert (eql 1000 (first (pg-result res :tuple 0))))
- (setq res (pg-exec conn "SELECT sum(key) FROM count_test_float"))
- (assert (float-eql 500500.0 (first (pg-result res :tuple 0))))
+ (check-single-return conn "SELECT count(val) FROM count_test_float" 1000)
+ (check-single-return conn "SELECT sum(key) FROM count_test_float" 500500.0 :test #'float-eql)
;; this iterator does the equivalent of the sum(key) SQL statement
;; above, but on the client side.
(pg-for-each conn "SELECT val FROM count_test_float"
@@ -86,8 +91,7 @@
(defun test-insert/numeric ()
(format *debug-io* "Testing INSERT & SELECT on NUMERIC ...~%")
(with-test-connection (conn)
- (let ((res nil)
- (sum 0)
+ (let ((sum 0)
(created nil))
(unwind-protect
(progn
@@ -97,10 +101,10 @@
:for sql = (format nil "INSERT INTO count_test_numeric VALUES(~d, ~f)"
i i)
:do (pg-exec conn sql))
- (setq res (pg-exec conn "SELECT count(val) FROM count_test_numeric"))
- (assert (eql 1000 (first (pg-result res :tuple 0))))
- (setq res (pg-exec conn "SELECT sum(key) FROM count_test_numeric"))
- (assert (eql 500500 (first (pg-result res :tuple 0))))
+ (check-single-return conn "SELECT count(val) FROM count_test_numeric" 1000)
+ (let ((res (pg-exec conn "EXPLAIN SELECT count(val) FROM count_test_numeric")))
+ (assert (string= "EXPLAIN" (pg-result res :status))))
+ (check-single-return conn "SELECT sum(key) FROM count_test_numeric" 500500)
;; this iterator does the equivalent of the sum(key) SQL statement
;; above, but on the client side.
(pg-for-each conn "SELECT val FROM count_test_numeric"
@@ -117,8 +121,8 @@
(progn
(pg-exec conn "CREATE TABLE pgltest (a timestamp, b abstime, c time, d date)")
(setq created t)
- (pg-exec conn "INSERT INTO pgltest VALUES "
- "(current_timestamp, 'now', 'now', 'now')")
+ (pg-exec conn "COMMENT ON TABLE pgltest is 'pg-dot-lisp testing DATE and TIMESTAMP parsing'")
+ (pg-exec conn "INSERT INTO pgltest VALUES (current_timestamp, 'now', 'now', 'now')")
(let* ((res (pg-exec conn "SELECT * FROM pgltest"))
(parsed (first (pg-result res :tuples))))
(format t "attributes ~a~%" (pg-result res :attributes))
@@ -145,10 +149,47 @@
(let ((sum 0))
(pg-for-each conn "SELECT * FROM pgbooltest"
(lambda (tuple) (when (first tuple) (incf sum (second tuple)))))
- (assert (eql 42 sum))))
+ (assert (eql 42 sum)))
+ (pg-exec conn "ALTER TABLE pgbooltest ADD COLUMN foo int2")
+ (pg-exec conn "INSERT INTO pgbooltest VALUES ('t', -1, 1)")
+ (let ((sum 0))
+ (pg-for-each conn "SELECT * FROM pgbooltest"
+ (lambda (tuple) (when (first tuple) (incf sum (second tuple)))))
+ (assert (eql 41 sum))))
(when created
(pg-exec conn "DROP TABLE pgbooltest"))))))
+
+(defun test-integer-overflow ()
+ (format *debug-io* "Testing integer overflow signaling ...~%")
+ (with-test-connection (conn)
+ (let ((created nil))
+ (unwind-protect
+ (progn
+ (pg-exec conn "CREATE TABLE pg_int_overflow (a INTEGER, b INTEGER)")
+ (setq created t)
+ (handler-case
+ (loop :for i :from 10 :by 100
+ :do (pg-exec conn (format nil "INSERT INTO pg_int_overflow VALUES (~D, ~D)" i (* i i)))
+ (check-single-return conn (format nil "SELECT b FROM pg_int_overflow WHERE a = ~D" i) (* i i)))
+ (pg:backend-error (exc)
+ (format *debug-io* "OK: integer overflow handled: ~A~%" exc))
+ (error (exc)
+ (format *debug-io* "FAIL: integer overflow not handled: ~A~%" exc))))
+ (when created
+ (pg-exec conn "DROP TABLE pg_int_overflow"))))))
+
+(defun test-strings ()
+ (format *debug-io* "Testing strings ...~%")
+ (with-test-connection (conn)
+ (check-single-return conn "SELECT POSITION('4' IN '1234567890')" 4)
+ (check-single-return conn "SELECT SUBSTRING('1234567890' FROM 4 FOR 3)" "456" :test #'string-equal)
+ (check-single-return conn "SELECT 'indio' LIKE 'in__o'" t)
+ (check-single-return conn "SELECT replace('yabadabadoo', 'ba', '123')" "ya123da123doo" :test #'string-equal)
+ (check-single-return conn "select md5('ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789'::bytea)"
+ "d174ab98d277d9f5a5611c2c9f419d9f" :test #'string-equal)))
+
+
(defun test-integrity ()
(format *debug-io* "Testing integrity constaint signaling ...~%")
(with-test-connection (conn)
@@ -167,12 +208,131 @@
(when created
(pg-exec conn "DROP TABLE pgintegritycheck"))))))
+
+(defun test-error-handling ()
+ (format *debug-io* "Testing error handling ...~%")
+ (with-test-connection (conn)
+ ;; error handling for non-existant table
+ (handler-case (pg-exec conn "SELECT * FROM inexistant_table")
+ (pg:backend-error (exc)
+ (format *debug-io* "OK: non-existant table error handled: ~A~%" exc))
+ (error (exc)
+ (format *debug-io* "FAIL: unhandled error: ~A~%" exc)))
+ ;; test for an ABORT when not in a transaction
+ (handler-case (pg-exec conn "ABORT")
+ (pg:backend-error (exc)
+ (format *debug-io* "OK: ABORT outside transaction handled: ~A~%" exc))
+ (error (exc)
+ (format *debug-io* "FAIL: unhandled error: ~A~%" exc)))
+ ;; test division by zero
+ (handler-case (pg-exec conn "SELECT 1/0::int8")
+ (pg:backend-error (exc)
+ (format *debug-io* "OK: integer division by zero handled: ~A~%" exc))
+ (error (exc)
+ (format *debug-io* "FAIL: unhandled error: ~A~%" exc)))
+ (handler-case (pg-exec conn "SELECT 1/0::float4")
+ (pg:backend-error (exc)
+ (format *debug-io* "OK: floating point division by zero handled: ~A~%" exc))
+ (error (exc)
+ (format *debug-io* "FAIL: unhandled error: ~A~%" exc)))
+ (handler-case (pg-exec conn "DROP OPERATOR = (int4, nonesuch)")
+ (pg:backend-error (exc)
+ (format *debug-io* "OK: drop non-existant operator handled: ~A~%" exc))
+ (error (exc)
+ (format *debug-io* "FAIL: unhandled error: ~A~%" exc)))
+ (handler-case (pg-exec conn "EXPLAIN WHY MYSQL SUCKS")
+ (pg:backend-error (exc)
+ (format *debug-io* "OK: syntax error handled: ~A~%" exc))
+ (error (exc)
+ (format *debug-io* "FAIL: unhandled error: ~A~%" exc)))
+ (handler-case (pg-exec conn "SELECT DISTINCT on (foobar) * from pg_database")
+ (pg:backend-error (exc)
+ (format *debug-io* "OK: selected attribute not in table handled: ~A~%" exc))
+ (error (exc)
+ (format *debug-io* "FAIL: unhandled error: ~A~%" exc)))))
+
+(defun test-transactions ()
+ (format *debug-io* "Testing transactions ...~%")
+ (with-test-connection (conn)
+ (let ((created nil))
+ (unwind-protect
+ (progn
+ (pg-exec conn "CREATE TABLE truncating (a INTEGER PRIMARY KEY)")
+ (setq created t)
+ (pg-exec conn" INSERT INTO truncating VALUES (1)")
+ (pg-exec conn "INSERT INTO truncating VALUES (2)")
+ (let ((res (pg-exec conn "SELECT * FROM truncating")))
+ (assert (eql 2 (length (pg-result res :tuples)))))
+ ;; emit a TRUNCATE but then abort the transaction
+ (ignore-errors
+ (with-pg-transaction conn
+ (pg-exec conn "TRUNCATE truncating")
+ (error "oops, aborting to force a rollback")))
+ (let ((res (pg-exec conn "SELECT * FROM truncating")))
+ (assert (eql 2 (length (pg-result res :tuples)))))
+ (with-pg-transaction conn
+ (pg-exec conn "TRUNCATE truncating"))
+ (let ((res (pg-exec conn "SELECT * FROM truncating")))
+ (assert (zerop (length (pg-result res :tuples))))))
+ (when created
+ (pg-exec conn "DROP TABLE truncating"))))))
+
+(defun test-arrays ()
+ (format *debug-io* "Testing array support ... ~%")
+ (with-test-connection (conn)
+ (let ((created nil))
+ (unwind-protect
+ (progn
+ (pg-exec conn "CREATE TABLE arrtest (
+ a int2[],
+ b int4[][][],
+ c name[],
+ d text[][],
+ e float8[],
+ f char(5)[],
+ g varchar(5)[])")
+ (setq created t)
+ (pg-exec conn "INSERT INTO arrtest (a[1:5], b[1:1][1:2][1:2], c, d, f, g)
+ VALUES ('{1,2,3,4,5}', '{{{0,0},{1,2}}}', '{}', '{}', '{}', '{}')")
+ (pg-exec conn "UPDATE arrtest SET e[0] = '1.1'")
+ (pg-exec conn "UPDATE arrtest SET e[1] = '2.2'")
+ (pg-for-each conn "SELECT * FROM arrtest"
+ (lambda (tuple) (princ tuple) (terpri)))
+ (pg-exec conn "SELECT a[1], b[1][1][1], c[1], d[1][1], e[0] FROM arrtest"))
+ (when created
+ (pg-exec conn "DROP TABLE arrtest"))))))
+
+(defun test-bit-tables ()
+ (format *debug-io* "Testing bit-tables ... ~%")
+ (with-test-connection (conn)
+ (let ((created nil))
+ (unwind-protect
+ (progn
+ (pg-exec conn "CREATE TABLE BIT_TABLE(b BIT(11))")
+ (setq created t)
+ (pg-exec conn "INSERT INTO BIT_TABLE VALUES (B'00000000000')")
+ (pg-exec conn "INSERT INTO BIT_TABLE VALUES (B'11011000000')")
+ (pg-exec conn "INSERT INTO BIT_TABLE VALUES (B'01010101010')")
+ (handler-case (pg-exec conn "INSERT INTO BIT_TABLE VALUES (B'101011111010')")
+ (pg:backend-error (exc)
+ (format *debug-io* "OK: bittable overflow handled: ~A~%" exc))
+ (error (exc)
+ (format *debug-io* "FAIL: undetected bittable overflow (type ~A): ~A~%"
+ (type-of exc) exc)))
+ (pg-for-each conn "SELECT * FROM bit_table"
+ (lambda (tuple) (format t "bits: ~A~%" tuple))))
+ (when created
+ (pg-exec conn "DROP TABLE bit_table"))))))
+
(defun test-introspection ()
(format *debug-io* "Testing support for introspection ...~%")
(with-test-connection (conn)
(dotimes (i 500)
(pg-tables conn))))
+;; (let ((res (pg-exec conn "SELECT pg_stat_file('/tmp')")))
+;; (format t "stat(\"/tmp\"): ~S~%" (pg-result res :tuples)))))
+
;; Fibonnaci numbers with memoization via a database table
(defun fib (n)
@@ -205,10 +365,10 @@
(progn
(pg-exec conn "CREATE TABLE fib (n INTEGER, fibn INT8)")
(setq created t)
- (funwrap 'fib)
+ #+cmu (funwrap 'fib)
(time (setq non-memoized (fib 40)))
#+cmu (fwrap 'fib #'memoize-fib :user-data conn)
- (update-fwrappers 'fib) ; remove stale conn user-data object
+ #+cmu (update-fwrappers 'fib) ; remove stale conn user-data object
(time (setq memoized (fib 40)))
(format t "~S" (pg-exec conn "SELECT COUNT(n) FROM fib"))
(assert (eql non-memoized memoized)))
@@ -312,11 +472,40 @@
(with-test-connection (conn)
(pg-exec conn "DROP TABLE pgmt")))
+#+(and sbcl sb-thread)
+(defun test-multiprocess ()
+ (format *debug-io* "Testing multiprocess database access~%")
+ (with-test-connection (conn)
+ (pg-exec conn "CREATE TABLE pgmt (a TEXT, b INTEGER, C FLOAT)"))
+ (let ((dio *debug-io*))
+ (flet ((producer ()
+ (with-test-connection (con)
+ (dotimes (i 5000)
+ (if (= (mod i 1000) 0) (format dio "~s connected over ~S producing ~a~%"
+ sb-thread:*current-thread* mycony i))
+ (pg-exec con (format nil "INSERT INTO pgmt VALUES (~S, ~D, ~F)" i i i))
+ (when (zerop (mod i 100))
+ (pg-exec con "COMMIT WORK")))))
+ (consumer ()
+ (with-test-connection (con)
+ (dotimes (i 10)
+ (sleep 1)
+ (format dio "~&consumer on ~a" i)
+ (let ((res (pg-exec con "SELECT count(*) FROM pgmt")))
+ (format *debug-io* " Consumer sees ~D rows~%"
+ (first (pg-result res :tuple 0))))))))
+ (let ((prs (loop :for x :from 0 :below 3
+ :collect (sb-thread:make-thread #'producer :name "PG data producer")))
+ (co (sb-thread:make-thread #'consumer :name "PG data consumer")))
+ (loop :while (some 'sb-thread:thread-alive-p (append prs (list co)))
+ :do (sleep 5))))
+ (with-test-connection (conn)
+ (pg-exec conn "DROP TABLE pgmt"))))
(defun test-pbe ()
(with-test-connection (conn)
(when (pg-supports-pbe conn)
- (format *debug-io* "~&Testing pbe...")
+ (format *debug-io* "~&Testing PBE/int4 ...")
(let ((res nil)
(count 0)
(created nil))
@@ -324,7 +513,6 @@
(progn
(pg-exec conn "CREATE TABLE count_test(key int, val int)")
(setq created t)
- (format *debug-io* "~&table created")
(pg-prepare conn "ct_insert"
"INSERT INTO count_test VALUES ($1, $2)"
'("int4" "int4"))
@@ -349,14 +537,48 @@
(when created
(pg-exec conn "DROP TABLE count_test")))))))
+(defun test-pbe-text ()
+ (with-test-connection (conn)
+ (when (pg-supports-pbe conn)
+ (format *debug-io* "~&Testing PBE/text...")
+ (let ((res nil)
+ (count 0)
+ (created nil))
+ (unwind-protect
+ (progn
+ (pg-exec conn "CREATE TABLE pbe_text_test(key int, val text)")
+ (setq created t)
+ (pg-prepare conn "ct_insert/text"
+ "INSERT INTO pbe_text_test VALUES ($1, $2)"
+ '("int4" "text"))
+ (loop :for i :from 1 :to 100
+ :do
+ (pg-bind conn
+ "ct_portal/text" "ct_insert/text"
+ `((:int32 ,i)
+ (:string ,(format nil "~a" (* i i)))))
+ (pg-execute conn "ct_portal/text")
+ (pg-close-portal conn "ct_portal/text"))
+ (format *debug-io* "~&data inserted")
+ (setq res (pg-exec conn "SELECT count(val) FROM pbe_text_test"))
+ (assert (eql 100 (first (pg-result res :tuple 0))))
+ (setq res (pg-exec conn "SELECT sum(key) FROM pbe_text_test"))
+ (assert (eql 5050 (first (pg-result res :tuple 0))))
+ ;; this iterator does the equivalent of the sum(key) SQL statement
+ ;; above, but on the client side.
+ (pg-for-each conn "SELECT key FROM pbe_text_test"
+ (lambda (tuple) (incf count (first tuple))))
+ (assert (= 5050 count)))
+ (when created
+ (pg-exec conn "DROP TABLE pbe_text_test")))))))
+
(defun test-copy-in-out ()
(with-test-connection (conn)
(ignore-errors
(pg-exec conn "DROP TABLE foo"))
- (pg-exec conn "CREATE TABLE foo (a int, b int)")
- (pg-exec conn "INSERT INTO foo VALUES (1, 2)")
- (pg-exec conn "INSERT INTO foo VALUES (2, 4)")
-
+ (pg-exec conn "CREATE TABLE foo (a int, b int, c text)")
+ (pg-exec conn "INSERT INTO foo VALUES (1, 2, 'two')")
+ (pg-exec conn "INSERT INTO foo VALUES (2, 4, 'four')")
(with-open-file (stream "/tmp/foo-out"
:direction :output
:element-type '(unsigned-byte 8)
@@ -364,25 +586,43 @@
:if-exists :overwrite)
(setf (pgcon-sql-stream conn) stream)
(pg-exec conn "COPY foo TO stdout"))
-
(pg-exec conn "DELETE FROM foo")
(with-open-file (stream "/tmp/foo-out"
[67 lines skipped]
More information about the Pg-cvs
mailing list