postmodern/tests.lisp

   1 (defpackage :postmodern-tests
   2   (:use :common-lisp :fiveam :postmodern :simple-date :cl-postgres-tests))
   3
   4 (in-package :postmodern-tests)
   5
   6 ;; Adjust the above to some db/user/pass/host combination that refers
   7 ;; to a valid postgresql database in which no table named test_data
   8 ;; currently exists. Then after loading the file, run the tests with
   9 ;; (fiveam:run! :postmodern)
  10
  11 (def-suite :postmodern)
  12 (in-suite :postmodern)
  13
  14 (defmacro with-test-connection (&body body)
  15   `(with-connection *test-connection* ,@body))
  16
  17 (defmacro protect (&body body)
  18   `(unwind-protect (progn ,@(butlast body)) ,(car (last body))))
  19
  20 (test connect-sanely
  21   (with-test-connection
  22     (is (not (null *database*)))))
  23
  24 (test connection-pool
  25   (let ((pooled (apply 'connect (append *test-connection* '(:pooled-p t)))))
  26     (disconnect pooled)
  27     (let ((pooled* (apply 'connect (append *test-connection* '(:pooled-p t)))))
  28       (is (eq pooled pooled*))
  29       (disconnect pooled*))
  30     (clear-connection-pool)
  31     (let ((pooled* (apply 'connect (append *test-connection* '(:pooled-p t)))))
  32       (is (not (eq pooled pooled*)))
  33       (disconnect pooled*))
  34     (clear-connection-pool)))
  35
  36 (test reconnect
  37   (with-test-connection
  38     (disconnect *database*)
  39     (is (not (connected-p *database*)))
  40     (reconnect *database*)
  41     (is (connected-p *database*))))
  42
  43 (test simple-query
  44   (with-test-connection
  45     (destructuring-bind (a b c d e f)
  46         (query (:select 22 (:type 44.5 double-precision) "abcde" t (:type 9/2 (numeric 5 2))
  47                         (:[] #("A" "B") 2)) :row)
  48       (is (eql a 22))
  49       (is (eql b 44.5d0))
  50       (is (string= c "abcde"))
  51       (is (eql d t))
  52       (is (eql e 9/2))
  53       (is (equal f "B")))))
  54
  55 (test reserved-words
  56   (with-test-connection
  57     (is (= (query (:select '* :from (:as (:select (:as 1 'as)) 'where) :where (:= 'where.as 1)) :single!) 1))))
  58
  59 (test time-types
  60   (with-test-connection
  61     (is (time= (query (:select (:type (encode-date 1980 2 1) date)) :single)
  62                (encode-date 1980 2 1)))
  63     (is (time= (query (:select (:type (encode-timestamp 2040 3 19 12 15 0 2) timestamp)) :single)
  64                (encode-timestamp 2040 3 19 12 15 0 2)))
  65     (is (time= (query (:select (:type (encode-interval :month -1 :hour 24) interval)) :single)
  66                (encode-interval :month -1 :hour 24)))))
  67
  68 (test table
  69   (with-test-connection
  70     (execute (:create-table test-data ((a :type integer :primary-key t) (b :type real) (c :type (or text db-null))) (:unique c)))
  71     (protect
  72       (is (table-exists-p 'test-data))
  73       (execute (:insert-into 'test-data :set 'a 1 'b 5.4 'c "foobar"))
  74       (execute (:insert-into 'test-data :set 'a 2 'b 88 'c :null))
  75       (is (equal (query (:order-by (:select '* :from 'test-data) 'a))
  76                  '((1 5.4 "foobar")
  77                    (2 88.0 :null))))
  78       (execute (:drop-table 'test-data)))
  79     (is (not (table-exists-p 'test-data)))))
  80
  81 (test sequence
  82   (with-test-connection
  83     (execute (:create-sequence 'my-seq :increment 4 :start 10))
  84     (protect
  85       (is (sequence-exists-p 'my-seq))
  86       (is (= (sequence-next 'my-seq) 10))
  87       (is (= (sequence-next 'my-seq) 14))
  88       (execute (:drop-sequence 'my-seq)))
  89     (is (not (sequence-exists-p 'my-seq)))))
  90
  91 (test prepare
  92   (with-test-connection
  93     (let ((select-int (prepare (:select (:type '$1 integer)) :single))
  94           (byte-arr (make-array 10 :element-type '(unsigned-byte 8) :initial-element 10))
  95           (select-bytes (prepare (:select (:type '$1 bytea)) :single)))
  96       (is (= (funcall select-int 10) 10))
  97       (is (= (funcall select-int -40) -40))
  98       (is (eq (funcall select-int :null) :null))
  99       (is (equalp (funcall select-bytes byte-arr) byte-arr)))))
 100
 101 (test doquery
 102   (with-test-connection
 103     (doquery (:select 55 "foobar") (number string)
 104       (is (= number 55))
 105       (is (string= string "foobar")))))
 106
 107 (test doquery-params
 108   (with-test-connection
 109     (doquery ("select $1::integer + 10" 20) (answer)
 110        (is (= answer 30)))))
 111
 112 (test transaction
 113   (with-test-connection
 114     (execute (:create-table test-data ((value :type integer))))
 115     (protect
 116       (ignore-errors
 117         (with-transaction ()
 118           (execute (:insert-into 'test-data :set 'value 2))
 119           (error "no wait")))
 120       (is (= 0 (length (query (:select '* :from 'test-data)))))
 121       (ignore-errors
 122         (with-transaction (transaction)
 123           (execute (:insert-into 'test-data :set 'value 2))
 124           (commit-transaction transaction)
 125           (error "no wait!!")))
 126       (is (= 1 (length (query (:select '* :from 'test-data)))))
 127       (with-transaction (transaction)
 128         (execute (:insert-into 'test-data :set 'value 44))
 129         (abort-transaction transaction))
 130       (is (= 1 (length (query (:select '* :from 'test-data)))))
 131       (execute (:drop-table 'test-data)))))
 132
 133 (test logical-transaction
 134   (with-test-connection
 135     (protect
 136       (execute (:create-table test-data ((value :type integer))))
 137       (with-logical-transaction ()
 138         (execute (:insert-into 'test-data :set 'value 1))
 139         (ignore-errors
 140           (with-logical-transaction ()
 141             (execute (:insert-into 'test-data :set 'value 2))
 142             (error "fail here"))))
 143       (is-true (query (:select '* :from 'test-data :where (:= 'value 1))))
 144       (is-false (query (:select '* :from 'test-data :where (:= 'value 2))))
 145       (execute (:drop-table 'test-data)))))
 146
 147 (test transaction-commit-hooks
 148   (with-test-connection
 149     (protect
 150       (execute (:create-table test-data ((value :type integer))))
 151       (with-logical-transaction (transaction-1)
 152         (execute (:insert-into 'test-data :set 'value 1))
 153         (with-logical-transaction (transaction-2)
 154           (push (lambda () (execute (:insert-into 'test-data :set 'value 3))) (commit-hooks transaction-2))
 155           (push (lambda () (execute (:insert-into 'test-data :set 'value 4))) (commit-hooks transaction-1))
 156           (execute (:insert-into 'test-data :set 'value 2))))
 157       (is (= 4 (length (query (:select '* :from 'test-data)))))
 158       (execute (:drop-table 'test-data)))))
 159
 160 (test transaction-abort-hooks
 161   (with-test-connection
 162     (protect
 163       (execute (:create-table test-data ((value :type integer))))
 164       (with-logical-transaction (transaction-1)
 165         (execute (:insert-into 'test-data :set 'value 1))
 166         (ignore-errors
 167           (with-logical-transaction (transaction-2)
 168             (push (lambda () (execute (:insert-into 'test-data :set 'value 3))) (abort-hooks transaction-2))
 169             (push (lambda () (execute (:insert-into 'test-data :set 'value 4))) (abort-hooks transaction-1))
 170             (error "no wait")
 171             (execute (:insert-into 'test-data :set 'value 2)))))
 172       (is (= 2 (length (query (:select '* :from 'test-data)))))
 173       (execute (:drop-table 'test-data)))))
 174
 175 (test ensure-transaction
 176   (with-test-connection
 177     (with-transaction ()
 178       (ensure-transaction
 179         (is (eql postmodern::*transaction-level* 1))))
 180     (is (eql postmodern::*transaction-level* 0))
 181     (ensure-transaction
 182       (is (eql postmodern::*transaction-level* 1)))))
 183
 184 (defclass test-data ()
 185   ((id :col-type serial :initarg :id :accessor test-id)
 186    (a :col-type (or (varchar 100) db-null) :initarg :a :accessor test-a)
 187    (b :col-type boolean :col-default nil :initarg :b :accessor test-b))
 188   (:metaclass dao-class)
 189   (:table-name dao-test)
 190   (:keys id))
 191
 192 (test dao-class
 193   (with-test-connection
 194     (execute (dao-table-definition 'test-data))
 195     (protect
 196       (is (member :dao-test (list-tables)))
 197       (is (null (get-dao 'test-data 1)))
 198       (let ((dao (make-instance 'test-data :a "quux")))
 199         (insert-dao dao)
 200         (is (eql (test-id dao) 1))
 201         (is (dao-exists-p dao)))
 202       (let ((dao (get-dao 'test-data 1)))
 203         (is (not (null dao)))
 204         (setf (test-b dao) t)
 205         (update-dao dao))
 206       (let ((dao (get-dao 'test-data 1)))
 207         (is (not (null dao)))
 208         (is (string= (test-a dao) "quux"))
 209         (is (eq (test-b dao) t))
 210         (delete-dao dao))
 211       (is (not (select-dao 'test-data)))
 212       (execute (:drop-table 'dao-test)))))
 213
 214 (test save-dao
 215   (with-test-connection
 216     (execute (dao-table-definition 'test-data))
 217     (protect
 218       (let ((dao (make-instance 'test-data :a "quux")))
 219         (is (save-dao dao))
 220         (setf (test-a dao) "bar")
 221         (is (not (save-dao dao)))
 222         (is (equal (test-a (get-dao 'test-data (test-id dao))) "bar"))
 223         (signals database-error
 224           (with-transaction () (save-dao dao)))
 225         (with-transaction ()
 226           (is (not (save-dao/transaction dao)))))
 227       (execute (:drop-table 'dao-test)))))
 228
 229 (defclass test-oid ()
 230   ((oid :col-type integer :ghost t :accessor test-oid)
 231    (a :col-type string :initarg :a :accessor test-a)
 232    (b :col-type string :initarg :b :accessor test-b))
 233   (:metaclass dao-class)
 234   (:keys a))
 235
 236 (test dao-class-oid
 237   (with-test-connection
 238     (execute (concatenate 'string (dao-table-definition 'test-oid) "with (oids=true)"))
 239     (protect
 240       (let ((dao (make-instance 'test-oid :a "a" :b "b")))
 241         (insert-dao dao)
 242         (is-true (integerp (test-oid dao)))
 243         (let ((back (get-dao 'test-oid "a")))
 244           (is (test-oid dao) (test-oid back))
 245           (setf (test-b back) "c")
 246           (update-dao back))
 247         (is (test-b (get-dao 'test-oid "a")) "c"))
 248       (execute (:drop-table 'test-oid)))))
 249
 250 (test notification
 251   (with-test-connection
 252     (execute (:listen 'foo))
 253     (with-test-connection
 254       (execute (:notify 'foo)))
 255     (is (cl-postgres:wait-for-notification *database*) "foo")))
 256
 257 (defclass test-col-name ()
 258   ((a :col-type string :col-name aa :initarg :a :accessor test-a)
 259    (b :col-type string :col-name bb :initarg :b :accessor test-b)
 260    (c :col-type string              :initarg :c :accessor test-c))
 261   (:metaclass dao-class)
 262   (:keys a))
 263
 264 (test dao-class-col-name
 265   (with-test-connection
 266     (execute "CREATE TEMPORARY TABLE test_col_name (aa text primary key,  bb text not null, c text not null)")
 267     (let ((o (make-instance 'test-col-name :a "1" :b "2" :c "3")))
 268       (save-dao o)
 269       (let ((oo (get-dao 'test-col-name "1")))
 270         (is (string= "1" (test-a oo)))
 271         (is (string= "2" (test-b oo)))
 272         (is (string= "3" (test-c oo)))))
 273     (let ((o (get-dao 'test-col-name "1")))
 274       (setf (test-b o) "b")
 275       (update-dao o))
 276     (is (string= "1" (test-a (get-dao 'test-col-name "1"))))
 277     (is (string= "b" (test-b (get-dao 'test-col-name "1"))))
 278     (is (string= "3" (test-c (get-dao 'test-col-name "1"))))))
 279
 280 ;; create two tables with the same name in two different
 281 ;; namespaces.
 282 (test namespace
 283   (with-test-connection
 284     (is (not (table-exists-p 'test-uniq)))
 285     (execute (:create-table test-uniq ((value :type integer))))
 286     (is (table-exists-p 'test-uniq))
 287     (is (not (schema-exist-p 'uniq)))
 288     (with-schema ('uniq :if-not-exist :create)
 289       (is (schema-exist-p 'uniq))
 290       (is (not (table-exists-p 'test-uniq)))
 291       (execute (:create-table test-uniq ((value :type integer))))
 292       (is (table-exists-p 'test-uniq))
 293       (execute (:drop-table 'test-uniq)))
 294     (is (schema-exist-p 'uniq))
 295     (drop-schema 'uniq)
 296     (is (not (schema-exist-p 'uniq)))
 297     (execute (:drop-table 'test-uniq))))
 298
 299 (test arrays
 300   (with-test-connection
 301     (execute (:create-table test-data ((a :type integer[]))))
 302     (protect
 303       (is (table-exists-p 'test-data))
 304       (execute (:insert-into 'test-data :set 'a (vector 3 4 5)))
 305       (execute (:insert-into 'test-data :set 'a #()))
 306       (execute (:drop-table 'test-data)))
 307     (is (not (table-exists-p 'test-data)))))