/[pg]/pg/pg-tests.lisp
ViewVC logotype

Contents of /pg/pg-tests.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.13 - (show annotations)
Sun Nov 19 18:47:58 2006 UTC (7 years, 4 months ago) by emarsden
Branch: MAIN
CVS Tags: HEAD
Changes since 1.12: +35 -30 lines
Allow encoding used for socket communication with the backend to be
specified as a keyword argument to PG-CONNECT, for cases where
rebinding *PG-CLIENT-ENCODING* is inconvenient.

Add a simple test for encoding support.

(From Attila Lendvai <attila.lendvai@gmail.com>)
1 ;;; pg-tests.lisp -- incomplete test suite
2 ;;;
3 ;;; Author: Eric Marsden <eric.marsden@free.fr>
4 ;;
5 ;;
6 ;; These tests assume that a table named "test" is defined in the
7 ;; system catalog, and that the user identified in
8 ;; CALL-WITH-TEST-CONNECTION has the rights to access that table.
9
10 (defpackage :pg-tests
11 (:use :cl
12 :pg
13 #+cmu :fwrappers)
14 (:export #:test))
15 (in-package :pg-tests)
16
17 (defmacro with-pg-connection/2 ((con &rest open-args) &body body)
18 `(let ((,con (pg::pg-connect/v2 ,@open-args)))
19 (unwind-protect
20 (progn ,@body)
21 (when ,con (pg-disconnect ,con)))))
22
23 ;; !!! CHANGE THE VALUES HERE !!!
24 (defmacro with-test-connection ((conn &key (database "test")
25 (user-name "pgdotlisp")
26 (password "secret")
27 (host "localhost") ;; or "/var/run/postgresql/"
28 (port 5432)
29 (encoding *pg-client-encoding*))
30 &body body)
31 `(with-pg-connection (,conn ,database ,user-name :password ,password
32 :host ,host :port ,port :encoding ,encoding)
33 ,@body))
34
35
36 (defun check-single-return (conn sql expected &key (test #'eql))
37 (let ((res (pg-exec conn sql)))
38 (assert (funcall test expected (first (pg-result res :tuple 0))))))
39
40
41 (defun test-insert ()
42 (format *debug-io* "Testing INSERT & SELECT on integers ...~%")
43 (with-test-connection (conn)
44 (let ((count 0)
45 (created nil))
46 (unwind-protect
47 (progn
48 (pg-exec conn "CREATE TABLE count_test(key int, val int)")
49 (loop :for i :from 1 :to 100
50 :for sql = (format nil "INSERT INTO count_test VALUES(~s, ~s)"
51 i (* i i))
52 :do (pg-exec conn sql))
53 (setq created t)
54 (pg-exec conn "VACUUM count_test")
55 (check-single-return conn "SELECT count(val) FROM count_test" 100)
56 (check-single-return conn "SELECT sum(key) FROM count_test" 5050)
57 ;; this iterator does the equivalent of the sum(key) SQL statement
58 ;; above, but on the client side.
59 (pg-for-each conn "SELECT key FROM count_test"
60 (lambda (tuple) (incf count (first tuple))))
61 (assert (= 5050 count)))
62 (when created
63 (pg-exec conn "DROP TABLE count_test"))))))
64
65 (defun test-insert/float ()
66 (format *debug-io* "Testing INSERT & SELECT on floats ...~%")
67 (with-test-connection (conn)
68 (let ((sum 0.0)
69 (created nil))
70 (flet ((float-eql (a b)
71 (< (/ (abs (- a b)) b) 1e-5)))
72 (unwind-protect
73 (progn
74 (pg-exec conn "CREATE TABLE count_test_float(key int, val float)")
75 (setq created t)
76 (loop :for i :from 1 :to 1000
77 :for sql = (format nil "INSERT INTO count_test_float VALUES(~d, ~f)"
78 i i)
79 :do (pg-exec conn sql))
80 (check-single-return conn "SELECT count(val) FROM count_test_float" 1000)
81 (check-single-return conn "SELECT sum(key) FROM count_test_float" 500500.0 :test #'float-eql)
82 ;; this iterator does the equivalent of the sum(key) SQL statement
83 ;; above, but on the client side.
84 (pg-for-each conn "SELECT val FROM count_test_float"
85 (lambda (tuple) (incf sum (first tuple))))
86 (assert (float-eql 500500 sum)))
87 (when created
88 (pg-exec conn "DROP TABLE count_test_float")))))))
89
90 (defun test-insert/numeric ()
91 (format *debug-io* "Testing INSERT & SELECT on NUMERIC ...~%")
92 (with-test-connection (conn)
93 (let ((sum 0)
94 (created nil))
95 (unwind-protect
96 (progn
97 (pg-exec conn "CREATE TABLE count_test_numeric(key int, val numeric(10,2))")
98 (setq created t)
99 (loop :for i :from 1 :to 1000
100 :for sql = (format nil "INSERT INTO count_test_numeric VALUES(~d, ~f)"
101 i i)
102 :do (pg-exec conn sql))
103 (check-single-return conn "SELECT count(val) FROM count_test_numeric" 1000)
104 (let ((res (pg-exec conn "EXPLAIN SELECT count(val) FROM count_test_numeric")))
105 (assert (string= "EXPLAIN" (pg-result res :status))))
106 (check-single-return conn "SELECT sum(key) FROM count_test_numeric" 500500)
107 ;; this iterator does the equivalent of the sum(key) SQL statement
108 ;; above, but on the client side.
109 (pg-for-each conn "SELECT val FROM count_test_numeric"
110 (lambda (tuple) (incf sum (first tuple))))
111 (assert (eql 500500 sum)))
112 ;; (check-single-return conn "SELECT 'infinity'::float4 + 'NaN'::float4" 'NAN)
113 (check-single-return conn "SELECT 1 / (!! 2)" 1/2)
114 (when created
115 (pg-exec conn "DROP TABLE count_test_numeric"))))))
116
117 (defun test-date ()
118 (format *debug-io* "Testing DATE and TIMESTAMP parsing ...~%")
119 (with-test-connection (conn)
120 (let ((created nil))
121 (unwind-protect
122 (progn
123 (pg-exec conn "CREATE TABLE pgltest (a timestamp, b abstime, c time, d date)")
124 (setq created t)
125 (pg-exec conn "COMMENT ON TABLE pgltest is 'pg-dot-lisp testing DATE and TIMESTAMP parsing'")
126 (pg-exec conn "INSERT INTO pgltest VALUES (current_timestamp, 'now', 'now', 'now')")
127 (let* ((res (pg-exec conn "SELECT * FROM pgltest"))
128 (parsed (first (pg-result res :tuples))))
129 (format t "attributes ~a~%" (pg-result res :attributes))
130 (format t "Timestamp = ~s~%abstime = ~s~%time = ~s (CL universal-time = ~d)~%date = ~s~%"
131 (first parsed)
132 (second parsed)
133 (third parsed)
134 (get-universal-time)
135 (fourth parsed))))
136 (when created
137 (pg-exec conn "DROP TABLE pgltest"))))))
138
139 (defun test-booleans ()
140 (format *debug-io* "Testing support for BOOLEAN type ...~%")
141 (with-test-connection (conn)
142 (let ((created nil))
143 (unwind-protect
144 (progn
145 (pg-exec conn "CREATE TABLE pgbooltest (a BOOLEAN, b INT4)")
146 (setq created t)
147 (pg-exec conn "INSERT INTO pgbooltest VALUES ('t', 42)")
148 (dotimes (i 100)
149 (pg-exec conn (format nil "INSERT INTO pgbooltest VALUES ('f', ~D)" i)))
150 (let ((sum 0))
151 (pg-for-each conn "SELECT * FROM pgbooltest"
152 (lambda (tuple) (when (first tuple) (incf sum (second tuple)))))
153 (assert (eql 42 sum)))
154 (pg-exec conn "ALTER TABLE pgbooltest ADD COLUMN foo int2")
155 (pg-exec conn "INSERT INTO pgbooltest VALUES ('t', -1, 1)")
156 (let ((sum 0))
157 (pg-for-each conn "SELECT * FROM pgbooltest"
158 (lambda (tuple) (when (first tuple) (incf sum (second tuple)))))
159 (assert (eql 41 sum))))
160 (when created
161 (pg-exec conn "DROP TABLE pgbooltest"))))))
162
163
164 (defun test-integer-overflow ()
165 (format *debug-io* "Testing integer overflow signaling ...~%")
166 (with-test-connection (conn)
167 (let ((created nil))
168 (unwind-protect
169 (progn
170 (pg-exec conn "CREATE TABLE pg_int_overflow (a INTEGER, b INTEGER)")
171 (setq created t)
172 (handler-case
173 (loop :for i :from 10 :by 100
174 :do (pg-exec conn (format nil "INSERT INTO pg_int_overflow VALUES (~D, ~D)" i (* i i)))
175 (check-single-return conn (format nil "SELECT b FROM pg_int_overflow WHERE a = ~D" i) (* i i)))
176 (pg:backend-error (exc)
177 (format *debug-io* "OK: integer overflow handled: ~A~%" exc))
178 (error (exc)
179 (format *debug-io* "FAIL: integer overflow not handled: ~A~%" exc)))
180 (handler-case (pg-exec conn "SELECT (10000 * 10000.0 / 45)::int2")
181 (pg:backend-error (exc)
182 (format *debug-io* "OK: int2 overflow handled: ~A~%" exc))
183 (error (exc)
184 (format *debug-io* "FAIL: int2 overflow not handled: ~A~%" exc))))
185 (when created
186 (pg-exec conn "DROP TABLE pg_int_overflow"))))))
187
188 (defun test-strings ()
189 (format *debug-io* "Testing strings ...~%")
190 (with-test-connection (conn)
191 (check-single-return conn "SELECT POSITION('4' IN '1234567890')" 4)
192 (check-single-return conn "SELECT SUBSTRING('1234567890' FROM 4 FOR 3)" "456" :test #'string-equal)
193 (check-single-return conn "SELECT 'indio' LIKE 'in__o'" t)
194 (check-single-return conn "SELECT replace('yabadabadoo', 'ba', '123')" "ya123da123doo" :test #'string-equal)
195 (check-single-return conn "select md5('ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789'::bytea)"
196 "d174ab98d277d9f5a5611c2c9f419d9f" :test #'string-equal)
197 (check-single-return conn "SELECT /* embedded comment */ CASE 'a' WHEN 'a' THEN 42 ELSE 2 END" 42)))
198
199
200 (defun test-integrity ()
201 (format *debug-io* "Testing integrity constaint signaling ...~%")
202 (with-test-connection (conn)
203 (let ((created nil))
204 (unwind-protect
205 (progn
206 (pg-exec conn "CREATE TABLE pgintegritycheck (a INTEGER UNIQUE)")
207 (setq created t)
208 (dotimes (i 100)
209 (pg-exec conn (format nil "INSERT INTO pgintegritycheck VALUES (~D)" i)))
210 (handler-case (pg-exec conn "INSERT INTO pgintegritycheck VALUES (1)")
211 (pg:backend-error (exc)
212 (format *debug-io* "OK: integrity constraint handled: ~A~%" exc))
213 (error (exc)
214 (format *debug-io* "FAIL: unhandled integrity constraint: ~A~%" exc))))
215 (when created
216 (pg-exec conn "DROP TABLE pgintegritycheck"))))))
217
218
219 (defun test-error-handling ()
220 (format *debug-io* "Testing error handling ...~%")
221 (with-test-connection (conn)
222 ;; error handling for non-existant table
223 (handler-case (pg-exec conn "SELECT * FROM inexistant_table")
224 (pg:backend-error (exc)
225 (format *debug-io* "OK: non-existant table error handled: ~A~%" exc))
226 (error (exc)
227 (format *debug-io* "FAIL: unhandled error: ~A~%" exc)))
228 ;; test for an ABORT when not in a transaction
229 (handler-case (pg-exec conn "ABORT")
230 (pg:backend-error (exc)
231 (format *debug-io* "OK: ABORT outside transaction handled: ~A~%" exc))
232 (error (exc)
233 (format *debug-io* "FAIL: unhandled error: ~A~%" exc)))
234 ;; test division by zero
235 (handler-case (pg-exec conn "SELECT 1/0::int8")
236 (pg:backend-error (exc)
237 (format *debug-io* "OK: integer division by zero handled: ~A~%" exc))
238 (error (exc)
239 (format *debug-io* "FAIL: unhandled error: ~A~%" exc)))
240 (handler-case (pg-exec conn "SELECT 1/0::float4")
241 (pg:backend-error (exc)
242 (format *debug-io* "OK: floating point division by zero handled: ~A~%" exc))
243 (error (exc)
244 (format *debug-io* "FAIL: unhandled error: ~A~%" exc)))
245 (handler-case (pg-exec conn "SELECT (4 / 4e40)::float4")
246 (pg:backend-error (exc)
247 (format *debug-io* "OK: floating point underflow handled: ~A~%" exc))
248 (error (exc)
249 (format *debug-io* "FAIL: unhandled floating point underflow: ~A~%" exc)))
250 (handler-case (pg-exec conn "SELECT (4 / 4e400)::float8")
251 (pg:backend-error (exc)
252 (format *debug-io* "OK: double precision floating point underflow handled: ~A~%" exc))
253 (error (exc)
254 (format *debug-io* "FAIL: unhandled double precision floating point underflow: ~A~%" exc)))
255 (handler-case (pg-exec conn "SELECT (log(-1))::float8")
256 (pg:backend-error (exc)
257 (format *debug-io* "OK: negative log handled: ~A~%" exc))
258 (error (exc)
259 (format *debug-io* "FAIL: undetected negative log: ~A~%" exc)))
260 (handler-case (pg-exec conn "DROP OPERATOR = (int4, nonesuch)")
261 (pg:backend-error (exc)
262 (format *debug-io* "OK: drop non-existant operator handled: ~A~%" exc))
263 (error (exc)
264 (format *debug-io* "FAIL: unhandled error: ~A~%" exc)))
265 (handler-case (pg-exec conn "SELECT CONVERT('éfooù' USING utf8_to_big5)")
266 (pg:backend-error (exc)
267 (format *debug-io* "OK: encoding error handled: ~A~%" exc))
268 (error (exc)
269 (format *debug-io* "FAIL: unhandled encoding error: ~A~%" exc)))
270 (handler-case (pg-exec conn "EXPLAIN WHY MYSQL SUCKS")
271 (pg:backend-error (exc)
272 (format *debug-io* "OK: syntax error handled: ~A~%" exc))
273 (error (exc)
274 (format *debug-io* "FAIL: unhandled error: ~A~%" exc)))
275 (handler-case (pg-exec conn "SELECT '{ }}'::text[]")
276 (pg:backend-error (exc)
277 (format *debug-io* "OK: array syntax error handled: ~A~%" exc))
278 (error (exc)
279 (format *debug-io* "FAIL: unhandled error: ~A~%" exc)))
280 (handler-case (pg-exec conn "SET SESSION AUTHORIZATION postgres")
281 (pg:backend-error (exc)
282 (format *debug-io* "OK: authorization error: ~A~%" exc))
283 (error (exc)
284 (format *debug-io* "FAIL: unhandled authorization error: ~A~%" exc)))
285 (handler-case (pg-exec conn "SELECT " (let ((sql "array[42]"))
286 (dotimes (i 2000)
287 (setq sql (format nil "array_prepend(~d, ~a)" i sql))) sql))
288 (pg:backend-error (exc)
289 (format *debug-io* "OK: stack overflow detected: ~A~%" exc))
290 (error (exc)
291 (format *debug-io* "FAIL: undetected stack overflow: ~A~%" exc)))
292 (handler-case (pg-exec conn "SELECT DISTINCT on (foobar) * from pg_database")
293 (pg:backend-error (exc)
294 (format *debug-io* "OK: selected attribute not in table handled: ~A~%" exc))
295 (error (exc)
296 (format *debug-io* "FAIL: unhandled error: ~A~%" exc)))))
297
298 (defun test-transactions ()
299 (format *debug-io* "Testing transactions ...~%")
300 (with-test-connection (conn)
301 (let ((created nil))
302 (unwind-protect
303 (progn
304 (pg-exec conn "CREATE TABLE truncating (a INTEGER PRIMARY KEY)")
305 (setq created t)
306 (pg-exec conn" INSERT INTO truncating VALUES (1)")
307 (pg-exec conn "INSERT INTO truncating VALUES (2)")
308 (let ((res (pg-exec conn "SELECT * FROM truncating")))
309 (assert (eql 2 (length (pg-result res :tuples)))))
310 ;; emit a TRUNCATE but then abort the transaction
311 (ignore-errors
312 (with-pg-transaction conn
313 (pg-exec conn "TRUNCATE truncating")
314 (pg-exec conn "SELECT sqrt(-2)")))
315 (let ((res (pg-exec conn "SELECT * FROM truncating")))
316 (assert (eql 2 (length (pg-result res :tuples)))))
317 (with-pg-transaction conn
318 (pg-exec conn "TRUNCATE truncating"))
319 (let ((res (pg-exec conn "SELECT * FROM truncating")))
320 (assert (zerop (length (pg-result res :tuples))))))
321 (when created
322 (pg-exec conn "DROP TABLE truncating"))))))
323
324 (defun test-arrays ()
325 (format *debug-io* "Testing array support ... ~%")
326 (with-test-connection (conn)
327 (let ((created nil))
328 (unwind-protect
329 (progn
330 (check-single-return conn "SELECT 33.4 > ALL(ARRAY[1,2,3])" t)
331 (check-single-return conn "SELECT 33.4 = ANY(ARRAY[1,2,3])" nil)
332 (check-single-return conn "SELECT 'foo' LIKE ANY (ARRAY['%a', '%o'])" t)
333 (pg-exec conn "CREATE TABLE arrtest (
334 a int2[],
335 b int4[][][],
336 c name[],
337 d text[][],
338 e float8[],
339 f char(5)[],
340 g varchar(5)[])")
341 (setq created t)
342 (pg-exec conn "INSERT INTO arrtest (a[1:5], b[1:1][1:2][1:2], c, d, f, g)
343 VALUES ('{1,2,3,4,5}', '{{{0,0},{1,2}}}', '{}', '{}', '{}', '{}')")
344 (pg-exec conn "UPDATE arrtest SET e[0] = '1.1'")
345 (pg-exec conn "UPDATE arrtest SET e[1] = '2.2'")
346 (pg-for-each conn "SELECT * FROM arrtest"
347 (lambda (tuple) (princ tuple) (terpri)))
348 (pg-exec conn "SELECT a[1], b[1][1][1], c[1], d[1][1], e[0] FROM arrtest"))
349 (when created
350 (pg-exec conn "DROP TABLE arrtest"))))))
351
352 (defun test-bit-tables ()
353 (format *debug-io* "Testing bit-tables ... ~%")
354 (with-test-connection (conn)
355 (let ((created nil))
356 (unwind-protect
357 (progn
358 (check-single-return conn "SELECT POSITION(B'1010' IN B'000001010')" 6)
359 (check-single-return conn "SELECT POSITION(B'1011011011011' IN B'00001011011011011')" 5)
360 (pg-exec conn "CREATE TABLE BIT_TABLE(b BIT(11))")
361 (setq created t)
362 (pg-exec conn "INSERT INTO BIT_TABLE VALUES (B'00000000000')")
363 (pg-exec conn "INSERT INTO BIT_TABLE VALUES (B'11011000000')")
364 (pg-exec conn "INSERT INTO BIT_TABLE VALUES (B'01010101010')")
365 (handler-case (pg-exec conn "INSERT INTO BIT_TABLE VALUES (B'101011111010')")
366 (pg:backend-error (exc)
367 (format *debug-io* "OK: bittable overflow handled: ~A~%" exc))
368 (error (exc)
369 (format *debug-io* "FAIL: undetected bittable overflow (type ~A): ~A~%"
370 (type-of exc) exc)))
371 (pg-for-each conn "SELECT * FROM bit_table"
372 (lambda (tuple) (format t "bits: ~A~%" tuple))))
373 (when created
374 (pg-exec conn "DROP TABLE bit_table"))))))
375
376 (defun test-introspection ()
377 (format *debug-io* "Testing support for introspection ...~%")
378 (with-test-connection (conn)
379 (dotimes (i 500)
380 (pg-tables conn))))
381
382 ;; (let ((res (pg-exec conn "SELECT pg_stat_file('/tmp')")))
383 ;; (format t "stat(\"/tmp\"): ~S~%" (pg-result res :tuples)))))
384
385
386 (defun test-encoding ()
387 (let ((octets (coerce '(105 97 122 115 124) '(vector (unsigned-byte 8)))))
388 (dolist (encoding '("UTF8" "LATIN1" "LATIN2"))
389 (let ((encoded (pg::convert-string-from-bytes octets encoding)))
390 (with-test-connection (conn :encoding encoding)
391 (ignore-errors
392 (pg-exec conn "DROP TABLE encoding_test"))
393 (pg-exec conn "CREATE TABLE encoding_test (a VARCHAR(40))")
394 (pg-exec conn "INSERT INTO encoding_test VALUES ('" encoded "')")
395 (check-single-return conn "SELECT * FROM encoding_test" encoded :test #'string=)
396 (pg-exec conn "DROP TABLE encoding_test"))))))
397
398
399
400 ;; Fibonnaci numbers with memoization via a database table
401 (defun fib (n)
402 (declare (type integer n))
403 (if (< n 2) 1 (+ (fib (- n 1)) (fib (- n 2)))))
404
405 ;; (compile 'fib)
406
407 #+cmu
408 (define-fwrapper memoize-fib (n)
409 (let* ((conn (fwrapper-user-data fwrapper))
410 (res (pg-exec conn (format nil "SELECT fibn FROM fib WHERE n = ~d" n)))
411 (tuples (pg-result res :tuples)))
412 (cond ((zerop (length tuples))
413 (let ((fibn (call-next-function)))
414 (pg-exec conn (format nil "INSERT INTO fib VALUES (~D, ~D)" n fibn))
415 fibn))
416 ((eql 1 (length tuples))
417 (caar tuples))
418 (t
419 (error "integrity error in fibn table")))))
420
421 (defun test-fib ()
422 (format *debug-io* "Testing fibonnaci number generation ...~%3")
423 (with-test-connection (conn)
424 (let ((created nil)
425 (non-memoized 0)
426 (memoized 0))
427 (unwind-protect
428 (progn
429 (pg-exec conn "CREATE TABLE fib (n INTEGER, fibn INT8)")
430 (setq created t)
431 #+cmu (funwrap 'fib)
432 (time (setq non-memoized (fib 40)))
433 #+cmu (fwrap 'fib #'memoize-fib :user-data conn)
434 #+cmu (update-fwrappers 'fib) ; remove stale conn user-data object
435 (time (setq memoized (fib 40)))
436 (format t "~S" (pg-exec conn "SELECT COUNT(n) FROM fib"))
437 (assert (eql non-memoized memoized)))
438 (when created
439 (pg-exec conn "DROP TABLE fib"))))))
440
441
442 (defun test-lo ()
443 (format *debug-io* "Testing large object support ...~%")
444 (with-test-connection (conn)
445 (with-pg-transaction conn
446 (let* ((oid (pglo-create conn))
447 (fd (pglo-open conn oid)))
448 (sleep 1)
449 (pglo-tell conn fd)
450 (sleep 1)
451 (pglo-unlink conn oid)))))
452
453 ;; test of large-object interface. We are careful to use vectors of
454 ;; bytes instead of strings, because with the v3 protocol strings
455 ;; undergo \\xxx encoding (for instance #\newline is transformed to \\012).
456 (defun test-lo-read ()
457 (format *debug-io* "Testing read of large object ...~%")
458 (with-test-connection (conn)
459 (with-pg-transaction conn
460 (let* ((oid (pglo-create conn "rw"))
461 (fd (pglo-open conn oid "rw")))
462 (pglo-write conn fd (map '(vector (unsigned-byte 8)) #'char-code (format nil "Hi there mate~%What's up?~%")))
463 (pglo-lseek conn fd 3 0) ; SEEK_SET = 0
464 (assert (eql 3 (pglo-tell conn fd)))
465 ;; this should print "there mate"
466 (format *debug-io* "Read ~s from lo~%" (map 'string #'code-char (pglo-read conn fd 10)))
467 (format *debug-io* "Rest is ~s~%" (map 'string #'code-char (pglo-read conn fd 1024)))
468 (pglo-close conn fd)
469 #+nil (pglo-unlink conn oid)))))
470
471 #+cmu
472 (defun test-lo-import ()
473 (format *debug-io* "Testing import of large object ...~%")
474 (with-test-connection (conn)
475 (with-pg-transaction conn
476 (let ((oid (pglo-import conn "/etc/group")))
477 (pglo-export conn oid "/tmp/group")
478 (cond ((zerop
479 (ext:process-exit-code
480 (ext:run-program "diff" (list "/tmp/group" "/etc/group"))))
481 (format *debug-io* "pglo-import test succeeded~%")
482 (unix:unix-unlink "/tmp/group"))
483 (t
484 (format *debug-io* "pglo-import test failed: check differences
485 between files /etc/group and /tmp/group")))
486 (pglo-unlink conn oid)))))
487
488 (defun test-simple ()
489 (let ((*pg-disable-type-coercion* t))
490 (with-test-connection (conn)
491 (format t "backend ~a~%" (pg-backend-version conn)))))
492
493 (defun test-notifications ()
494 (with-test-connection (conn)
495 (let (res)
496 (setq res (pg-exec conn "LISTEN pg_test_listen"))
497 (format t "LISTEN -> ~S~%" (pg-result res :status))
498 (assert (null (pg::pgcon-notices conn)))
499 (pg-exec conn "SELECT * FROM pg_type")
500 (assert (null (pg::pgcon-notices conn)))
501 (setq res (pg-exec conn "NOTIFY pg_test_listen"))
502 (format t "NOTIFY -> ~S~%" (pg-result res :status))
503 (format t "In TEST-NOTIFICATIONS notices are ~S~%"
504 (pg::pgcon-notices conn)))))
505
506
507 ;; FIXME could add interaction between producer and consumers via NOTIFY
508
509 #+(and cmu mp)
510 (defun test-multiprocess ()
511 (format *debug-io* "Testing multiprocess database access~%")
512 (when (eq mp::*current-process* mp::*initial-process*)
513 (mp::startup-idle-and-top-level-loops))
514 (with-test-connection (conn)
515 (pg-exec conn "CREATE TABLE pgmt (a TEXT, b INTEGER, C FLOAT)"))
516 (flet ((producer ()
517 (with-test-connection (conn)
518 (dotimes (i 5000)
519 (pg-exec conn (format nil "INSERT INTO pgmt VALUES (~S, ~D, ~F)" i i i))
520 (when (zerop (mod i 100))
521 (pg-exec conn "COMMIT WORK")))))
522 (consumer ()
523 (with-test-connection (conn)
524 (dotimes (i 10)
525 (sleep 1)
526 (let ((res (pg-exec conn "SELECT count(*) FROM pgmt")))
527 (format *debug-io* " Consumer sees ~D rows~%"
528 (first (pg-result res :tuple 0))))))))
529 (let ((p1 (mp:make-process #'producer :name "PG data producer"))
530 (p2 (mp:make-process #'producer :name "PG data producer"))
531 (p3 (mp:make-process #'producer :name "PG data producer"))
532 (co (mp:make-process #'consumer :name "PG data consumer")))
533 (loop :while (some 'mp:process-alive-p (list p1 p2 p3 co))
534 :do (sleep 5) (mp:show-processes t))))
535 (with-test-connection (conn)
536 (pg-exec conn "DROP TABLE pgmt")))
537
538 #+(and sbcl sb-thread)
539 (defun test-multiprocess ()
540 (format *debug-io* "Testing multiprocess database access~%")
541 (with-test-connection (conn)
542 (pg-exec conn "CREATE TABLE pgmt (a TEXT, b INTEGER, C FLOAT)"))
543 (let ((dio *debug-io*))
544 (flet ((producer ()
545 (with-test-connection (con)
546 (dotimes (i 5000)
547 (if (= (mod i 1000) 0) (format dio "~s connected over ~S producing ~a~%"
548 sb-thread:*current-thread* con i))
549 (pg-exec con (format nil "INSERT INTO pgmt VALUES (~S, ~D, ~F)" i i i))
550 (when (zerop (mod i 100))
551 (pg-exec con "COMMIT WORK")))))
552 (consumer ()
553 (with-test-connection (con)
554 (dotimes (i 10)
555 (sleep 1)
556 (format dio "~&consumer on ~a" i)
557 (let ((res (pg-exec con "SELECT count(*) FROM pgmt")))
558 (format *debug-io* " Consumer sees ~D rows~%"
559 (first (pg-result res :tuple 0))))))))
560 (let ((prs (loop :for x :from 0 :below 3
561 :collect (sb-thread:make-thread #'producer :name "PG data producer")))
562 (co (sb-thread:make-thread #'consumer :name "PG data consumer")))
563 (loop :while (some 'sb-thread:thread-alive-p (append prs (list co)))
564 :do (sleep 5))))
565 (with-test-connection (conn)
566 (pg-exec conn "DROP TABLE pgmt"))))
567
568 (defun test-pbe ()
569 (with-test-connection (conn)
570 (when (pg-supports-pbe conn)
571 (format *debug-io* "~&Testing PBE/int4 ...")
572 (let ((count 0)
573 (created nil))
574 (unwind-protect
575 (progn
576 (pg-exec conn "CREATE TABLE count_test(key int, val int)")
577 (setq created t)
578 (pg-prepare conn "ct_insert"
579 "INSERT INTO count_test VALUES ($1, $2)"
580 '("int4" "int4"))
581 (loop :for i :from 1 :to 100
582 :do
583 (pg-bind conn
584 "ct_portal" "ct_insert"
585 `((:int32 ,i)
586 (:int32 ,(* i i))))
587 (pg-execute conn "ct_portal")
588 (pg-close-portal conn "ct_portal"))
589 (check-single-return conn "SELECT count(val) FROM count_test" 100)
590 (check-single-return conn "SELECT sum(key) FROM count_test" 5050)
591 ;; this iterator does the equivalent of the sum(key) SQL statement
592 ;; above, but on the client side.
593 (pg-for-each conn "SELECT key FROM count_test"
594 (lambda (tuple) (incf count (first tuple))))
595 (assert (= 5050 count)))
596 (when created
597 (pg-exec conn "DROP TABLE count_test")))))))
598
599 (defun test-pbe-text ()
600 (with-test-connection (conn)
601 (when (pg-supports-pbe conn)
602 (format *debug-io* "~&Testing PBE/text...")
603 (let ((count 0)
604 (created nil))
605 (unwind-protect
606 (progn
607 (pg-exec conn "CREATE TABLE pbe_text_test(key int, val text)")
608 (setq created t)
609 (pg-prepare conn "ct_insert/text"
610 "INSERT INTO pbe_text_test VALUES ($1, $2)"
611 '("int4" "text"))
612 (loop :for i :from 1 :to 100
613 :do
614 (pg-bind conn
615 "ct_portal/text" "ct_insert/text"
616 `((:int32 ,i)
617 (:string ,(format nil "~a" (* i i)))))
618 (pg-execute conn "ct_portal/text")
619 (pg-close-portal conn "ct_portal/text"))
620 (check-single-return conn "SELECT count(val) FROM pbe_text_test" 100)
621 (check-single-return conn "SELECT sum(key) FROM pbe_text_test" 5050)
622 ;; this iterator does the equivalent of the sum(key) SQL statement
623 ;; above, but on the client side.
624 (pg-for-each conn "SELECT key FROM pbe_text_test"
625 (lambda (tuple) (incf count (first tuple))))
626 (assert (= 5050 count)))
627 (when created
628 (pg-exec conn "DROP TABLE pbe_text_test")))))))
629
630 (defun test-copy-in-out ()
631 (with-test-connection (conn)
632 (ignore-errors
633 (pg-exec conn "DROP TABLE foo"))
634 (pg-exec conn "CREATE TABLE foo (a int, b int, c text)")
635 (pg-exec conn "INSERT INTO foo VALUES (1, 2, 'two')")
636 (pg-exec conn "INSERT INTO foo VALUES (2, 4, 'four')")
637 (with-open-file (stream "/tmp/foo-out"
638 :direction :output
639 :element-type '(unsigned-byte 8)
640 :if-does-not-exist :create
641 :if-exists :overwrite)
642 (setf (pgcon-sql-stream conn) stream)
643 (pg-exec conn "COPY foo TO stdout"))
644 (pg-exec conn "DELETE FROM foo")
645 (with-open-file (stream "/tmp/foo-out"
646 :direction :input
647 :element-type '(unsigned-byte 8)
648 :if-does-not-exist :error)
649 (setf (pgcon-sql-stream conn) stream)
650 (pg-exec conn "COPY foo FROM stdout"))
651 (let ((res (pg-exec conn "SELECT b FROM foo WHERE a = 1")))
652 (assert (eql 2 (first (pg-result res :tuple 0)))))
653 (let ((res (pg-exec conn "SELECT c FROM foo WHERE a = 1")))
654 (assert (string-equal "two" (first (pg-result res :tuple 0)))))
655 (let ((res (pg-exec conn "SELECT b FROM foo WHERE a = 2")))
656 (assert (eql 4 (first (pg-result res :tuple 0)))))
657 (pg-exec conn "DROP TABLE foo")))
658
659
660 (defun test-triggers ()
661 (with-test-connection (conn)
662 (ignore-errors
663 (pg-exec conn "DROP TABLE pg_trigger_table"))
664 (pg-exec conn "CREATE TABLE pg_trigger_table (a int, b int)")
665 (pg-exec conn "CREATE FUNCTION trigger_func() RETURNS trigger LANGUAGE plpgsql AS '"
666 "BEGIN "
667 "RAISE NOTICE ''trigger_func() called: action = %, when = %, level = %'', TG_OP, TG_WHEN, TG_LEVEL; "
668 "RETURN NULL; "
669 "END;'")
670 (pg-exec conn "CREATE TRIGGER before_ins_stmt_trig BEFORE INSERT ON pg_trigger_table "
671 "FOR EACH STATEMENT EXECUTE PROCEDURE trigger_func()")
672 (pg-exec conn "CREATE TRIGGER after_ins_stmt_trig AFTER INSERT ON pg_trigger_table "
673 "FOR EACH STATEMENT EXECUTE PROCEDURE trigger_func()")
674 (pg-exec conn "INSERT INTO pg_trigger_table VALUES (1, 2)")
675 (pg-exec conn "INSERT INTO pg_trigger_table VALUES (3, 4)")
676 (pg-exec conn "DROP TABLE pg_trigger_table")))
677
678
679 (defun test ()
680 (let (#+nil(*pg-client-encoding* "UTF8"))
681 (with-test-connection (conn)
682 (format t "Running pg.lisp tests against backend ~a~%" (pg-backend-version conn))
683 ;; client encoding supported since PostgreSQL v7.1
684 (format t "Client encoding is ~A~%" (pg-client-encoding conn))
685 (format t "Date style is ~A~%" (pg-date-style conn))
686 (let ((r2 (pg-exec conn "CREATE TABLE pgltest (a int, b float, c numeric)"))
687 (r3 (pg-exec conn "INSERT INTO pgltest VALUES (3, -1234.5e67, 123.45)"))
688 (r4 (pg-exec conn "DROP TABLE pgltest")))
689 (format t "~%==============================================~%")
690 (format t "status of CREATE is ~s~%" (pg-result r2 :status))
691 (format t "status of INSERT is ~s~%" (pg-result r3 :status))
692 (format t "oid of INSERT is ~s~%" (pg-result r3 :oid))
693 (format t "status of DROP is ~s~%" (pg-result r4 :status))
694 (format t "==============================================~%")))
695 (test-simple)
696 (test-insert)
697 (test-insert/float)
698 (test-insert/numeric)
699 (test-date)
700 (test-booleans)
701 (test-integer-overflow)
702 (test-strings)
703 (test-integrity)
704 (test-error-handling)
705 (test-transactions)
706 (test-arrays)
707 (test-bit-tables)
708 (test-notifications)
709 (test-lo)
710 (test-lo-read)
711 #+cmu (test-lo-import)
712 (test-pbe)
713 (test-pbe-text)
714 #+unix
715 (test-copy-in-out)
716 (values)))
717
718
719 ;; EOF

  ViewVC Help
Powered by ViewVC 1.1.5