tests/test-oodml.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; ======================================================================
   3 ;;;; File:    test-oodml.lisp
   4 ;;;; Author:  Marcus Pearce <m.t.pearce@city.ac.uk>
   5 ;;;; Created: 01/04/2004
   6 ;;;;
   7 ;;;; Tests for the CLSQL Object Oriented Data Definition Language
   8 ;;;; (OODML).
   9 ;;;;
  10 ;;;; This file is part of CLSQL.
  11 ;;;;
  12 ;;;; CLSQL users are granted the rights to distribute and use this software
  13 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
  14 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
  15 ;;;; ======================================================================
  16
  17 (in-package #:clsql-tests)
  18
  19 #.(clsql:locally-enable-sql-reader-syntax)
  20
  21 (setq *rt-oodml*
  22       '(
  23
  24 (deftest :oodml/select/1
  25     (with-dataset *ds-employees*
  26       (mapcar #'(lambda (e) (slot-value e 'last-name))
  27               (clsql:select 'employee :order-by [last-name] :flatp t :caching nil)))
  28   ("Andropov" "Brezhnev" "Chernenko" "Gorbachev" "Kruschev" "Lenin" "Putin"
  29               "Stalin" "Trotsky" "Yeltsin"))
  30
  31 (deftest :oodml/select/2
  32     (with-dataset *ds-employees*
  33       (mapcar #'(lambda (e) (slot-value e 'name))
  34               (clsql:select 'company :flatp t :caching nil)))
  35   ("Widgets Inc."))
  36
  37 (deftest :oodml/select/3
  38     (with-dataset *ds-employees*
  39       (mapcar #'(lambda (e) (slot-value e 'ecompanyid))
  40               (clsql:select 'employee
  41                             :where [and [= [slot-value 'employee 'ecompanyid]
  42                                            [slot-value 'company 'companyid]]
  43                                         [= [slot-value 'company 'name]
  44                                            "Widgets Inc."]]
  45                             :flatp t
  46                             :caching nil)))
  47   (1 1 1 1 1 1 1 1 1 1))
  48
  49 (deftest :oodml/select/4
  50     (with-dataset *ds-employees*
  51       (mapcar #'(lambda (e)
  52                   (concatenate 'string (slot-value e 'first-name)
  53                                " "
  54                                (slot-value e 'last-name)))
  55               (clsql:select 'employee :where [= [slot-value 'employee 'first-name]
  56                                                 "Vladimir"]
  57                             :flatp t
  58                             :order-by [last-name]
  59                             :caching nil)))
  60   ("Vladimir Lenin" "Vladimir Putin"))
  61
  62 (deftest :oodml/select/5
  63     (with-dataset *ds-employees*
  64       (length (clsql:select 'employee :where [married] :flatp t :caching nil)))
  65   3)
  66
  67 (deftest :oodml/select/6
  68     (with-dataset *ds-employees*
  69       (let ((a (caar (clsql:select 'address :where [= 1 [addressid]] :caching nil))))
  70         (values
  71           (slot-value a 'street-number)
  72           (slot-value a 'street-name)
  73           (slot-value a 'city)
  74           (slot-value a 'postal-code))))
  75   10 "Park Place" "Leningrad" 123)
  76
  77 (deftest :oodml/select/7
  78     (with-dataset *ds-employees*
  79       (let ((a (caar (clsql:select 'address :where [= 2 [addressid]] :caching nil))))
  80         (values
  81           (slot-value a 'street-number)
  82           (slot-value a 'street-name)
  83           (slot-value a 'city)
  84           (slot-value a 'postal-code))))
  85   nil "" "no city" 0)
  86
  87 (deftest :oodml/select/8
  88     (with-dataset *ds-employees*
  89       (mapcar #'(lambda (e) (slot-value e 'married))
  90               (clsql:select 'employee :flatp t :order-by [emplid] :caching nil)))
  91   (t t t nil nil nil nil nil nil nil))
  92
  93 (deftest :oodml/select/9
  94     (with-dataset *ds-employees*
  95       (mapcar #'(lambda (pair)
  96                   (list
  97                    (typep (car pair) 'address)
  98                    (typep (second pair) 'employee-address)
  99                    (slot-value (car pair) 'addressid)
 100                    (slot-value (second pair) 'aaddressid)
 101                    (slot-value (second pair) 'aemplid)))
 102               (employee-addresses employee1)))
 103   ((t t 1 1 1) (t t 2 2 1)))
 104
 105 (deftest :oodml/select/10
 106     (with-dataset *ds-employees*
 107       (mapcar #'(lambda (pair)
 108                   (list
 109                    (typep (car pair) 'address)
 110                    (typep (second pair) 'employee-address)
 111                    (slot-value (car pair) 'addressid)
 112                    (slot-value (second pair) 'aaddressid)
 113                    (slot-value (second pair) 'aemplid)))
 114               (employee-addresses employee2)))
 115   ((t t 2 2 2)))
 116
 117 (deftest :oodml/select/11
 118     (with-dataset *ds-employees*
 119       (values (mapcar #'(lambda (x) (slot-value x 'emplid))
 120                       (clsql:select 'employee :order-by '(([emplid] :asc))
 121                                     :flatp t))
 122               (mapcar #'(lambda (x) (slot-value x 'emplid))
 123                       (clsql:select 'employee :order-by '(([emplid] :desc))
 124                                     :flatp t))))
 125   (1 2 3 4 5 6 7 8 9 10)
 126   (10 9 8 7 6 5 4 3 2 1))
 127
 128 ;; test retrieval of node, derived nodes etc
 129 (deftest :oodml/select/12
 130     (with-dataset *ds-nodes*
 131       (length (clsql:select 'node :where [node-id] :flatp t :caching nil)))
 132   11)
 133
 134 (deftest :oodml/select/13
 135     (with-dataset *ds-nodes*
 136       (let ((a (car (clsql:select 'node :where [= 1 [node-id]] :flatp t :caching nil))))
 137         (values
 138           (slot-value a 'node-id)
 139           (slot-value a 'title))))
 140   1 "Bare node")
 141
 142 (deftest :oodml/select/14
 143     (with-dataset *ds-nodes*
 144       (length (clsql:select 'setting :where [setting-id] :flatp t :caching nil)))
 145   4)
 146
 147 (deftest :oodml/select/15
 148     (with-dataset *ds-nodes*
 149       (let ((a (car (clsql:select 'setting :where [= 3 [setting-id]] :flatp t :caching nil))))
 150         (values
 151           (slot-value a 'node-id)
 152           (slot-value a 'setting-id)
 153           (slot-value a 'title)
 154           (slot-value a 'vars))))
 155   3 3 "Setting2" "var 2")
 156
 157 (deftest :oodml/select/16
 158     (with-dataset *ds-nodes*
 159       (length (clsql:select 'user :where [user-id] :flatp t :caching nil)))
 160   2)
 161
 162 (deftest :oodml/select/17
 163     (with-dataset *ds-nodes*
 164       (let ((a (car (clsql:select 'user :where [= 4 [user-id]] :flatp t :caching nil))))
 165         (values
 166           (slot-value a 'node-id)
 167           (slot-value a 'user-id)
 168           (slot-value a 'title)
 169           (slot-value a 'nick))))
 170   4 4 "user-1" "first user")
 171
 172 (deftest :oodml/select/18
 173     (with-dataset *ds-nodes*
 174       (length (clsql:select 'theme :where [theme-id] :flatp t :caching nil)))
 175   2)
 176
 177 (deftest :oodml/select/19
 178     (with-dataset *ds-nodes*
 179       (let ((a (car (clsql:select 'theme :where [= 6 [theme-id]] :flatp t :caching nil))))
 180         (slot-value a 'theme-id)))
 181   6)
 182
 183 (deftest :oodml/select/20
 184     (with-dataset *ds-nodes*
 185       (let ((a (car (clsql:select 'theme :where [= 7 [theme-id]] :flatp t :caching nil))))
 186         (values
 187           (slot-value a 'node-id)
 188           (slot-value a 'theme-id)
 189           (slot-value a 'title)
 190           (slot-value a 'vars)
 191           (slot-value a 'doc)
 192           )))
 193   7 7 "theme-2"
 194   nil "second theme")
 195
 196 ;; Some tests to check weird subclassed nodes (node without own table, or subclassed of same)
 197 (deftest :oodml/select/21
 198     (with-dataset *ds-nodes*
 199       (let ((a (car (clsql:select 'location :where [= [title] "location-1"] :flatp t :caching nil))))
 200         (values
 201           (slot-value a 'node-id)
 202           (slot-value a 'title))))
 203   8 "location-1")
 204
 205 (deftest :oodml/select/22
 206     (with-dataset *ds-nodes*
 207       (let ((a (car (clsql:select 'subloc :where [subloc-id] :flatp t :caching nil))))
 208         (values
 209           (slot-value a 'node-id)
 210           (slot-value a 'subloc-id)
 211           (slot-value a 'title)
 212           (slot-value a 'loc))))
 213   10 10 "subloc-1" "a subloc")
 214
 215 ;; test retrieval is deferred
 216 (deftest :oodm/retrieval/1
 217     (with-dataset *ds-employees*
 218       (every #'(lambda (e) (not (slot-boundp e 'company)))
 219              (select 'employee :flatp t :caching nil)))
 220   t)
 221
 222 (deftest :oodm/retrieval/2
 223     (with-dataset *ds-employees*
 224       (every #'(lambda (e) (not (slot-boundp e 'address)))
 225              (select 'deferred-employee-address :flatp t :caching nil)))
 226   t)
 227
 228 ;; :retrieval :immediate should be boundp before accessed
 229 (deftest :oodm/retrieval/3
 230     (with-dataset *ds-employees*
 231       (every #'(lambda (ea) (slot-boundp ea 'address))
 232              (select 'employee-address :flatp t :caching nil)))
 233   t)
 234
 235 (deftest :oodm/retrieval/4
 236     (with-dataset *ds-employees*
 237       (mapcar #'(lambda (ea) (typep (slot-value ea 'address) 'address))
 238               (select 'employee-address :flatp t :caching nil)))
 239   (t t t t t))
 240
 241 (deftest :oodm/retrieval/5
 242     (with-dataset *ds-employees*
 243       (mapcar #'(lambda (ea) (typep (slot-value ea 'address) 'address))
 244               (select 'deferred-employee-address :flatp t :caching nil)))
 245   (t t t t t))
 246
 247 (deftest :oodm/retrieval/6
 248     (with-dataset *ds-employees*
 249       (every #'(lambda (ea) (slot-boundp (slot-value ea 'address) 'addressid))
 250              (select 'employee-address :flatp t :caching nil)))
 251   t)
 252
 253 (deftest :oodm/retrieval/7
 254     (with-dataset *ds-employees*
 255       (every #'(lambda (ea) (slot-boundp (slot-value ea 'address) 'addressid))
 256              (select 'deferred-employee-address :flatp t :caching nil)))
 257   t)
 258
 259 (deftest :oodm/retrieval/8
 260     (with-dataset *ds-employees*
 261       (mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number))
 262               (select 'employee-address :flatp t :order-by [aaddressid] :caching nil)))
 263   (10 10 nil nil nil))
 264
 265 (deftest :oodm/retrieval/9
 266     (with-dataset *ds-employees*
 267       (mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number))
 268               (select 'deferred-employee-address :flatp t :order-by [aaddressid] :caching nil)))
 269   (10 10 nil nil nil))
 270
 271 ;; tests update-records-from-instance
 272 (deftest :oodml/update-records/1
 273     (with-dataset *ds-employees*
 274       (values
 275         (progn
 276           (let ((lenin (car (clsql:select 'employee
 277                                           :where [= 1 [slot-value 'employee 'emplid]]
 278                                           :flatp t
 279                                           :caching nil))))
 280             (format nil "~a ~a: ~a"
 281                 (first-name lenin)
 282                 (last-name lenin)
 283                 (employee-email lenin))))
 284         (progn
 285           (setf (slot-value employee1 'first-name) "Dimitriy"
 286                 (slot-value employee1 'last-name) "Ivanovich"
 287                 (slot-value employee1 'email) "ivanovich@soviet.org")
 288           (clsql:update-records-from-instance employee1)
 289           (let ((lenin (car (clsql:select 'employee
 290                                           :where [= 1 [slot-value 'employee 'emplid]]
 291                                           :flatp t
 292                                           :caching nil))))
 293             (format nil "~a ~a: ~a"
 294                 (first-name lenin)
 295                 (last-name lenin)
 296                 (employee-email lenin))))))
 297   "Vladimir Lenin: lenin@soviet.org"
 298   "Dimitriy Ivanovich: ivanovich@soviet.org")
 299
 300 ;; tests update-record-from-slot
 301 (deftest :oodml/update-records/2
 302     (with-dataset *ds-employees*
 303       (values
 304         (employee-email
 305          (car (clsql:select 'employee
 306                             :where [= 1 [slot-value 'employee 'emplid]]
 307                             :flatp t
 308                             :caching nil)))
 309         (progn
 310           (setf (slot-value employee1 'email) "lenin-nospam@soviet.org")
 311           (clsql:update-record-from-slot employee1 'email)
 312           (employee-email
 313            (car (clsql:select 'employee
 314                               :where [= 1 [slot-value 'employee 'emplid]]
 315                               :flatp t
 316                               :caching nil))))))
 317   "lenin@soviet.org" "lenin-nospam@soviet.org")
 318
 319 ;; tests update-record-from-slots
 320 (deftest :oodml/update-records/3
 321     (with-dataset *ds-employees*
 322       (values
 323         (let ((lenin (car (clsql:select 'employee
 324                                         :where [= 1 [slot-value 'employee 'emplid]]
 325                                         :flatp t
 326                                         :caching nil))))
 327           (format nil "~a ~a: ~a"
 328                   (first-name lenin)
 329                   (last-name lenin)
 330                   (employee-email lenin)))
 331         (progn
 332           (setf (slot-value employee1 'first-name) "Dimitriy"
 333                 (slot-value employee1 'last-name) "Ivanovich"
 334                 (slot-value employee1 'email) "ivanovich@soviet.org")
 335           (clsql:update-record-from-slots employee1 '(first-name last-name email))
 336           (let ((lenin (car (clsql:select 'employee
 337                                           :where [= 1 [slot-value 'employee 'emplid]]
 338                                           :flatp t
 339                                           :caching nil))))
 340             (format nil "~a ~a: ~a"
 341                     (first-name lenin)
 342                     (last-name lenin)
 343                     (employee-email lenin))))))
 344   "Vladimir Lenin: lenin@soviet.org"
 345   "Dimitriy Ivanovich: ivanovich@soviet.org")
 346
 347 (deftest :oodml/update-records/4
 348     (with-dataset *ds-nodes*
 349       (flet ((print-fresh-node ()
 350                (let ((base (car (clsql:select 'node
 351                                               :where [= 1 [slot-value 'node 'node-id]]
 352                                               :flatp t :caching nil))))
 353                  (format nil "~a ~a"
 354                          (slot-value base 'node-id)
 355                          (slot-value base 'title)))))
 356         (values
 357           (print-fresh-node)
 358           (let ((base (car (clsql:select 'node
 359                                          :where [= 1 [slot-value 'node 'node-id]]
 360                                          :flatp t :caching nil))))
 361             (setf (slot-value base 'title) "Altered title")
 362             (clsql:update-records-from-instance base)
 363             (print-fresh-node)))))
 364   "1 Bare node"
 365   "1 Altered title")
 366
 367 (deftest :oodml/update-records/4-slots ;just like 4, but use slots fns.
 368     (with-dataset *ds-nodes*
 369       (flet ((print-fresh-setting ()
 370                (let ((node (car (clsql:select 'setting
 371                                               :where [= 3 [slot-value 'setting 'setting-id]]
 372                                               :flatp t :caching nil))))
 373                  (format nil "~a ~a ~a"
 374                          (slot-value node 'setting-id)
 375                          (slot-value node 'title)
 376                          (slot-value node 'vars)))))
 377         (values
 378           (print-fresh-setting)
 379           (let ((node (car (clsql:select 'setting
 380                                          :where [= 3 [slot-value 'setting 'setting-id]]
 381                                          :flatp t :caching nil))))
 382             (setf (slot-value node 'title) "Altered title")
 383             (setf (slot-value node 'vars) "Altered vars")
 384             (clsql-sys:update-record-from-slot node 'title)
 385             (clsql-sys:update-record-from-slot node 'vars)
 386             (print-fresh-setting))
 387           (let ((node (car (clsql:select 'setting
 388                                          :where [= 3 [slot-value 'setting 'setting-id]]
 389                                          :flatp t :caching nil))))
 390             (setf (slot-value node 'title) "Setting2")
 391             (setf (slot-value node 'vars) "var 2")
 392             (clsql:update-records-from-instance node)
 393             (clsql-sys:update-record-from-slots node '(vars title))
 394             (print-fresh-setting)))))
 395   "3 Setting2 var 2"
 396   "3 Altered title Altered vars"
 397   "3 Setting2 var 2")
 398
 399 (deftest :oodml/update-records/5
 400     (with-dataset *ds-nodes*
 401       (flet ((print-fresh-setting ()
 402                (let ((node (car (clsql:select 'setting
 403                                               :where [= 3 [slot-value 'setting 'setting-id]]
 404                                               :flatp t :caching nil))))
 405                  (format nil "~a ~a ~a"
 406                          (slot-value node 'setting-id)
 407                          (slot-value node 'title)
 408                          (slot-value node 'vars)))))
 409         (values
 410           (print-fresh-setting)
 411           (let ((node (car (clsql:select 'setting
 412                                          :where [= 3 [slot-value 'setting 'setting-id]]
 413                                          :flatp t :caching nil))))
 414             (setf (slot-value node 'title) "Altered title")
 415             (setf (slot-value node 'vars) "Altered vars")
 416             (clsql:update-records-from-instance node)
 417             (print-fresh-setting)))))
 418   "3 Setting2 var 2"
 419   "3 Altered title Altered vars")
 420
 421 (deftest :oodml/update-records/5-slots
 422     (with-dataset *ds-nodes*
 423       (flet ((print-fresh-setting ()
 424                (let ((node (car (clsql:select 'setting
 425                                               :where [= 3 [slot-value 'setting 'setting-id]]
 426                                               :flatp t :caching nil))))
 427                  (format nil "~a ~a ~a"
 428                          (slot-value node 'setting-id)
 429                          (slot-value node 'title)
 430                          (slot-value node 'vars)))))
 431         (values
 432           (print-fresh-setting)
 433           (let ((node (car (clsql:select 'setting
 434                                          :where [= 3 [slot-value 'setting 'setting-id]]
 435                                          :flatp t :caching nil))))
 436             (setf (slot-value node 'title) "Altered title")
 437             (setf (slot-value node 'vars) "Altered vars")
 438             (clsql-sys:update-record-from-slot node 'title)
 439             (clsql-sys:update-record-from-slot node 'vars)
 440             (print-fresh-setting))
 441           (let ((node (car (clsql:select 'setting
 442                                          :where [= 3 [slot-value 'setting 'setting-id]]
 443                                          :flatp t :caching nil))))
 444             (setf (slot-value node 'title) "Setting2")
 445             (setf (slot-value node 'vars) "var 2")
 446             (clsql-sys:update-record-from-slots node '(title vars))
 447             (print-fresh-setting)))))
 448   "3 Setting2 var 2"
 449   "3 Altered title Altered vars"
 450   "3 Setting2 var 2")
 451
 452 (deftest :oodml/update-records/6
 453     (with-dataset *ds-nodes*
 454       (flet ((print-fresh-setting ()
 455                (let ((node (car (clsql:select 'setting
 456                                               :where [= 7 [slot-value 'setting 'setting-id]]
 457                                               :flatp t :caching nil))))
 458                  (format nil "~a ~a ~a"
 459                          (slot-value node 'setting-id)
 460                          (slot-value node 'title)
 461                          (slot-value node 'vars)))))
 462         (values
 463           (print-fresh-setting)
 464           (let ((node (car (clsql:select 'setting
 465                                          :where [= 7 [slot-value 'setting 'setting-id]]
 466                                          :flatp t :caching nil))))
 467             (setf (slot-value node 'title) "Altered title")
 468             (setf (slot-value node 'vars) "Altered vars")
 469             (clsql:update-records-from-instance node)
 470             (print-fresh-setting))
 471           (let ((node (car (clsql:select 'setting
 472                                          :where [= 7 [slot-value 'setting 'setting-id]]
 473                                          :flatp t :caching nil))))
 474             (setf (slot-value node 'title) "theme-2")
 475             (setf (slot-value node 'vars) nil)
 476             (clsql:update-records-from-instance node)
 477             (print-fresh-setting)))))
 478   "7 theme-2 NIL"
 479   "7 Altered title Altered vars"
 480   "7 theme-2 NIL")
 481
 482 (deftest :oodml/update-records/7
 483     (with-dataset *ds-nodes*
 484       (flet ((print-fresh-user ()
 485                "requery to get what the db has, and print out."
 486                (let ((node (car (clsql:select 'user
 487                                               :where [= 5 [slot-value 'user 'user-id]]
 488                                               :flatp t :caching nil))))
 489                  (format nil "~a ~a ~a"
 490                          (slot-value node 'user-id)
 491                          (slot-value node 'title)
 492                          (slot-value node 'nick)))))
 493         (values
 494           (print-fresh-user)
 495           (let ((node (car (clsql:select 'user
 496                                          :where [= 5 [slot-value 'user 'user-id]]
 497                                          :flatp t :caching nil))))
 498             (setf (slot-value node 'title) "Altered title")
 499             (setf (slot-value node 'nick) "Altered nick")
 500             (clsql:update-records-from-instance node)
 501             (print-fresh-user)))))
 502   "5 user-2 second user"
 503   "5 Altered title Altered nick")
 504
 505 (deftest :oodml/update-records/8
 506     (with-dataset *ds-nodes*
 507       (flet ((print-fresh-theme ()
 508                (let ((node (car (clsql:select 'theme
 509                                               :where [= 6 [slot-value 'theme 'theme-id]]
 510                                               :flatp t :caching nil))))
 511                  (with-slots (node-id setting-id theme-id title vars doc) node
 512                    (format nil "~a ~a ~a ~a ~a ~a"
 513                            node-id setting-id theme-id
 514                            title vars doc)))))
 515         (values
 516           (print-fresh-theme)
 517           (let ((node (car (clsql:select 'setting
 518                                          :where [= 6 [slot-value 'setting 'setting-id]]
 519                                          :flatp t :caching nil))))
 520             (setf (slot-value node 'title) "Altered title")
 521             (setf (slot-value node 'vars) nil)
 522             (clsql:update-records-from-instance node)
 523             (print-fresh-theme))
 524           (let ((node (car (clsql:select 'theme
 525                                          :where [= 6 [slot-value 'theme 'theme-id]]
 526                                          :flatp t :caching nil))))
 527             (setf (slot-value node 'title) "Altered title again")
 528             (setf (slot-value node 'doc) "altered doc")
 529             (clsql:update-records-from-instance node)
 530             (print-fresh-theme))
 531           (let ((node (car (clsql:select 'theme
 532                                          :where [= 6 [slot-value 'theme 'theme-id]]
 533                                          :flatp t :caching nil))))
 534             (setf (slot-value node 'title) "theme-1")
 535             (setf (slot-value node 'vars) "empty")
 536             (setf (slot-value node 'doc) "first theme")
 537             (clsql:update-records-from-instance node)
 538             (print-fresh-theme)))))
 539   "6 6 6 theme-1 empty first theme"
 540   "6 6 6 Altered title NIL first theme"
 541   "6 6 6 Altered title again NIL altered doc"
 542   "6 6 6 theme-1 empty first theme")
 543
 544 (deftest :oodml/update-records/9
 545     (with-dataset *ds-nodes*
 546       (flet ((print-fresh-subloc ()
 547                (let ((sl (car (clsql:select 'subloc
 548                                             :where [= 10 [slot-value 'subloc 'subloc-id]]
 549                                             :flatp t :caching nil))))
 550                  (format nil "~a ~a ~a"
 551                          (slot-value sl 'subloc-id)
 552                          (slot-value sl 'title)
 553                          (slot-value sl 'loc)))))
 554         (values
 555           (print-fresh-subloc)
 556           (let ((sl (car (clsql:select 'subloc
 557                                        :where [= 10 [slot-value 'subloc 'subloc-id]]
 558                                        :flatp t :caching nil))))
 559             (setf (slot-value sl 'title) "Altered subloc title")
 560             (setf (slot-value sl 'loc) "Altered loc")
 561             (clsql:update-records-from-instance sl)
 562             (print-fresh-subloc)))))
 563   "10 subloc-1 a subloc"
 564   "10 Altered subloc title Altered loc")
 565
 566 (deftest :oodml/update-records/9-slots ;like 9, but use slots fns.
 567     (with-dataset *ds-nodes*
 568       (flet ((print-fresh-subloc ()
 569                (let ((sl (car (clsql:select 'subloc
 570                                             :where [= 10 [slot-value 'subloc 'subloc-id]]
 571                                             :flatp t :caching nil))))
 572                  (format nil "~a ~a ~a"
 573                          (slot-value sl 'subloc-id)
 574                          (slot-value sl 'title)
 575                          (slot-value sl 'loc)))))
 576         (values
 577           (print-fresh-subloc)
 578           (let ((sl (car (clsql:select 'subloc
 579                                        :where [= 10 [slot-value 'subloc 'subloc-id]]
 580                                        :flatp t :caching nil))))
 581             (setf (slot-value sl 'title) "Altered subloc title")
 582             (setf (slot-value sl 'loc) "Altered loc")
 583             (clsql:update-record-from-slot sl 'title)
 584             (clsql:update-record-from-slot sl 'loc)
 585             (print-fresh-subloc))
 586           (let ((sl (car (clsql:select 'subloc
 587                                        :where [= 10 [slot-value 'subloc 'subloc-id]]
 588                                        :flatp t :caching nil))))
 589             (setf (slot-value sl 'title) "subloc-1")
 590             (setf (slot-value sl 'loc) "a subloc")
 591             (clsql:update-record-from-slot sl '(title loc))
 592             (print-fresh-subloc)))))
 593   "10 subloc-1 a subloc"
 594   "10 Altered subloc title Altered loc"
 595   "10 subloc-1 a subloc")
 596
 597 ;; Verify that we can set a float to nil and then read it back
 598 ;; (was failing in Postgresql at somepoint)
 599 (deftest :oodml/update-records/10
 600     (with-dataset *ds-employees*
 601       (let ((emp (first (clsql:select 'employee :where [= [emplid] 1] :flatp T))))
 602         (setf (height emp) nil)
 603         (clsql-sys:update-record-from-slot emp 'height)
 604         (values
 605           (clsql:select [height] :from [employee] :where [= [emplid] 1])
 606           (progn
 607             (setf (height emp) 42.0)
 608             (clsql-sys:update-record-from-slot emp 'height)
 609             (clsql:select [height] :from [employee] :where [= [emplid] 1]))
 610           (progn
 611             (setf (height emp) 24.13d0)
 612             (clsql-sys:update-record-from-slot emp 'height)
 613             (clsql:select [height] :from [employee] :where [= [emplid] 1])))))
 614   ((nil))
 615   ((42.0d0))
 616   ((24.13d0)))
 617
 618
 619 ;; tests update-instance-from-records
 620 (deftest :oodml/update-instance/1
 621     (with-dataset *ds-employees*
 622       (values
 623         (format nil "~a ~a: ~a"
 624                 (slot-value employee1 'first-name)
 625                 (slot-value employee1 'last-name)
 626                 (slot-value employee1 'email))
 627         (progn
 628           (clsql:update-records [employee]
 629                                 :av-pairs '(([first-name] "Ivan")
 630                                             ([last-name] "Petrov")
 631                                             ([email] "petrov@soviet.org"))
 632                                 :where [= [emplid] 1])
 633           (clsql:update-instance-from-records employee1)
 634           (format nil "~a ~a: ~a"
 635                 (slot-value employee1 'first-name)
 636                 (slot-value employee1 'last-name)
 637                 (slot-value employee1 'email)))))
 638   "Vladimir Lenin: lenin@soviet.org"
 639   "Ivan Petrov: petrov@soviet.org")
 640
 641 ;; tests update-slot-from-record
 642 (deftest :oodml/update-instance/2
 643     (with-dataset *ds-employees*
 644       (values
 645         (slot-value employee1 'email)
 646         (progn
 647           (clsql:update-records [employee]
 648                                 :av-pairs '(([email] "lenin-nospam@soviet.org"))
 649                                 :where [= [emplid] 1])
 650           (clsql:update-slot-from-record employee1 'email)
 651           (slot-value employee1 'email))))
 652   "lenin@soviet.org" "lenin-nospam@soviet.org")
 653
 654 ;; tests normalizedp update-instance-from-records
 655 (deftest :oodml/update-instance/3
 656     (with-dataset *ds-nodes*
 657       (values
 658         (with-output-to-string (out)
 659           (format out "~a ~a ~a ~a"
 660                   (slot-value theme2 'theme-id)
 661                   (slot-value theme2 'title)
 662                   (slot-value theme2 'vars)
 663                   (slot-value theme2 'doc)))
 664         (progn
 665           (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
 666                                 :where [= [node-id] 7])
 667           (clsql:update-records [setting] :av-pairs '(([vars] "Altered vars"))
 668                                 :where [= [setting-id] 7])
 669           (clsql:update-records [theme] :av-pairs '(([doc] "Altered doc"))
 670                                 :where [= [theme-id] 7])
 671           (clsql:update-instance-from-records theme2)
 672           (with-output-to-string (out)
 673             (format out "~a ~a ~a ~a"
 674                     (slot-value theme2 'theme-id)
 675                     (slot-value theme2 'title)
 676                     (slot-value theme2 'vars)
 677                     (slot-value theme2 'doc))))))
 678   "7 theme-2 NIL second theme"
 679   "7 Altered title Altered vars Altered doc")
 680
 681 (deftest :oodml/update-instance/4
 682     (with-dataset *ds-nodes*
 683       (values
 684         (progn
 685           (setf loc2 (car (clsql:select 'location
 686                                         :where [= [node-id] 9]
 687                                         :flatp t :caching nil)))
 688           (format nil "~a ~a"
 689                   (slot-value loc2 'node-id)
 690                   (slot-value loc2 'title)))
 691         (progn
 692           (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
 693                                 :where [= [node-id] 9])
 694           (clsql:update-instance-from-records loc2)
 695           (format nil "~a ~a"
 696                   (slot-value loc2 'node-id)
 697                   (slot-value loc2 'title)))))
 698   "9 location-2"
 699   "9 Altered title")
 700
 701 (deftest :oodml/update-instance/5
 702     (with-dataset *ds-nodes*
 703       (values
 704         (format nil "~a ~a ~a"
 705                 (slot-value subloc2 'subloc-id)
 706                 (slot-value subloc2 'title)
 707                 (slot-value subloc2 'loc))
 708         (progn
 709           (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
 710                                 :where [= [node-id] 11])
 711           (clsql:update-records [subloc] :av-pairs '(([loc] "Altered loc"))
 712                                 :where [= [subloc-id] 11])
 713           (clsql:update-instance-from-records subloc2)
 714           (format nil "~a ~a ~a"
 715                   (slot-value subloc2 'subloc-id)
 716                   (slot-value subloc2 'title)
 717                   (slot-value subloc2 'loc)))))
 718   "11 subloc-2 second subloc"
 719   "11 Altered title Altered loc")
 720
 721 ;; tests update-slot-from-record with normalizedp stuff
 722 (deftest :oodml/update-instance/6
 723     (with-dataset *ds-nodes*
 724       (values
 725         (slot-value theme1 'doc)
 726         (slot-value theme1 'vars)
 727         (progn
 728           (clsql:update-records [theme]
 729                                 :av-pairs '(([doc] "altered doc"))
 730                                 :where [= [theme-id] 6])
 731           (clsql:update-slot-from-record theme1 'doc)
 732           (slot-value theme1 'doc))
 733         (progn
 734           (clsql:update-records [setting]
 735                                 :av-pairs '(([vars] "altered vars"))
 736                                 :where [= [setting-id] 6])
 737           (clsql:update-slot-from-record theme1 'vars)
 738           (slot-value theme1 'vars))))
 739   "first theme" "empty"
 740   "altered doc" "altered vars")
 741
 742 (deftest :oodml/update-instance/7
 743     (flet ((print-loc (l)
 744              (format nil "~a: ~a"
 745                      (slot-value l 'node-id) (slot-value l 'title)))
 746            (print-subloc (sl)
 747              (format nil "~a: ~a"
 748                      (slot-value sl 'node-id) (slot-value sl 'loc))))
 749         (with-dataset *ds-nodes*
 750       (values
 751         (print-loc loc2)
 752         (print-subloc subloc2)
 753         (progn
 754           (clsql:update-records [node]
 755                                 :av-pairs '(([title] "altered title"))
 756                                 :where [= [node-id] 9])
 757           (clsql:update-slot-from-record loc2 'title)
 758           (print-loc loc2))
 759         (progn
 760           (clsql:update-records [subloc]
 761                                 :av-pairs '(([loc] "altered loc"))
 762                                 :where [= [subloc-id] 11])
 763           (clsql:update-slot-from-record subloc2 'loc)
 764           (print-subloc subloc2)))))
 765   "9: location-2" "11: second subloc"
 766   "9: altered title" "11: altered loc")
 767
 768 (deftest :oodml/do-query/1
 769     (with-dataset *ds-employees*
 770       (let ((result '()))
 771         (clsql:do-query ((e) [select 'employee :order-by [emplid]])
 772           (push (slot-value e 'last-name) result))
 773         result))
 774   ("Putin" "Yeltsin" "Gorbachev" "Chernenko" "Andropov" "Brezhnev" "Kruschev"
 775            "Trotsky" "Stalin" "Lenin"))
 776
 777 (deftest :oodml/do-query/2
 778     (with-dataset *ds-employees*
 779       (let ((result '()))
 780         (clsql:do-query ((e c) [select 'employee 'company
 781                                        :where [= [slot-value 'employee 'last-name]
 782                                                  "Lenin"]])
 783           (push (list (slot-value e 'last-name) (slot-value c 'name))
 784                 result))
 785         result))
 786   (("Lenin" "Widgets Inc.")))
 787
 788 (deftest :oodml/map-query/1
 789     (with-dataset *ds-employees*
 790       (clsql:map-query 'list #'last-name [select 'employee :order-by [emplid]]))
 791   ("Lenin" "Stalin" "Trotsky" "Kruschev" "Brezhnev" "Andropov" "Chernenko"
 792            "Gorbachev" "Yeltsin" "Putin"))
 793
 794 (deftest :oodml/map-query/2
 795     (with-dataset *ds-employees*
 796       (clsql:map-query 'list #'(lambda (e c) (list (slot-value e 'last-name)
 797                                                    (slot-value c 'name)))
 798                        [select 'employee 'company :where [= [slot-value 'employee 'last-name]
 799                                                             "Lenin"]]))
 800   (("Lenin" "Widgets Inc.")))
 801
 802 (deftest :oodml/iteration/3
 803     (with-dataset *ds-employees*
 804       (loop for (e) being the records in
 805             [select 'employee :where [< [emplid] 4] :order-by [emplid]]
 806             collect (slot-value e 'last-name)))
 807   ("Lenin" "Stalin" "Trotsky"))
 808
 809
 810 (deftest :oodml/cache/1
 811     (with-dataset *ds-employees*
 812       (progn
 813         (setf (clsql-sys:record-caches *default-database*) nil)
 814         (let ((employees (select 'employee)))
 815           (every #'(lambda (a b) (eq a b))
 816                  employees (select 'employee)))))
 817   t)
 818
 819 (deftest :oodml/cache/2
 820     (with-dataset *ds-employees*
 821       (let ((employees (select 'employee)))
 822         (equal employees (select 'employee :flatp t))))
 823   nil)
 824
 825 (deftest :oodml/refresh/1
 826     (with-dataset *ds-employees*
 827       (let ((addresses (select 'address)))
 828         (equal addresses (select 'address :refresh t))))
 829   t)
 830
 831 (deftest :oodml/refresh/2
 832     (with-dataset *ds-employees*
 833       (let* ((addresses (select 'address :order-by [addressid] :flatp t :refresh t))
 834              (city (slot-value (car addresses) 'city)))
 835         (clsql:update-records [addr]
 836                               :av-pairs '((city_field "A new city"))
 837                               :where [= [addressid] (slot-value (car addresses) 'addressid)])
 838         (let* ((new-addresses (select 'address :order-by [addressid] :refresh t :flatp t))
 839                (new-city (slot-value (car addresses) 'city))
 840                )
 841           (clsql:update-records [addr]
 842                                 :av-pairs `((city_field ,city))
 843                                 :where [= [addressid] (slot-value (car addresses) 'addressid)])
 844           (values (equal addresses new-addresses)
 845                   city
 846                   new-city))))
 847   t "Leningrad" "A new city")
 848
 849 (deftest :oodml/refresh/3
 850     (with-dataset *ds-employees*
 851       (let* ((addresses (select 'address :order-by [addressid] :flatp t)))
 852         (values
 853           (equal addresses (select 'address :refresh t :flatp t))
 854           (equal addresses (select 'address :flatp t)))))
 855   nil nil)
 856
 857 (deftest :oodml/refresh/4
 858     (with-dataset *ds-employees*
 859       (let* ((addresses (select 'address :order-by [addressid] :flatp t :refresh t))
 860              (*db-auto-sync* t))
 861         (make-instance 'address :addressid 1000 :city "A new address city")
 862         (let ((new-addresses (select 'address :order-by [addressid] :flatp t :refresh t)))
 863           (delete-records :from [addr] :where [= [addressid] 1000])
 864           (values
 865             (length addresses)
 866             (length new-addresses)
 867             (eq (first addresses) (first new-addresses))
 868             (eq (second addresses) (second new-addresses))))))
 869   2 3 t t)
 870
 871
 872 (deftest :oodml/uoj/1
 873     (with-dataset *ds-employees*
 874       (progn
 875         (let* ((dea-list (select 'deferred-employee-address :caching nil :order-by ["ea_join" aaddressid]
 876                                  :flatp t))
 877                (dea-list-copy (copy-seq dea-list))
 878                (initially-unbound (every #'(lambda (dea) (not (slot-boundp dea 'address))) dea-list)))
 879           (update-objects-joins dea-list)
 880           (values
 881             initially-unbound
 882             (equal dea-list dea-list-copy)
 883             (every #'(lambda (dea) (slot-boundp dea 'address)) dea-list)
 884             (every #'(lambda (dea) (typep (slot-value dea 'address) 'address)) dea-list)
 885             (mapcar #'(lambda (dea) (slot-value (slot-value dea 'address) 'addressid)) dea-list)))))
 886   t t t t (1 1 2 2 2))
 887
 888 ;; update-object-joins needs to be fixed for multiple keys
 889 #+ignore
 890 (deftest :oodml/uoj/2
 891     (progn
 892       (clsql:update-objects-joins (list company1))
 893       (mapcar #'(lambda (e)
 894                   (slot-value e 'ecompanyid))
 895               (company-employees company1)))
 896   (1 1 1 1 1 1 1 1 1 1))
 897
 898 (deftest :oodml/big/1
 899     (with-dataset *ds-big*
 900       (let ((objs (clsql:select 'big :order-by [i] :flatp t)))
 901         (values
 902           (length objs)
 903           (do ((i 0 (1+ i))
 904                (max (expt 2 60))
 905                (rest objs (cdr rest)))
 906               ((= i (length objs)) t)
 907             (let ((obj (car rest))
 908                   (index (1+ i)))
 909               (unless (and (eql (slot-value obj 'i) index)
 910                            (eql (slot-value obj 'bi) (truncate max index)))
 911                 (print index)
 912                 (describe obj)
 913                 (return nil)))))))
 914   555 t)
 915
 916 (deftest :oodml/db-auto-sync/1
 917     (with-dataset *ds-employees*
 918       (values
 919         (progn
 920           (make-instance 'employee :emplid 20 :groupid 1
 921                          :last-name "Ivanovich")
 922           (select [last-name] :from [employee] :where [= [emplid] 20]
 923                   :flatp t :field-names nil))
 924         (let ((*db-auto-sync* t))
 925           (make-instance 'employee :emplid 20 :groupid 1
 926                          :last-name "Ivanovich")
 927           (prog1 (select [last-name] :from [employee] :flatp t
 928                          :field-names nil
 929                          :where [= [emplid] 20])
 930             (delete-records :from [employee] :where [= [emplid] 20])))))
 931   nil ("Ivanovich"))
 932
 933 (deftest :oodml/db-auto-sync/2
 934     (with-dataset *ds-employees*
 935       (values
 936         (let ((instance (make-instance 'employee :emplid 20 :groupid 1
 937                                        :last-name "Ivanovich")))
 938           (setf (slot-value instance 'last-name) "Bulgakov")
 939           (select [last-name] :from [employee] :where [= [emplid] 20]
 940                   :flatp t :field-names nil))
 941         (let* ((*db-auto-sync* t)
 942                (instance (make-instance 'employee :emplid 20 :groupid 1
 943                                         :last-name "Ivanovich")))
 944           (setf (slot-value instance 'last-name) "Bulgakov")
 945           (prog1 (select [last-name] :from [employee] :flatp t
 946                          :field-names nil
 947                          :where [= [emplid] 20])
 948             (delete-records :from [employee] :where [= [emplid] 20])))))
 949   nil ("Bulgakov"))
 950
 951 (deftest :oodml/db-auto-sync/3
 952     (with-dataset *ds-nodes*
 953       (values
 954         (progn
 955           (make-instance 'theme :title "test-theme" :vars "test-vars"
 956                          :doc "test-doc")
 957           (select [node-id] :from [node] :where [= [title] "test-theme"]
 958                   :flatp t :field-names nil))
 959         (let ((*db-auto-sync* t))
 960           (make-instance 'theme :title "test-theme" :vars "test-vars"
 961                          :doc "test-doc")
 962           (prog1 (select [title] :from [node] :where [= [title] "test-theme"]
 963                          :flatp t :field-names nil)
 964             (delete-records :from [node] :where [= [title] "test-theme"])
 965             (delete-records :from [setting] :where [= [vars] "test-vars"])
 966             (delete-records :from [theme] :where [= [doc] "test-doc"])))))
 967   nil ("test-theme"))
 968
 969 (deftest :oodml/db-auto-sync/4
 970     (with-dataset *ds-nodes*
 971       (values
 972         (let ((inst (make-instance 'theme
 973                                    :title "test-theme" :vars "test-vars"
 974                                    :doc "test-doc")))
 975           (setf (slot-value inst 'title) "alternate-test-theme")
 976           (format nil "~a ~a ~a ~a"
 977                   (select [title] :from [node]
 978                           :where [= [title] "test-theme"]
 979                           :flatp t :field-names nil)
 980                   (select [vars] :from [setting]
 981                           :where [= [vars] "test-vars"]
 982                           :flatp t :field-names nil)
 983                   (select [doc] :from [theme]
 984                           :where [= [doc] "test-doc"]
 985                           :flatp t :field-names nil)
 986                   (select [title] :from [node]
 987                           :where [= [title] "alternate-test-theme"]
 988                           :flatp t :field-names nil)))
 989         (let* ((*db-auto-sync* t)
 990                (inst (make-instance 'theme
 991                                     :title "test-theme" :vars "test-vars"
 992                                     :doc "test-doc")))
 993           (setf (slot-value inst 'title) "alternate-test-theme")
 994           (prog1
 995               (format nil "~a ~a ~a ~a"
 996                       (select [title] :from [node]
 997                               :where [= [title] "test-theme"]
 998                               :flatp t :field-names nil)
 999                       (select [vars] :from [setting]
1000                               :where [= [vars] "test-vars"]
1001                               :flatp t :field-names nil)
1002                       (select [doc] :from [theme]
1003                               :where [= [doc] "test-doc"]
1004                               :flatp t :field-names nil)
1005                       (select [title] :from [node]
1006                               :where [= [title] "alternate-test-theme"]
1007                               :flatp t :field-names nil))
1008             (delete-records :from [node] :where [= [title] "alternate-test-theme"])
1009             (delete-records :from [setting] :where [= [vars] "test-vars"])
1010             (delete-records :from [theme] :where [= [doc] "test-doc"])))))
1011   "NIL NIL NIL NIL"
1012   "NIL (test-vars) (test-doc) (alternate-test-theme)")
1013
1014 (deftest :oodml/setf-slot-value/1
1015     (with-dataset *ds-employees*
1016       (let* ((*db-auto-sync* t)
1017              (instance (make-instance 'employee :emplid 20 :groupid 1)))
1018         (prog1
1019             (setf
1020              (slot-value instance 'first-name) "Mikhail"
1021              (slot-value instance 'last-name) "Bulgakov")
1022           (delete-records :from [employee] :where [= [emplid] 20]))))
1023   "Bulgakov")
1024
1025 (deftest :oodml/float/1
1026     (with-dataset *ds-employees*
1027       (let* ((emp1 (car (select 'employee
1028                                 :where [= [slot-value 'employee 'emplid]
1029                                           1]
1030                                 :flatp t
1031                                 :caching nil)))
1032              (height (slot-value emp1 'height)))
1033         (prog1
1034             (progn
1035               (setf (slot-value emp1 'height) 1.0E0)
1036               (clsql:update-record-from-slot emp1 'height)
1037               (= (car (clsql:select [height] :from [employee]
1038                                     :where [= [emplid] 1]
1039                                     :flatp t
1040                                     :field-names nil))
1041                  1))
1042           (setf (slot-value emp1 'height) height)
1043           (clsql:update-record-from-slot emp1 'height))))
1044   t)
1045
1046 (deftest :oodml/float/2
1047     (with-dataset *ds-employees*
1048       (let* ((emp1 (car (select 'employee
1049                                 :where [= [slot-value 'employee 'emplid]
1050                                           1]
1051                                 :flatp t
1052                                 :caching nil)))
1053              (height (slot-value emp1 'height)))
1054         (prog1
1055             (progn
1056               (setf (slot-value emp1 'height) 1.0S0)
1057               (clsql:update-record-from-slot emp1 'height)
1058               (= (car (clsql:select [height] :from [employee]
1059                                     :where [= [emplid] 1]
1060                                     :flatp t
1061                                     :field-names nil))
1062                  1))
1063           (setf (slot-value emp1 'height) height)
1064           (clsql:update-record-from-slot emp1 'height))))
1065   t)
1066
1067 (deftest :oodml/float/3
1068     (with-dataset *ds-employees*
1069       (let* ((emp1 (car (select 'employee
1070                                 :where [= [slot-value 'employee 'emplid]
1071                                           1]
1072                                 :flatp t
1073                                 :caching nil)))
1074              (height (slot-value emp1 'height)))
1075         (prog1
1076             (progn
1077               (setf (slot-value emp1 'height) 1.0F0)
1078               (clsql:update-record-from-slot emp1 'height)
1079               (= (car (clsql:select [height] :from [employee]
1080                                     :where [= [emplid] 1]
1081                                     :flatp t
1082                                     :field-names nil))
1083                  1))
1084           (setf (slot-value emp1 'height) height)
1085           (clsql:update-record-from-slot emp1 'height))))
1086   t)
1087
1088 (deftest :oodml/float/4
1089     (with-dataset *ds-employees*
1090       (let* ((emp1 (car (select 'employee
1091                                 :where [= [slot-value 'employee 'emplid]
1092                                           1]
1093                                 :flatp t
1094                                 :caching nil)))
1095              (height (slot-value emp1 'height)))
1096         (prog1
1097             (progn
1098               (setf (slot-value emp1 'height) 1.0D0)
1099               (clsql:update-record-from-slot emp1 'height)
1100               (= (car (clsql:select [height] :from [employee]
1101                                     :where [= [emplid] 1]
1102                                     :flatp t
1103                                     :field-names nil))
1104                  1))
1105           (setf (slot-value emp1 'height) height)
1106           (clsql:update-record-from-slot emp1 'height))))
1107   t)
1108
1109 (deftest :oodml/float/5
1110     (with-dataset *ds-employees*
1111       (let* ((emp1 (car (select 'employee
1112                                 :where [= [slot-value 'employee 'emplid]
1113                                           1]
1114                                 :flatp t
1115                                 :caching nil)))
1116              (height (slot-value emp1 'height)))
1117         (prog1
1118             (progn
1119               (setf (slot-value emp1 'height) 1.0L0)
1120               (clsql:update-record-from-slot emp1 'height)
1121               (= (car (clsql:select [height] :from [employee]
1122                                     :where [= [emplid] 1]
1123                                     :flatp t
1124                                     :field-names nil))
1125                  1))
1126           (setf (slot-value emp1 'height) height)
1127           (clsql:update-record-from-slot emp1 'height))))
1128   t)
1129 ))
1130
1131
1132
1133 #.(clsql:restore-sql-reader-syntax-state)