tests/test-oodml.lisp

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