File: pg-tests.lisp

package info (click to toggle)
cl-pg 1:20061216-4
  • links: PTS
  • area: main
  • in suites: lenny
  • size: 276 kB
  • ctags: 233
  • sloc: lisp: 3,125; makefile: 43
file content (719 lines) | stat: -rw-r--r-- 32,761 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
;;; pg-tests.lisp -- incomplete test suite
;;;
;;; Author: Eric Marsden <eric.marsden@free.fr>
;;
;;
;; These tests assume that a table named "test" is defined in the
;; system catalog, and that the user identified in
;; CALL-WITH-TEST-CONNECTION has the rights to access that table.

(defpackage :pg-tests
  (:use :cl
        :pg
        #+cmu :fwrappers)
  (:export #:test))
(in-package :pg-tests)

(defmacro with-pg-connection/2 ((con &rest open-args) &body body)
  `(let ((,con (pg::pg-connect/v2 ,@open-args)))
     (unwind-protect
         (progn ,@body)
       (when ,con (pg-disconnect ,con)))))

;; !!! CHANGE THE VALUES HERE !!!
(defmacro with-test-connection ((conn &key (database "test")
                                      (user-name "pgdotlisp")
                                      (password "secret")
                                      (host "localhost") ;; or "/var/run/postgresql/"
                                      (port 5432)
                                      (encoding *pg-client-encoding*))
                                &body body)
  `(with-pg-connection (,conn ,database ,user-name :password ,password
                        :host ,host :port ,port :encoding ,encoding)
    ,@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)
    (let ((count 0)
          (created nil))
      (unwind-protect
           (progn
             (pg-exec conn "CREATE TABLE count_test(key int, val int)")
             (loop :for i :from 1 :to 100
                   :for sql = (format nil "INSERT INTO count_test VALUES(~s, ~s)"
                                      i (* i i))
                   :do (pg-exec conn sql))
             (setq created t)
             (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"
                          (lambda (tuple) (incf count (first tuple))))
             (assert (= 5050 count)))
        (when created
          (pg-exec conn "DROP TABLE count_test"))))))

(defun test-insert/float ()
  (format *debug-io* "Testing INSERT & SELECT on floats ...~%")
  (with-test-connection (conn)
    (let ((sum 0.0)
          (created nil))
      (flet ((float-eql (a b)
               (< (/ (abs (- a b)) b) 1e-5)))
        (unwind-protect
             (progn
               (pg-exec conn "CREATE TABLE count_test_float(key int, val float)")
               (setq created t)
               (loop :for i :from 1 :to 1000
                     :for sql = (format nil "INSERT INTO count_test_float VALUES(~d, ~f)"
                                        i i)
                     :do (pg-exec conn sql))
               (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"
                            (lambda (tuple) (incf sum (first tuple))))
               (assert (float-eql 500500 sum)))
          (when created
            (pg-exec conn "DROP TABLE count_test_float")))))))

(defun test-insert/numeric ()
  (format *debug-io* "Testing INSERT & SELECT on NUMERIC ...~%")
  (with-test-connection (conn)
    (let ((sum 0)
          (created nil))
      (unwind-protect
           (progn
             (pg-exec conn "CREATE TABLE count_test_numeric(key int, val numeric(10,2))")
             (setq created t)
             (loop :for i :from 1 :to 1000
                   :for sql = (format nil "INSERT INTO count_test_numeric VALUES(~d, ~f)"
                                      i i)
                   :do (pg-exec conn sql))
             (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"
                          (lambda (tuple) (incf sum (first tuple))))
             (assert (eql 500500 sum)))
        ;; (check-single-return conn "SELECT 'infinity'::float4 + 'NaN'::float4" 'NAN)
        (check-single-return conn "SELECT 1 / (!! 2)" 1/2)
        (when created
          (pg-exec conn "DROP TABLE count_test_numeric"))))))

(defun test-date ()
  (format *debug-io* "Testing DATE and TIMESTAMP parsing ...~%")
  (with-test-connection (conn)
    (let ((created nil))
      (unwind-protect
           (progn
             (pg-exec conn "CREATE TABLE pgltest (a timestamp, b abstime, c time, d date)")
             (setq created t)
             (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))
               (format t "Timestamp = ~s~%abstime = ~s~%time = ~s (CL universal-time = ~d)~%date = ~s~%"
                       (first parsed)
                       (second parsed)
                       (third parsed)
                       (get-universal-time)
                       (fourth parsed))))
        (when created
          (pg-exec conn "DROP TABLE pgltest"))))))

(defun test-booleans ()
  (format *debug-io* "Testing support for BOOLEAN type ...~%")
  (with-test-connection (conn)
    (let ((created nil))
      (unwind-protect
           (progn
             (pg-exec conn "CREATE TABLE pgbooltest (a BOOLEAN, b INT4)")
             (setq created t)
             (pg-exec conn "INSERT INTO pgbooltest VALUES ('t', 42)")
             (dotimes (i 100)
               (pg-exec conn (format nil "INSERT INTO pgbooltest VALUES ('f', ~D)" i)))
             (let ((sum 0))
               (pg-for-each conn "SELECT * FROM pgbooltest"
                            (lambda (tuple) (when (first tuple) (incf sum (second tuple)))))
               (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)))
             (handler-case (pg-exec conn "SELECT (10000 * 10000.0 / 45)::int2")
               (pg:backend-error (exc)
                 (format *debug-io* "OK: int2 overflow handled: ~A~%" exc))
               (error (exc)
                 (format *debug-io* "FAIL: int2 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)
    (check-single-return conn "SELECT /* embedded comment */ CASE 'a' WHEN 'a' THEN 42 ELSE 2 END" 42)))


(defun test-integrity ()
  (format *debug-io* "Testing integrity constaint signaling ...~%")
  (with-test-connection (conn)
    (let ((created nil))
      (unwind-protect
           (progn
             (pg-exec conn "CREATE TABLE pgintegritycheck (a INTEGER UNIQUE)")
             (setq created t)
             (dotimes (i 100)
               (pg-exec conn (format nil "INSERT INTO pgintegritycheck VALUES (~D)" i)))
             (handler-case (pg-exec conn "INSERT INTO pgintegritycheck VALUES (1)")
               (pg:backend-error (exc)
                 (format *debug-io* "OK: integrity constraint handled: ~A~%" exc))
               (error (exc)
                 (format *debug-io* "FAIL: unhandled integrity constraint: ~A~%" exc))))
        (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 "SELECT (4 / 4e40)::float4")
      (pg:backend-error (exc)
        (format *debug-io* "OK: floating point underflow handled: ~A~%" exc))
      (error (exc)
        (format *debug-io* "FAIL: unhandled floating point underflow: ~A~%" exc)))
    (handler-case (pg-exec conn "SELECT (4 / 4e400)::float8")
      (pg:backend-error (exc)
        (format *debug-io* "OK: double precision floating point underflow handled: ~A~%" exc))
      (error (exc)
        (format *debug-io* "FAIL: unhandled double precision floating point underflow: ~A~%" exc)))
    (handler-case (pg-exec conn "SELECT (log(-1))::float8")
      (pg:backend-error (exc)
        (format *debug-io* "OK: negative log handled: ~A~%" exc))
      (error (exc)
        (format *debug-io* "FAIL: undetected negative log: ~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 "SELECT CONVERT('éfooù' USING utf8_to_big5)")
      (pg:backend-error (exc)
        (format *debug-io* "OK: encoding error handled: ~A~%" exc))
      (error (exc)
        (format *debug-io* "FAIL: unhandled encoding 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 '{ }}'::text[]")
      (pg:backend-error (exc)
        (format *debug-io* "OK: array syntax error handled: ~A~%" exc))
      (error (exc)
        (format *debug-io* "FAIL: unhandled error: ~A~%" exc)))
    (handler-case (pg-exec conn "SET SESSION AUTHORIZATION postgres")
      (pg:backend-error (exc)
        (format *debug-io* "OK: authorization error: ~A~%" exc))
      (error (exc)
        (format *debug-io* "FAIL: unhandled authorization error: ~A~%" exc)))
    (handler-case (pg-exec conn "SELECT " (let ((sql "array[42]"))
                                            (dotimes (i 2000)
                                              (setq sql (format nil "array_prepend(~d, ~a)" i sql))) sql))
      (pg:backend-error (exc)
        (format *debug-io* "OK: stack overflow detected: ~A~%" exc))
      (error (exc)
        (format *debug-io* "FAIL: undetected stack overflow: ~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")
                 (pg-exec conn "SELECT sqrt(-2)")))
             (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
             (check-single-return conn "SELECT 33.4 > ALL(ARRAY[1,2,3])" t)
             (check-single-return conn "SELECT 33.4 = ANY(ARRAY[1,2,3])" nil)
             (check-single-return conn "SELECT 'foo' LIKE ANY (ARRAY['%a', '%o'])" t)
             (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
             (check-single-return conn "SELECT POSITION(B'1010' IN B'000001010')" 6)
             (check-single-return conn "SELECT POSITION(B'1011011011011' IN B'00001011011011011')" 5)
             (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)))))


(defun test-encoding ()
  (let ((octets (coerce '(105 97 122 115 124) '(vector (unsigned-byte 8)))))
    (dolist (encoding '("UTF8" "LATIN1" "LATIN2"))
      (let ((encoded (pg::convert-string-from-bytes octets encoding)))
        (with-test-connection (conn :encoding encoding)
          (ignore-errors
            (pg-exec conn "DROP TABLE encoding_test"))
          (pg-exec conn "CREATE TABLE encoding_test (a VARCHAR(40))")
          (pg-exec conn "INSERT INTO encoding_test VALUES ('" encoded "')")
          (check-single-return conn "SELECT * FROM encoding_test" encoded :test #'string=)
          (pg-exec conn "DROP TABLE encoding_test"))))))



;; Fibonnaci numbers with memoization via a database table
(defun fib (n)
  (declare (type integer n))
  (if (< n 2) 1 (+ (fib (- n 1)) (fib (- n 2)))))

;; (compile 'fib)

#+cmu
(define-fwrapper memoize-fib (n)
  (let* ((conn (fwrapper-user-data fwrapper))
         (res (pg-exec conn (format nil "SELECT fibn FROM fib WHERE n = ~d" n)))
         (tuples (pg-result res :tuples)))
    (cond ((zerop (length tuples))
           (let ((fibn (call-next-function)))
             (pg-exec conn (format nil "INSERT INTO fib VALUES (~D, ~D)" n fibn))
             fibn))
          ((eql 1 (length tuples))
           (caar tuples))
          (t
           (error "integrity error in fibn table")))))

(defun test-fib ()
  (format *debug-io* "Testing fibonnaci number generation ...~%3")
  (with-test-connection (conn)
    (let ((created nil)
          (non-memoized 0)
          (memoized 0))
      (unwind-protect
           (progn
             (pg-exec conn "CREATE TABLE fib (n INTEGER, fibn INT8)")
             (setq created t)
             #+cmu (funwrap 'fib)
             (time (setq non-memoized (fib 40)))
             #+cmu (fwrap 'fib #'memoize-fib :user-data conn)
             #+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)))
        (when created
          (pg-exec conn "DROP TABLE fib"))))))


(defun test-lo ()
  (format *debug-io* "Testing large object support ...~%")
  (with-test-connection (conn)
   (with-pg-transaction conn
    (let* ((oid (pglo-create conn))
           (fd (pglo-open conn oid)))
      (sleep 1)
      (pglo-tell conn fd)
      (sleep 1)
      (pglo-unlink conn oid)))))

;; test of large-object interface. We are careful to use vectors of
;; bytes instead of strings, because with the v3 protocol strings
;; undergo \\xxx encoding (for instance #\newline is transformed to \\012). 
(defun test-lo-read ()
  (format *debug-io* "Testing read of large object ...~%")
  (with-test-connection (conn)
   (with-pg-transaction conn
    (let* ((oid (pglo-create conn "rw"))
           (fd (pglo-open conn oid "rw")))
      (pglo-write conn fd (map '(vector (unsigned-byte 8)) #'char-code (format nil "Hi there mate~%What's up?~%")))
      (pglo-lseek conn fd 3 0)           ; SEEK_SET = 0
      (assert (eql 3 (pglo-tell conn fd)))
      ;; this should print "there mate"
      (format *debug-io* "Read ~s from lo~%" (map 'string #'code-char (pglo-read conn fd 10)))
      (format *debug-io* "Rest is ~s~%" (map 'string #'code-char (pglo-read conn fd 1024)))
      (pglo-close conn fd)
      #+nil (pglo-unlink conn oid)))))

#+cmu
(defun test-lo-import ()
  (format *debug-io* "Testing import of large object ...~%")
  (with-test-connection (conn)
   (with-pg-transaction conn
    (let ((oid (pglo-import conn "/etc/group")))
      (pglo-export conn oid "/tmp/group")
      (cond ((zerop
              (ext:process-exit-code
               (ext:run-program "diff" (list "/tmp/group" "/etc/group"))))
             (format *debug-io* "pglo-import test succeeded~%")
             (unix:unix-unlink "/tmp/group"))
            (t
             (format *debug-io* "pglo-import test failed: check differences
between files /etc/group and /tmp/group")))
      (pglo-unlink conn oid)))))

(defun test-simple ()
  (let ((*pg-disable-type-coercion* t))
    (with-test-connection (conn)
     (format t "backend ~a~%" (pg-backend-version conn)))))

(defun test-notifications ()
  (with-test-connection (conn)
    (let (res)
      (setq res (pg-exec conn "LISTEN pg_test_listen"))
      (format t "LISTEN -> ~S~%" (pg-result res :status))
      (assert (null (pg::pgcon-notices conn)))
      (pg-exec conn "SELECT * FROM pg_type")
      (assert (null (pg::pgcon-notices conn)))
      (setq res (pg-exec conn "NOTIFY pg_test_listen"))
      (format t "NOTIFY -> ~S~%" (pg-result res :status))
      (format t "In TEST-NOTIFICATIONS notices are ~S~%"
              (pg::pgcon-notices conn)))))


;; FIXME could add interaction between producer and consumers via NOTIFY

#+(and cmu mp)
(defun test-multiprocess ()
  (format *debug-io* "Testing multiprocess database access~%")
  (when (eq mp::*current-process* mp::*initial-process*)
    (mp::startup-idle-and-top-level-loops))
  (with-test-connection (conn)
    (pg-exec conn "CREATE TABLE pgmt (a TEXT, b INTEGER, C FLOAT)"))
  (flet ((producer ()
           (with-test-connection (conn)
             (dotimes (i 5000)
               (pg-exec conn (format nil "INSERT INTO pgmt VALUES (~S, ~D, ~F)" i i i))
               (when (zerop (mod i 100))
                 (pg-exec conn "COMMIT WORK")))))
         (consumer ()
           (with-test-connection (conn)
             (dotimes (i 10)
               (sleep 1)
               (let ((res (pg-exec conn "SELECT count(*) FROM pgmt")))
                 (format *debug-io* "  Consumer sees ~D rows~%"
                         (first (pg-result res :tuple 0))))))))
    (let ((p1 (mp:make-process #'producer :name "PG data producer"))
          (p2 (mp:make-process #'producer :name "PG data producer"))
          (p3 (mp:make-process #'producer :name "PG data producer"))
          (co (mp:make-process #'consumer :name "PG data consumer")))
      (loop :while (some 'mp:process-alive-p (list p1 p2 p3 co))
            :do (sleep 5) (mp:show-processes t))))
  (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* con 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/int4 ...")
      (let ((count 0)
            (created nil))
        (unwind-protect
             (progn
               (pg-exec conn "CREATE TABLE count_test(key int, val int)")
               (setq created t)
               (pg-prepare conn "ct_insert"
                           "INSERT INTO count_test VALUES ($1, $2)"
                           '("int4" "int4"))
               (loop :for i :from 1 :to 100
                     :do
                     (pg-bind conn
                              "ct_portal" "ct_insert"
                              `((:int32 ,i)
                                (:int32 ,(* i i))))
                     (pg-execute conn "ct_portal")
                     (pg-close-portal conn "ct_portal"))
               (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"
                            (lambda (tuple) (incf count (first tuple))))
               (assert (= 5050 count)))
          (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 ((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"))
               (check-single-return conn "SELECT count(val) FROM pbe_text_test" 100)
               (check-single-return conn "SELECT sum(key) FROM pbe_text_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 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, 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)
			    :if-does-not-exist :create
			    :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"
			    :direction :input
			    :element-type '(unsigned-byte 8)
			    :if-does-not-exist :error)
      (setf (pgcon-sql-stream conn) stream)
      (pg-exec conn "COPY foo FROM stdout"))
    (let ((res (pg-exec conn "SELECT b FROM foo WHERE a = 1")))
      (assert (eql 2 (first (pg-result res :tuple 0)))))
    (let ((res (pg-exec conn "SELECT c FROM foo WHERE a = 1")))
      (assert (string-equal "two" (first (pg-result res :tuple 0)))))
    (let ((res (pg-exec conn "SELECT b FROM foo WHERE a = 2")))
      (assert (eql 4 (first (pg-result res :tuple 0)))))
    (pg-exec conn "DROP TABLE foo")))


(defun test-triggers ()
  (with-test-connection (conn)
    (ignore-errors
      (pg-exec conn "DROP TABLE pg_trigger_table"))
    (pg-exec conn "CREATE TABLE pg_trigger_table (a int, b int)")
    (pg-exec conn "CREATE FUNCTION trigger_func() RETURNS trigger LANGUAGE plpgsql AS '"
             "BEGIN "
             "RAISE NOTICE ''trigger_func() called: action = %, when = %, level = %'', TG_OP, TG_WHEN, TG_LEVEL; "
             "RETURN NULL; "
             "END;'")
    (pg-exec conn "CREATE TRIGGER before_ins_stmt_trig BEFORE INSERT ON pg_trigger_table "
             "FOR EACH STATEMENT EXECUTE PROCEDURE trigger_func()")
    (pg-exec conn "CREATE TRIGGER after_ins_stmt_trig AFTER INSERT ON pg_trigger_table "
             "FOR EACH STATEMENT EXECUTE PROCEDURE trigger_func()")
    (pg-exec conn "INSERT INTO pg_trigger_table VALUES (1, 2)")
    (pg-exec conn "INSERT INTO pg_trigger_table VALUES (3, 4)")
    (pg-exec conn "DROP TABLE pg_trigger_table")))


(defun test ()
  (let (#+nil(*pg-client-encoding* "UTF8"))
    (with-test-connection (conn)
      (format t "Running pg.lisp tests against backend ~a~%" (pg-backend-version conn))
      ;; client encoding supported since PostgreSQL v7.1
      (format t "Client encoding is ~A~%" (pg-client-encoding conn))
      (format t "Date style is ~A~%" (pg-date-style conn))
      (let ((r2 (pg-exec conn "CREATE TABLE pgltest (a int, b float, c numeric)"))
            (r3 (pg-exec conn "INSERT INTO pgltest VALUES (3, -1234.5e67, 123.45)"))
            (r4 (pg-exec conn "DROP TABLE pgltest")))
        (format t "~%==============================================~%")
        (format t "status of CREATE is ~s~%" (pg-result r2 :status))
        (format t "status of INSERT is ~s~%" (pg-result r3 :status))
        (format t "oid of INSERT is ~s~%" (pg-result r3 :oid))
        (format t "status of DROP is ~s~%" (pg-result r4 :status))
        (format t "==============================================~%")))
    (test-simple)
    (test-insert)
    (test-insert/float)
    (test-insert/numeric)
    (test-date)
    (test-booleans)
    (test-integer-overflow)
    (test-strings)
    (test-integrity)
    (test-error-handling)
    (test-transactions)
    (test-arrays)
    (test-bit-tables)
    (test-notifications)
    (test-lo)
    (test-lo-read)
    #+cmu (test-lo-import)
    (test-pbe)
    (test-pbe-text)
    #+unix
    (test-copy-in-out)
    (values)))


;; EOF