tests/test-oodml.lisp

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