[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