src/rofl-test.lisp

   1 (in-package :lol-test)
   2
   3 ;;;; CREATE USER rofl_test PASSWORD 'rofl_test';
   4 ;;;; CREATE DATABASE rofl_test OWNER rofl_test;
   5
   6
   7 (defmacro db (&body body)
   8  `(postmodern:with-connection '("rofl_test" "rofl_test" "rofl_test" "localhost")
   9     ,@body))
  10
  11 (deftest test-create-table ()
  12   (finishes (db
  13     (postmodern:query (:DROP-TABLE 'rofl_test_base))
  14
  15     (postmodern:query (:CREATE-TABLE rofl_test_base
  16                        ((rofl_test_base_id :type SERIAL :primary-key t)
  17                         (test_string :type string)
  18                         (test_integer :type integer)))))))
  19
  20 (deftest test-simple-insert ()
  21   (test-create-table)
  22   (let ((plist '(test-string "Test Entry" test-integer 1)))
  23     (finishes (db
  24                 (postmodern:execute
  25                  (postmodern:sql-compile  `(:insert-into rofl-test-base :set ,@plist)))))))
  26
  27 (deftest test-rofl-select ()
  28   (test-simple-insert)
  29   (db
  30   (finishes
  31     (let* ((result (first (select '* :from 'rofl-test-base))))
  32       (is (equalp '(:ROFL-TEST-BASE-ID 1 :TEST-STRING "Test Entry" :TEST-INTEGER 1) result))))))
  33
  34 (deftest test-rofl-select-only-1 ()
  35   (test-simple-insert)
  36   (db
  37   (finishes
  38     (let* ((result (select-only 1 '* :from 'rofl-test-base)))
  39       (is (equalp '(:ROFL-TEST-BASE-ID 1 :TEST-STRING "Test Entry" :TEST-INTEGER 1) result))))))
  40
  41 (deftest test-rofl-insert ()
  42   (test-create-table)
  43   (db
  44     (finishes (insert-into 'rofl-test-base :test-integer 2 :test-string "a"))
  45     (finishes (insert-into 'rofl-test-base :test-integer 3 :test-string "b"))
  46     (finishes (insert-into 'rofl-test-base :test-integer 4 :test-string "c"))
  47
  48     (let ((r (select '* :from 'rofl-test-base)))
  49       (is (equal 3 (length r))))))
  50
  51 (deftest test-rofl-class-creation ()
  52   (finishes (eval '(progn
  53                     (setf (find-class 'rofl-test-base) nil)
  54                     (defclass rofl-test-base ()
  55                       ((rofl-test-base-id :primary-key t)
  56                        test-integer test-string)
  57                       (:metaclass standard-db-access-class))))))
  58
  59
  60 (deftest test-rofl-make-object-from-plist ()
  61   (test-rofl-class-creation)
  62   (let* ((plist '(:ROFL-TEST-BASE-ID 1 :TEST-STRING "a" :TEST-INTEGER 2))
  63          (object (make-object-from-plist 'rofl-test-base plist)))
  64     (is (equal (slot-value object 'rofl-test-base-id) 1))))
  65
  66
  67 (deftest test-rofl-select-objects ()
  68   (test-create-table)
  69   (test-rofl-class-creation)
  70   (test-rofl-insert)
  71
  72   (db (finishes
  73     (let ((objects (select-objects 'rofl-test-base
  74                                  :where '(:= rofl-test-base-id 1))))
  75       (is (equal (slot-value (first objects) 'rofl-test-base-id) 1))))))
  76
  77 (deftest test-rofl-create-references-tables ()
  78   (finishes
  79     (db
  80       (ignore-errors (postmodern:query (:DROP-TABLE 'rofl_test_child)))
  81       (ignore-errors (postmodern:query (:DROP-TABLE 'rofl_test_parent)))
  82
  83       (postmodern:query (:CREATE-TABLE rofl_test_parent
  84                                        ((rofl_test_parent_id
  85                                          :type SERIAL
  86                                          :primary-key t)
  87                                         (test_string
  88                                          :type string)
  89                                                 (test_integer
  90                                                  :type integer))))
  91
  92
  93
  94               (postmodern:query (:CREATE-TABLE rofl_test_child
  95                                                ((rofl_test_child_id
  96                                                  :type SERIAL
  97                                                  :primary-key t)
  98                                                 (rofl_test_parent_id
  99                                                  :type integer
 100                                                  :references (rofl_test_parent))
 101                                                 (test_string
 102                                                  :type string)
 103                                                 (test_integer
 104                                                  :type integer)))))))
 105
 106 (deftest test-rofl-def-references-classes ()
 107   (finishes
 108     (eval
 109      '(progn
 110        (defclass rofl-test-parent ()
 111          ((rofl-test-parent-id
 112           :primary-key t)
 113           (test-string)
 114           (test-integer))
 115          (:metaclass standard-db-access-class))
 116
 117        ;;; three ways to get to the parent.
 118        ;;; The should all point to the same object.
 119
 120        (defclass rofl-test-child ()
 121          ((rofl-test-child-id
 122           :primary-key t)
 123           (rofl-test-parent-id
 124            :references rofl-test-parent)
 125           (parent :column rofl-test-parent-id
 126                   :references rofl-test-parent)
 127           (same-parent :column rofl-test-parent-id
 128                        :references (rofl-test-parent .
 129                                     rofl-test-parent-id))
 130
 131           (test-string)
 132           (test-integer))
 133          (:metaclass standard-db-access-class))))))
 134
 135 (deftest test-rofl-foreign-references ()
 136   (test-rofl-create-references-tables)
 137   (test-rofl-def-references-classes)
 138   (db
 139   (finishes
 140     (insert-into 'rofl-test-parent :test-string "Parent" :test-integer 1)
 141     (insert-into 'rofl-test-child :test-string "Child 1" :test-integer 1
 142                  :rofl-test-parent-id
 143                  (slot-value (first (select-objects 'rofl-test-parent)) 'rofl-test-parent-id)))
 144   (let* ((child (select-only-n-objects 1 'rofl-test-child))
 145          (parent-same-slot-name/fkey (slot-value child 'rofl-test-parent-id))
 146          (parent-column-same-fkey (slot-value child 'parent))
 147          (parent-column-table-and-key (slot-value child 'same-parent)))
 148
 149     (is (eql 1 (slot-value child 'test-integer)))
 150
 151     (is (equal 1 (slot-value parent-same-slot-name/fkey 'test-integer)))
 152     (is (equal 1 (slot-value parent-column-same-fkey 'test-integer)))
 153     (is (equal 1 (slot-value parent-column-table-and-key 'test-integer))))))
 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