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@laas.fr +;;; Author: Eric Marsden eric.marsden@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) ,@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]