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
  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 [not [null [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 [not [null [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 [not [null [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 [not [null [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 [not [null [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 (deftest :oodml/select/23
 216     (with-dataset *ds-artists*
 217       (length (clsql:select 'artist :flatp t :caching nil)))
 218   0)
 219
 220
 221
 222 ;; test retrieval is deferred
 223 (deftest :oodm/retrieval/1
 224     (with-dataset *ds-employees*
 225       (every #'(lambda (e) (not (slot-boundp e 'company)))
 226              (select 'employee :flatp t :caching nil)))
 227   t)
 228
 229 (deftest :oodm/retrieval/2
 230     (with-dataset *ds-employees*
 231       (every #'(lambda (e) (not (slot-boundp e 'address)))
 232              (select 'deferred-employee-address :flatp t :caching nil)))
 233   t)
 234
 235 ;; :retrieval :immediate should be boundp before accessed
 236 (deftest :oodm/retrieval/3
 237     (with-dataset *ds-employees*
 238       (every #'(lambda (ea) (slot-boundp ea 'address))
 239              (select 'employee-address :flatp t :caching nil)))
 240   t)
 241
 242 (deftest :oodm/retrieval/4
 243     (with-dataset *ds-employees*
 244       (every #'(lambda (ea) (typep (slot-value ea 'address) 'address))
 245               (select 'employee-address :flatp t :caching nil)))
 246   t)
 247
 248 (deftest :oodm/retrieval/5
 249     (with-dataset *ds-employees*
 250       (every #'(lambda (ea) (typep (slot-value ea 'address) 'address))
 251              (select 'deferred-employee-address :flatp t :caching nil)))
 252   t)
 253
 254 (deftest :oodm/retrieval/6
 255     (with-dataset *ds-employees*
 256       (every #'(lambda (ea) (slot-boundp (slot-value ea 'address) 'addressid))
 257              (select 'employee-address :flatp t :caching nil)))
 258   t)
 259
 260 (deftest :oodm/retrieval/7
 261     (with-dataset *ds-employees*
 262       (every #'(lambda (ea) (slot-boundp (slot-value ea 'address) 'addressid))
 263              (select 'deferred-employee-address :flatp t :caching nil)))
 264   t)
 265
 266 (deftest :oodm/retrieval/8
 267     (with-dataset *ds-employees*
 268       (mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number))
 269               (select 'employee-address :flatp t :order-by [aaddressid] :caching nil)))
 270   (10 10 nil nil nil nil))
 271
 272 (deftest :oodm/retrieval/9
 273     (with-dataset *ds-employees*
 274       (mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number))
 275               (select 'deferred-employee-address :flatp t :order-by [aaddressid] :caching nil)))
 276   (10 10 nil nil nil nil))
 277
 278 ;; tests update-records-from-instance
 279 (deftest :oodml/update-records/1
 280     (with-dataset *ds-employees*
 281       (values
 282         (progn
 283           (let ((lenin (car (clsql:select 'employee
 284                                           :where [= 1 [slot-value 'employee 'emplid]]
 285                                           :flatp t
 286                                           :caching nil))))
 287             (format nil "~a ~a: ~a"
 288                 (first-name lenin)
 289                 (last-name lenin)
 290                 (employee-email lenin))))
 291         (progn
 292           (setf (slot-value employee1 'first-name) "Dimitriy"
 293                 (slot-value employee1 'last-name) "Ivanovich"
 294                 (slot-value employee1 'email) "ivanovich@soviet.org")
 295           (clsql:update-records-from-instance employee1)
 296           (let ((lenin (car (clsql:select 'employee
 297                                           :where [= 1 [slot-value 'employee 'emplid]]
 298                                           :flatp t
 299                                           :caching nil))))
 300             (format nil "~a ~a: ~a"
 301                 (first-name lenin)
 302                 (last-name lenin)
 303                 (employee-email lenin))))))
 304   "Vladimir Lenin: lenin@soviet.org"
 305   "Dimitriy Ivanovich: ivanovich@soviet.org")
 306
 307 ;; tests update-record-from-slot
 308 (deftest :oodml/update-records/2
 309     (with-dataset *ds-employees*
 310       ;(start-sql-recording :type :both)
 311       (values
 312         (employee-email
 313          (car (clsql:select 'employee
 314                             :where [= 1 [slot-value 'employee 'emplid]]
 315                             :flatp t
 316                             :caching nil)))
 317         (progn
 318           (setf (slot-value employee1 'email) "lenin-nospam@soviet.org")
 319           (clsql:update-record-from-slot employee1 'email)
 320           (employee-email
 321            (car (clsql:select 'employee
 322                               :where [= 1 [slot-value 'employee 'emplid]]
 323                               :flatp t
 324                               :caching nil))))))
 325   "lenin@soviet.org" "lenin-nospam@soviet.org")
 326
 327 ;; tests update-record-from-slots
 328 (deftest :oodml/update-records/3
 329     (with-dataset *ds-employees*
 330       (values
 331         (let ((lenin (car (clsql:select 'employee
 332                                         :where [= 1 [slot-value 'employee 'emplid]]
 333                                         :flatp t
 334                                         :caching nil))))
 335           (format nil "~a ~a: ~a"
 336                   (first-name lenin)
 337                   (last-name lenin)
 338                   (employee-email lenin)))
 339         (progn
 340           (setf (slot-value employee1 'first-name) "Dimitriy"
 341                 (slot-value employee1 'last-name) "Ivanovich"
 342                 (slot-value employee1 'email) "ivanovich@soviet.org")
 343           (clsql:update-record-from-slots employee1 '(first-name last-name email))
 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   "Vladimir Lenin: lenin@soviet.org"
 353   "Dimitriy Ivanovich: ivanovich@soviet.org")
 354
 355 (deftest :oodml/update-records/4
 356     (with-dataset *ds-nodes*
 357       (flet ((print-fresh-node ()
 358                (let ((base (car (clsql:select 'node
 359                                               :where [= 1 [slot-value 'node 'node-id]]
 360                                               :flatp t :caching nil))))
 361                  (format nil "~a ~a"
 362                          (slot-value base 'node-id)
 363                          (slot-value base 'title)))))
 364         (values
 365           (print-fresh-node)
 366           (let ((base (car (clsql:select 'node
 367                                          :where [= 1 [slot-value 'node 'node-id]]
 368                                          :flatp t :caching nil))))
 369             (setf (slot-value base 'title) "Altered title")
 370             (clsql:update-records-from-instance base)
 371             (print-fresh-node)))))
 372   "1 Bare node"
 373   "1 Altered title")
 374
 375 (deftest :oodml/update-records/4-slots ;just like 4, but use slots fns.
 376     (with-dataset *ds-nodes*
 377       (flet ((print-fresh-setting ()
 378                (let ((node (car (clsql:select 'setting
 379                                               :where [= 3 [slot-value 'setting 'setting-id]]
 380                                               :flatp t :caching nil))))
 381                  (format nil "~a ~a ~a"
 382                          (slot-value node 'setting-id)
 383                          (slot-value node 'title)
 384                          (slot-value node 'vars)))))
 385         (values
 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) "Altered title")
 391             (setf (slot-value node 'vars) "Altered vars")
 392             (clsql-sys:update-record-from-slot node 'title)
 393             (clsql-sys:update-record-from-slot node 'vars)
 394             (print-fresh-setting))
 395           (let ((node (car (clsql:select 'setting
 396                                          :where [= 3 [slot-value 'setting 'setting-id]]
 397                                          :flatp t :caching nil))))
 398             (setf (slot-value node 'title) "Setting2")
 399             (setf (slot-value node 'vars) "var 2")
 400             (clsql:update-records-from-instance node)
 401             (clsql-sys:update-record-from-slots node '(vars title))
 402             (print-fresh-setting)))))
 403   "3 Setting2 var 2"
 404   "3 Altered title Altered vars"
 405   "3 Setting2 var 2")
 406
 407 (deftest :oodml/update-records/5
 408     (with-dataset *ds-nodes*
 409       (flet ((print-fresh-setting ()
 410                (let ((node (car (clsql:select 'setting
 411                                               :where [= 3 [slot-value 'setting 'setting-id]]
 412                                               :flatp t :caching nil))))
 413                  (format nil "~a ~a ~a"
 414                          (slot-value node 'setting-id)
 415                          (slot-value node 'title)
 416                          (slot-value node 'vars)))))
 417         (values
 418           (print-fresh-setting)
 419           (let ((node (car (clsql:select 'setting
 420                                          :where [= 3 [slot-value 'setting 'setting-id]]
 421                                          :flatp t :caching nil))))
 422             (setf (slot-value node 'title) "Altered title")
 423             (setf (slot-value node 'vars) "Altered vars")
 424             (clsql:update-records-from-instance node)
 425             (print-fresh-setting)))))
 426   "3 Setting2 var 2"
 427   "3 Altered title Altered vars")
 428
 429 (deftest :oodml/update-records/5-slots
 430     (with-dataset *ds-nodes*
 431       (flet ((print-fresh-setting ()
 432                (let ((node (car (clsql:select 'setting
 433                                               :where [= 3 [slot-value 'setting 'setting-id]]
 434                                               :flatp t :caching nil))))
 435                  (format nil "~a ~a ~a"
 436                          (slot-value node 'setting-id)
 437                          (slot-value node 'title)
 438                          (slot-value node 'vars)))))
 439         (values
 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) "Altered title")
 445             (setf (slot-value node 'vars) "Altered vars")
 446             (clsql-sys:update-record-from-slot node 'title)
 447             (clsql-sys:update-record-from-slot node 'vars)
 448             (print-fresh-setting))
 449           (let ((node (car (clsql:select 'setting
 450                                          :where [= 3 [slot-value 'setting 'setting-id]]
 451                                          :flatp t :caching nil))))
 452             (setf (slot-value node 'title) "Setting2")
 453             (setf (slot-value node 'vars) "var 2")
 454             (clsql-sys:update-record-from-slots node '(title vars))
 455             (print-fresh-setting)))))
 456   "3 Setting2 var 2"
 457   "3 Altered title Altered vars"
 458   "3 Setting2 var 2")
 459
 460 (deftest :oodml/update-records/6
 461     (with-dataset *ds-nodes*
 462       (flet ((print-fresh-setting ()
 463                (let ((node (car (clsql:select 'setting
 464                                               :where [= 7 [slot-value 'setting 'setting-id]]
 465                                               :flatp t :caching nil))))
 466                  (format nil "~a ~a ~a"
 467                          (slot-value node 'setting-id)
 468                          (slot-value node 'title)
 469                          (or (slot-value node 'vars) "NIL")))))
 470         (values
 471           (print-fresh-setting)
 472           (let ((node (car (clsql:select 'setting
 473                                          :where [= 7 [slot-value 'setting 'setting-id]]
 474                                          :flatp t :caching nil))))
 475             (setf (slot-value node 'title) "Altered title")
 476             (setf (slot-value node 'vars) "Altered vars")
 477             (clsql:update-records-from-instance node)
 478             (print-fresh-setting))
 479           (let ((node (car (clsql:select 'setting
 480                                          :where [= 7 [slot-value 'setting 'setting-id]]
 481                                          :flatp t :caching nil))))
 482             (setf (slot-value node 'title) "theme-2")
 483             (setf (slot-value node 'vars) nil)
 484             (clsql:update-records-from-instance node)
 485             (print-fresh-setting)))))
 486   "7 theme-2 NIL"
 487   "7 Altered title Altered vars"
 488   "7 theme-2 NIL")
 489
 490 (deftest :oodml/update-records/7
 491     (with-dataset *ds-nodes*
 492       (flet ((print-fresh-user ()
 493                "requery to get what the db has, and print out."
 494                (let ((node (car (clsql:select 'user
 495                                               :where [= 5 [slot-value 'user 'user-id]]
 496                                               :flatp t :caching nil))))
 497                  (format nil "~a ~a ~a"
 498                          (slot-value node 'user-id)
 499                          (slot-value node 'title)
 500                          (slot-value node 'nick)))))
 501         (values
 502           (print-fresh-user)
 503           (let ((node (car (clsql:select 'user
 504                                          :where [= 5 [slot-value 'user 'user-id]]
 505                                          :flatp t :caching nil))))
 506             (setf (slot-value node 'title) "Altered title")
 507             (setf (slot-value node 'nick) "Altered nick")
 508             (clsql:update-records-from-instance node)
 509             (print-fresh-user)))))
 510   "5 user-2 second user"
 511   "5 Altered title Altered nick")
 512
 513 (deftest :oodml/update-records/8
 514     (with-dataset *ds-nodes*
 515       (flet ((print-fresh-theme ()
 516                (let ((node (car (clsql:select 'theme
 517                                               :where [= 6 [slot-value 'theme 'theme-id]]
 518                                               :flatp t :caching nil))))
 519                  (with-slots (node-id setting-id theme-id title vars doc) node
 520                    (format nil "~a ~a ~a ~a ~a ~a"
 521                            node-id setting-id theme-id
 522                            title (or vars "NIL") doc)))))
 523         (values
 524           (print-fresh-theme)
 525           (let ((node (car (clsql:select 'setting
 526                                          :where [= 6 [slot-value 'setting 'setting-id]]
 527                                          :flatp t :caching nil))))
 528             (setf (slot-value node 'title) "Altered title")
 529             (setf (slot-value node 'vars) nil)
 530             (clsql:update-records-from-instance node)
 531             (print-fresh-theme))
 532           (let ((node (car (clsql:select 'theme
 533                                          :where [= 6 [slot-value 'theme 'theme-id]]
 534                                          :flatp t :caching nil))))
 535             (setf (slot-value node 'title) "Altered title again")
 536             (setf (slot-value node 'doc) "altered doc")
 537             (clsql:update-records-from-instance node)
 538             (print-fresh-theme))
 539           (let ((node (car (clsql:select 'theme
 540                                          :where [= 6 [slot-value 'theme 'theme-id]]
 541                                          :flatp t :caching nil))))
 542             (setf (slot-value node 'title) "theme-1")
 543             (setf (slot-value node 'vars) "empty")
 544             (setf (slot-value node 'doc) "first theme")
 545             (clsql:update-records-from-instance node)
 546             (print-fresh-theme)))))
 547   "6 6 6 theme-1 empty first theme"
 548   "6 6 6 Altered title NIL first theme"
 549   "6 6 6 Altered title again NIL altered doc"
 550   "6 6 6 theme-1 empty first theme")
 551
 552 (deftest :oodml/update-records/9
 553     (with-dataset *ds-nodes*
 554       (flet ((print-fresh-subloc ()
 555                (let ((sl (car (clsql:select 'subloc
 556                                             :where [= 10 [slot-value 'subloc 'subloc-id]]
 557                                             :flatp t :caching nil))))
 558                  (unless sl
 559                    (error "Couldn't find expected sublocation"))
 560                  (format nil "~a ~a ~a"
 561                          (slot-value sl 'subloc-id)
 562                          (slot-value sl 'title)
 563                          (slot-value sl 'loc)))))
 564         (values
 565           (print-fresh-subloc)
 566           (let ((sl (car (clsql:select 'subloc
 567                                        :where [= 10 [slot-value 'subloc 'subloc-id]]
 568                                        :flatp t :caching nil))))
 569             (setf (slot-value sl 'title) "Altered subloc title")
 570             (setf (slot-value sl 'loc) "Altered loc")
 571             (clsql:update-records-from-instance sl)
 572             (print-fresh-subloc)))))
 573   "10 subloc-1 a subloc"
 574   "10 Altered subloc title Altered loc")
 575
 576 (deftest :oodml/update-records/9-slots ;like 9, but use slots fns.
 577     (with-dataset *ds-nodes*
 578       (flet ((print-fresh-subloc ()
 579                (let ((sl (car (clsql:select 'subloc
 580                                             :where [= 10 [slot-value 'subloc 'subloc-id]]
 581                                             :flatp t :caching nil))))
 582                  (unless sl
 583                    (error "In psfl: found no sublocation with id = 10"))
 584                  (format nil "~a ~a ~a"
 585                          (slot-value sl 'subloc-id)
 586                          (slot-value sl 'title)
 587                          (slot-value sl 'loc)))))
 588         (values
 589           (print-fresh-subloc)
 590           (let ((sl (car (clsql:select 'subloc
 591                                        :where [= 10 [slot-value 'subloc 'subloc-id]]
 592                                        :flatp t :caching nil))))
 593             (unless sl
 594               (error "Select for modification: Found no sublocation with id = 10"))
 595             (setf (slot-value sl 'title) "Altered subloc title")
 596             (setf (slot-value sl 'loc) "Altered loc")
 597             (clsql:update-record-from-slot sl 'title)
 598             (clsql:update-record-from-slot sl 'loc)
 599             (print-fresh-subloc))
 600           (let ((sl (car (clsql:select 'subloc
 601                                        :where [= 10 [slot-value 'subloc 'subloc-id]]
 602                                        :flatp t :caching nil))))
 603             (unless sl
 604               (error "Select for next modification: Found no sublocation with id = 10"))
 605             (setf (slot-value sl 'title) "subloc-1")
 606             (setf (slot-value sl 'loc) "a subloc")
 607             (clsql:update-record-from-slots sl '(title loc))
 608             (print-fresh-subloc)))))
 609   "10 subloc-1 a subloc"
 610   "10 Altered subloc title Altered loc"
 611   "10 subloc-1 a subloc")
 612
 613 ;; Verify that we can set a float to nil and then read it back
 614 ;; (was failing in Postgresql at somepoint)
 615 (deftest :oodml/update-records/10
 616     (with-dataset *ds-employees*
 617       (let ((emp (first (clsql:select 'employee :where [= [emplid] 1] :flatp t))))
 618         (setf (height emp) nil)
 619         (clsql-sys:update-record-from-slot emp 'height)
 620         (values
 621           (clsql:select [height] :from [employee] :where [= [emplid] 1])
 622           (progn
 623             (setf (height emp) 42.0)
 624             (clsql-sys:update-record-from-slot emp 'height)
 625             (clsql:select [height] :from [employee] :where [= [emplid] 1]))
 626           (progn
 627             (setf (height emp) 24.13d0)
 628             (clsql-sys:update-record-from-slot emp 'height)
 629             (clsql:select [height] :from [employee] :where [= [emplid] 1])))))
 630   ((nil))
 631   ((42.0d0))
 632   ((24.13d0)))
 633
 634 (deftest :oodml/update-records/11
 635     (with-dataset *ds-artists*
 636       (clsql:update-records-from-instance artist1)
 637       (list (name artist1) (artist_id artist1)))
 638   ("Mogwai" 1))
 639
 640 (deftest :oodml/update-records/12
 641     (with-dataset *ds-artists*
 642       (clsql:update-records-from-instance artist1)
 643       (list (name artist1) (genre artist1)))
 644   ("Mogwai" "Unknown"))
 645
 646 ;; tests update-instance-from-records
 647 (deftest :oodml/update-instance/1
 648     (with-dataset *ds-employees*
 649       (values
 650         (format nil "~a ~a: ~a"
 651                 (slot-value employee1 'first-name)
 652                 (slot-value employee1 'last-name)
 653                 (slot-value employee1 'email))
 654         (progn
 655           (clsql:update-records [employee]
 656                                 :av-pairs '(([first-name] "Ivan")
 657                                             ([last-name] "Petrov")
 658                                             ([email] "petrov@soviet.org"))
 659                                 :where [= [emplid] 1])
 660           (clsql:update-instance-from-records employee1)
 661           (format nil "~a ~a: ~a"
 662                 (slot-value employee1 'first-name)
 663                 (slot-value employee1 'last-name)
 664                 (slot-value employee1 'email)))))
 665   "Vladimir Lenin: lenin@soviet.org"
 666   "Ivan Petrov: petrov@soviet.org")
 667
 668 ;; tests update-slot-from-record
 669 (deftest :oodml/update-instance/2
 670     (with-dataset *ds-employees*
 671       (values
 672         (slot-value employee1 'email)
 673         (progn
 674           (clsql:update-records [employee]
 675                                 :av-pairs '(([email] "lenin-nospam@soviet.org"))
 676                                 :where [= [emplid] 1])
 677           (clsql:update-slot-from-record employee1 'email)
 678           (slot-value employee1 'email))))
 679   "lenin@soviet.org" "lenin-nospam@soviet.org")
 680
 681 ;; tests normalizedp update-instance-from-records
 682 (deftest :oodml/update-instance/3
 683     (with-dataset *ds-nodes*
 684       (values
 685         (with-output-to-string (out)
 686           (format out "~a ~a ~a ~a"
 687                   (slot-value theme2 'theme-id)
 688                   (slot-value theme2 'title)
 689                   (or (slot-value theme2 'vars) "NIL")
 690                   (slot-value theme2 'doc)))
 691         (progn
 692           (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
 693                                 :where [= [node-id] 7])
 694           (clsql:update-records [setting] :av-pairs '(([vars] "Altered vars"))
 695                                 :where [= [setting-id] 7])
 696           (clsql:update-records [theme] :av-pairs '(([doc] "Altered doc"))
 697                                 :where [= [theme-id] 7])
 698           (clsql:update-instance-from-records theme2)
 699           (with-output-to-string (out)
 700             (format out "~a ~a ~a ~a"
 701                     (slot-value theme2 'theme-id)
 702                     (slot-value theme2 'title)
 703                     (slot-value theme2 'vars)
 704                     (slot-value theme2 'doc))))))
 705   "7 theme-2 NIL second theme"
 706   "7 Altered title Altered vars Altered doc")
 707
 708 (deftest :oodml/update-instance/4
 709     (with-dataset *ds-nodes*
 710       (values
 711         (progn
 712           (setf loc2 (car (clsql:select 'location
 713                                         :where [= [node-id] 9]
 714                                         :flatp t :caching nil)))
 715           (format nil "~a ~a"
 716                   (slot-value loc2 'node-id)
 717                   (slot-value loc2 'title)))
 718         (progn
 719           (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
 720                                 :where [= [node-id] 9])
 721           (clsql:update-instance-from-records loc2)
 722           (format nil "~a ~a"
 723                   (slot-value loc2 'node-id)
 724                   (slot-value loc2 'title)))))
 725   "9 location-2"
 726   "9 Altered title")
 727
 728 (deftest :oodml/update-instance/5
 729     (with-dataset *ds-nodes*
 730       (values
 731         (format nil "~a ~a ~a"
 732                 (slot-value subloc2 'subloc-id)
 733                 (slot-value subloc2 'title)
 734                 (slot-value subloc2 'loc))
 735         (progn
 736           (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
 737                                 :where [= [node-id] 11])
 738           (clsql:update-records [subloc] :av-pairs '(([loc] "Altered loc"))
 739                                 :where [= [subloc-id] 11])
 740           (clsql:update-instance-from-records subloc2)
 741           (format nil "~a ~a ~a"
 742                   (slot-value subloc2 'subloc-id)
 743                   (slot-value subloc2 'title)
 744                   (slot-value subloc2 'loc)))))
 745   "11 subloc-2 second subloc"
 746   "11 Altered title Altered loc")
 747
 748 ;; tests update-slot-from-record with normalizedp stuff
 749 (deftest :oodml/update-instance/6
 750     (with-dataset *ds-nodes*
 751       (values
 752         (slot-value theme1 'doc)
 753         (slot-value theme1 'vars)
 754         (progn
 755           (clsql:update-records [theme]
 756                                 :av-pairs '(([doc] "altered doc"))
 757                                 :where [= [theme-id] 6])
 758           (clsql:update-slot-from-record theme1 'doc)
 759           (slot-value theme1 'doc))
 760         (progn
 761           (clsql:update-records [setting]
 762                                 :av-pairs '(([vars] "altered vars"))
 763                                 :where [= [setting-id] 6])
 764           (clsql:update-slot-from-record theme1 'vars)
 765           (slot-value theme1 'vars))))
 766   "first theme" "empty"
 767   "altered doc" "altered vars")
 768
 769 (deftest :oodml/update-instance/7
 770     (flet ((print-loc (l)
 771              (format nil "~a: ~a"
 772                      (slot-value l 'node-id) (slot-value l 'title)))
 773            (print-subloc (sl)
 774              (format nil "~a: ~a"
 775                      (slot-value sl 'node-id) (slot-value sl 'loc))))
 776         (with-dataset *ds-nodes*
 777       (values
 778         (print-loc loc2)
 779         (print-subloc subloc2)
 780         (progn
 781           (clsql:update-records [node]
 782                                 :av-pairs '(([title] "altered title"))
 783                                 :where [= [node-id] 9])
 784           (clsql:update-slot-from-record loc2 'title)
 785           (print-loc loc2))
 786         (progn
 787           (clsql:update-records [subloc]
 788                                 :av-pairs '(([loc] "altered loc"))
 789                                 :where [= [subloc-id] 11])
 790           (clsql:update-slot-from-record subloc2 'loc)
 791           (print-subloc subloc2)))))
 792   "9: location-2" "11: second subloc"
 793   "9: altered title" "11: altered loc")
 794
 795 (deftest :oodml/do-query/1
 796     (with-dataset *ds-employees*
 797       (let ((result '()))
 798         (clsql:do-query ((e) [select 'employee :order-by [emplid]])
 799           (push (slot-value e 'last-name) result))
 800         result))
 801   ("Putin" "Yeltsin" "Gorbachev" "Chernenko" "Andropov" "Brezhnev" "Kruschev"
 802            "Trotsky" "Stalin" "Lenin"))
 803
 804 (deftest :oodml/do-query/2
 805     (with-dataset *ds-employees*
 806       (let ((result '()))
 807         (clsql:do-query ((e c) [select 'employee 'company
 808                                        :where [= [slot-value 'employee 'last-name]
 809                                                  "Lenin"]])
 810           (push (list (slot-value e 'last-name) (slot-value c 'name))
 811                 result))
 812         result))
 813   (("Lenin" "Widgets Inc.")))
 814
 815 (deftest :oodml/map-query/1
 816     (with-dataset *ds-employees*
 817       (clsql:map-query 'list #'last-name [select 'employee :order-by [emplid]]))
 818   ("Lenin" "Stalin" "Trotsky" "Kruschev" "Brezhnev" "Andropov" "Chernenko"
 819            "Gorbachev" "Yeltsin" "Putin"))
 820
 821 (deftest :oodml/map-query/2
 822     (with-dataset *ds-employees*
 823       (clsql:map-query 'list #'(lambda (e c) (list (slot-value e 'last-name)
 824                                                    (slot-value c 'name)))
 825                        [select 'employee 'company :where [= [slot-value 'employee 'last-name]
 826                                                             "Lenin"]]))
 827   (("Lenin" "Widgets Inc.")))
 828
 829 (deftest :oodml/iteration/3
 830     (with-dataset *ds-employees*
 831       (loop for (e) being the records in
 832             [select 'employee :where [< [emplid] 4] :order-by [emplid]]
 833             collect (slot-value e 'last-name)))
 834   ("Lenin" "Stalin" "Trotsky"))
 835
 836
 837 (deftest :oodml/cache/1
 838     (with-dataset *ds-employees*
 839       (let ((*default-caching* t))
 840         (setf (clsql-sys:record-caches *default-database*) nil)
 841         (let ((employees (select 'employee)))
 842           (every #'(lambda (a b) (eq a b))
 843                  employees (select 'employee)))))
 844   t)
 845
 846 (deftest :oodml/cache/2
 847     (with-dataset *ds-employees*
 848       (let* ((*default-caching* t)
 849              (employees (select 'employee)))
 850         (equal employees (select 'employee :flatp t))))
 851   nil)
 852
 853 (deftest :oodml/refresh/1
 854     (with-dataset *ds-employees*
 855       (let* ((clsql-sys:*default-caching* t)
 856              (addresses (select 'address)))
 857         (equal addresses (select 'address :refresh t))))
 858   t)
 859
 860 (deftest :oodml/refresh/2
 861     (with-dataset *ds-employees*
 862       (let* ((clsql-sys:*default-caching* t)
 863              (addresses (select 'address :order-by [addressid] :flatp t :refresh t))
 864              (city (slot-value (car addresses) 'city)))
 865         (clsql:update-records [addr]
 866                               :av-pairs '((city_field "A new city"))
 867                               :where [= [addressid] (slot-value (car addresses) 'addressid)])
 868         (let* ((new-addresses (select 'address :order-by [addressid] :refresh t :flatp t))
 869                (new-city (slot-value (car addresses) 'city))
 870                )
 871           (clsql:update-records [addr]
 872                                 :av-pairs `((city_field ,city))
 873                                 :where [= [addressid] (slot-value (car addresses) 'addressid)])
 874           (values (equal addresses new-addresses)
 875                   city
 876                   new-city))))
 877   t "Leningrad" "A new city")
 878
 879 (deftest :oodml/refresh/3
 880     (with-dataset *ds-employees*
 881       (let* ((clsql-sys:*default-caching* t)
 882              (addresses (select 'address :order-by [addressid] :flatp t)))
 883         (values
 884           (equal addresses (select 'address :refresh t :flatp t))
 885           (equal addresses (select 'address :flatp t)))))
 886   nil nil)
 887
 888 (deftest :oodml/refresh/4
 889     (with-dataset *ds-employees*
 890       (let* ((clsql-sys:*default-caching* t)
 891              (addresses (select 'address :order-by [addressid] :flatp t :refresh t))
 892              (*db-auto-sync* t))
 893         (make-instance 'address :addressid 1000 :city "A new address city")
 894         (let ((new-addresses (select 'address :order-by [addressid] :flatp t :refresh t)))
 895           (values
 896             (length addresses)
 897             (length new-addresses)
 898             (eq (first addresses) (first new-addresses))
 899             (eq (second addresses) (second new-addresses))))))
 900   3 4 t t)
 901
 902
 903 (deftest :oodml/uoj/full-set
 904     (with-dataset *ds-employees*
 905       (progn
 906         (let* ((dea-list (select 'deferred-employee-address
 907                            :caching nil :order-by ["ea_join" aaddressid]
 908                            :flatp t))
 909                (dea-list-copy (copy-seq dea-list))
 910                (initially-unbound (every #'(lambda (dea) (not (slot-boundp dea 'address))) dea-list)))
 911           (update-objects-joins dea-list :slots 'address :max-len nil)
 912           (values
 913             initially-unbound
 914             (equal dea-list dea-list-copy)
 915             (every #'(lambda (dea) (slot-boundp dea 'address)) dea-list)
 916             (every #'(lambda (dea) (typep (slot-value dea 'address) 'address)) dea-list)
 917             (mapcar #'(lambda (dea) (slot-value (slot-value dea 'address) 'addressid)) dea-list)))))
 918   t t t t (1 1 2 2 2 3))
 919
 920 (deftest :oodml/uoj/batched
 921     (with-dataset *ds-employees*
 922       (progn
 923         (let* ((dea-list (select 'deferred-employee-address
 924                            :caching nil :order-by ["ea_join" aaddressid]
 925                            :flatp t))
 926                (dea-list-copy (copy-seq dea-list))
 927                (initially-unbound (every #'(lambda (dea) (not (slot-boundp dea 'address))) dea-list)))
 928           (update-objects-joins dea-list :slots 'address :max-len 2)
 929           (values
 930            initially-unbound
 931            (equal dea-list dea-list-copy)
 932            (every #'(lambda (dea) (slot-boundp dea 'address)) dea-list)
 933            (every #'(lambda (dea) (typep (slot-value dea 'address) 'address)) dea-list)
 934            (mapcar #'(lambda (dea) (slot-value (slot-value dea 'address) 'addressid)) dea-list)))))
 935   t t t t (1 1 2 2 2 3))
 936
 937 ;; update-object-joins needs to be fixed for multiple keys
 938 #+ignore
 939 (deftest :oodml/uoj/multi-key
 940     (progn
 941       (clsql:update-objects-joins (list company1))
 942       (mapcar #'(lambda (e)
 943                   (slot-value e 'ecompanyid))
 944               (company-employees company1)))
 945   (1 1 1 1 1 1 1 1 1 1))
 946
 947 (deftest :oodml/big/1
 948     (with-dataset *ds-big*
 949       (let ((objs (clsql:select 'big :order-by [i] :flatp t)))
 950         (values
 951           (length objs)
 952           (do ((i 0 (1+ i))
 953                (max (expt 2 60))
 954                (rest objs (cdr rest)))
 955               ((= i (length objs)) t)
 956             (let ((obj (car rest))
 957                   (index (1+ i)))
 958               (unless (and (eql (slot-value obj 'i) index)
 959                            (eql (slot-value obj 'bi) (truncate max index)))
 960                 (print index)
 961                 (describe obj)
 962                 (return nil)))))))
 963   555 t)
 964
 965 (deftest :oodml/db-auto-sync/1
 966     (with-dataset *ds-employees*
 967       (values
 968         (progn
 969           (make-instance 'employee :emplid 20 :groupid 1
 970                          :last-name "Ivanovich")
 971           (select [last-name] :from [employee] :where [= [emplid] 20]
 972                   :flatp t :field-names nil))
 973         (let ((*db-auto-sync* t))
 974           (make-instance 'employee :emplid 20 :groupid 1
 975                          :last-name "Ivanovich")
 976           (prog1 (select [last-name] :from [employee] :flatp t
 977                          :field-names nil
 978                          :where [= [emplid] 20])
 979             (delete-records :from [employee] :where [= [emplid] 20])))))
 980   nil ("Ivanovich"))
 981
 982 (deftest :oodml/db-auto-sync/2
 983     (with-dataset *ds-employees*
 984       (values
 985         (let ((instance (make-instance 'employee :emplid 20 :groupid 1
 986                                        :last-name "Ivanovich")))
 987           (setf (slot-value instance 'last-name) "Bulgakov")
 988           (select [last-name] :from [employee] :where [= [emplid] 20]
 989                   :flatp t :field-names nil))
 990         (let* ((*db-auto-sync* t)
 991                (instance (make-instance 'employee :emplid 20 :groupid 1
 992                                         :last-name "Ivanovich")))
 993           (setf (slot-value instance 'last-name) "Bulgakov")
 994           (prog1 (select [last-name] :from [employee] :flatp t
 995                          :field-names nil
 996                          :where [= [emplid] 20])
 997             (delete-records :from [employee] :where [= [emplid] 20])))))
 998   nil ("Bulgakov"))
 999
1000 (deftest :oodml/db-auto-sync/3
1001     (with-dataset *ds-nodes*
1002       (values
1003         (progn
1004           (make-instance 'theme :title "test-theme" :vars "test-vars"
1005                          :doc "test-doc")
1006           (select [node-id] :from [node] :where [= [title] "test-theme"]
1007                   :flatp t :field-names nil))
1008         (let ((*db-auto-sync* t))
1009           (make-instance 'theme :title "test-theme" :vars "test-vars"
1010                          :doc "test-doc")
1011           (prog1 (select [title] :from [node] :where [= [title] "test-theme"]
1012                          :flatp t :field-names nil)
1013             (delete-records :from [node] :where [= [title] "test-theme"])
1014             (delete-records :from [setting] :where [= [vars] "test-vars"])
1015             (delete-records :from [theme] :where [= [doc] "test-doc"])))))
1016   nil ("test-theme"))
1017
1018 (deftest :oodml/db-auto-sync/4
1019     (with-dataset *ds-nodes*
1020       (values
1021         (let ((inst (make-instance 'theme
1022                                    :title "test-theme" :vars "test-vars"
1023                                    :doc "test-doc"))
1024               (*print-circle* nil))
1025           (setf (slot-value inst 'title) "alternate-test-theme")
1026           (format nil "~a ~a ~a ~a"
1027                   (or (select [title] :from [node]
1028                               :where [= [title] "test-theme"]
1029                               :flatp t :field-names nil) "NIL")
1030                   (or (select [vars] :from [setting]
1031                               :where [= [vars] "test-vars"]
1032                               :flatp t :field-names nil) "NIL")
1033                   (or (select [doc] :from [theme]
1034                               :where [= [doc] "test-doc"]
1035                               :flatp t :field-names nil) "NIL")
1036                   (or (select [title] :from [node]
1037                               :where [= [title] "alternate-test-theme"]
1038                               :flatp t :field-names nil) "NIL")))
1039         (let* ((*db-auto-sync* t)
1040                (inst (make-instance 'theme
1041                                     :title "test-theme" :vars "test-vars"
1042                                     :doc "test-doc")))
1043           (setf (slot-value inst 'title) "alternate-test-theme")
1044           (prog1
1045               (format nil "~a ~a ~a ~a"
1046                       (or (select [title] :from [node]
1047                                   :where [= [title] "test-theme"]
1048                                   :flatp t :field-names nil) "NIL")
1049                       (or (select [vars] :from [setting]
1050                                   :where [= [vars] "test-vars"]
1051                                   :flatp t :field-names nil) "NIL")
1052                       (or (select [doc] :from [theme]
1053                                   :where [= [doc] "test-doc"]
1054                                   :flatp t :field-names nil) "NIL")
1055                       (or (select [title] :from [node]
1056                                   :where [= [title] "alternate-test-theme"]
1057                                   :flatp t :field-names nil) "NIL"))
1058             (delete-records :from [node] :where [= [title] "alternate-test-theme"])
1059             (delete-records :from [setting] :where [= [vars] "test-vars"])
1060             (delete-records :from [theme] :where [= [doc] "test-doc"])))))
1061   "NIL NIL NIL NIL"
1062   "NIL (test-vars) (test-doc) (alternate-test-theme)")
1063
1064 (deftest :oodml/setf-slot-value/1
1065     (with-dataset *ds-employees*
1066       (let* ((*db-auto-sync* t)
1067              (instance (make-instance 'employee :emplid 20 :groupid 1)))
1068         (prog1
1069             (setf
1070              (slot-value instance 'first-name) "Mikhail"
1071              (slot-value instance 'last-name) "Bulgakov")
1072           (delete-records :from [employee] :where [= [emplid] 20]))))
1073   "Bulgakov")
1074
1075 (deftest :oodml/float/1
1076     (with-dataset *ds-employees*
1077       (let* ((emp1 (car (select 'employee
1078                                 :where [= [slot-value 'employee 'emplid]
1079                                           1]
1080                                 :flatp t
1081                                 :caching nil)))
1082              (height (slot-value emp1 'height)))
1083         (prog1
1084             (progn
1085               (setf (slot-value emp1 'height) 1.0E0)
1086               (clsql:update-record-from-slot emp1 'height)
1087               (= (car (clsql:select [height] :from [employee]
1088                                     :where [= [emplid] 1]
1089                                     :flatp t
1090                                     :field-names nil))
1091                  1))
1092           (setf (slot-value emp1 'height) height)
1093           (clsql:update-record-from-slot emp1 'height))))
1094   t)
1095
1096 (deftest :oodml/float/2
1097     (with-dataset *ds-employees*
1098       (let* ((emp1 (car (select 'employee
1099                                 :where [= [slot-value 'employee 'emplid]
1100                                           1]
1101                                 :flatp t
1102                                 :caching nil)))
1103              (height (slot-value emp1 'height)))
1104         (prog1
1105             (progn
1106               (setf (slot-value emp1 'height) 1.0S0)
1107               (clsql:update-record-from-slot emp1 'height)
1108               (= (car (clsql:select [height] :from [employee]
1109                                     :where [= [emplid] 1]
1110                                     :flatp t
1111                                     :field-names nil))
1112                  1))
1113           (setf (slot-value emp1 'height) height)
1114           (clsql:update-record-from-slot emp1 'height))))
1115   t)
1116
1117 (deftest :oodml/float/3
1118     (with-dataset *ds-employees*
1119       (let* ((emp1 (car (select 'employee
1120                                 :where [= [slot-value 'employee 'emplid]
1121                                           1]
1122                                 :flatp t
1123                                 :caching nil)))
1124              (height (slot-value emp1 'height)))
1125         (prog1
1126             (progn
1127               (setf (slot-value emp1 'height) 1.0F0)
1128               (clsql:update-record-from-slot emp1 'height)
1129               (= (car (clsql:select [height] :from [employee]
1130                                     :where [= [emplid] 1]
1131                                     :flatp t
1132                                     :field-names nil))
1133                  1))
1134           (setf (slot-value emp1 'height) height)
1135           (clsql:update-record-from-slot emp1 'height))))
1136   t)
1137
1138 (deftest :oodml/float/4
1139     (with-dataset *ds-employees*
1140       (let* ((emp1 (car (select 'employee
1141                                 :where [= [slot-value 'employee 'emplid]
1142                                           1]
1143                                 :flatp t
1144                                 :caching nil)))
1145              (height (slot-value emp1 'height)))
1146         (prog1
1147             (progn
1148               (setf (slot-value emp1 'height) 1.0D0)
1149               (clsql:update-record-from-slot emp1 'height)
1150               (= (car (clsql:select [height] :from [employee]
1151                                     :where [= [emplid] 1]
1152                                     :flatp t
1153                                     :field-names nil))
1154                  1))
1155           (setf (slot-value emp1 'height) height)
1156           (clsql:update-record-from-slot emp1 'height))))
1157   t)
1158
1159 (deftest :oodml/float/5
1160     (with-dataset *ds-employees*
1161       (let* ((emp1 (car (select 'employee
1162                                 :where [= [slot-value 'employee 'emplid]
1163                                           1]
1164                                 :flatp t
1165                                 :caching nil)))
1166              (height (slot-value emp1 'height)))
1167         (prog1
1168             (progn
1169               (setf (slot-value emp1 'height) 1.0L0)
1170               (clsql:update-record-from-slot emp1 'height)
1171               (= (car (clsql:select [height] :from [employee]
1172                                     :where [= [emplid] 1]
1173                                     :flatp t
1174                                     :field-names nil))
1175                  1))
1176           (setf (slot-value emp1 'height) height)
1177           (clsql:update-record-from-slot emp1 'height))))
1178   t)
1179 ))
1180
1181