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 ;;;; Updated: $Id$
   7 ;;;;
   8 ;;;; Tests for the CLSQL Object Oriented Data Definition Language
   9 ;;;; (OODML).
  10 ;;;;
  11 ;;;; This file is part of CLSQL.
  12 ;;;;
  13 ;;;; CLSQL users are granted the rights to distribute and use this software
  14 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
  15 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
  16 ;;;; ======================================================================
  17
  18 (in-package #:clsql-tests)
  19
  20 #.(clsql:locally-enable-sql-reader-syntax)
  21
  22 (setq *rt-oodml*
  23       '(
  24
  25         (deftest :oodml/select/1
  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             (mapcar #'(lambda (e) (slot-value e 'name))
  33              (clsql:select 'company :flatp t :caching nil))
  34           ("Widgets Inc."))
  35
  36         (deftest :oodml/select/3
  37             (mapcar #'(lambda (e) (slot-value e 'ecompanyid))
  38              (clsql:select 'employee
  39                            :where [and [= [slot-value 'employee 'ecompanyid]
  40                                           [slot-value 'company 'companyid]]
  41                                        [= [slot-value 'company 'name]
  42                                           "Widgets Inc."]]
  43                            :flatp t
  44                            :caching nil))
  45           (1 1 1 1 1 1 1 1 1 1))
  46
  47         (deftest :oodml/select/4
  48             (mapcar #'(lambda (e)
  49                         (concatenate 'string (slot-value e 'first-name)
  50                                      " "
  51                                      (slot-value e 'last-name)))
  52              (clsql:select 'employee :where [= [slot-value 'employee 'first-name]
  53                                                "Vladimir"]
  54                            :flatp t
  55                            :order-by [last-name]
  56                            :caching nil))
  57           ("Vladimir Lenin" "Vladimir Putin"))
  58
  59         (deftest :oodml/select/5
  60             (length (clsql:select 'employee :where [married] :flatp t :caching nil))
  61           3)
  62
  63         (deftest :oodml/select/6
  64             (let ((a (caar (clsql:select 'address :where [= 1 [addressid]] :caching nil))))
  65               (values
  66                (slot-value a 'street-number)
  67                (slot-value a 'street-name)
  68                (slot-value a 'city)
  69                (slot-value a 'postal-code)))
  70           10 "Park Place" "Leningrad" 123)
  71
  72         (deftest :oodml/select/7
  73             (let ((a (caar (clsql:select 'address :where [= 2 [addressid]] :caching nil))))
  74               (values
  75                (slot-value a 'street-number)
  76                (slot-value a 'street-name)
  77                (slot-value a 'city)
  78                (slot-value a 'postal-code)))
  79           nil "" "no city" 0)
  80
  81         (deftest :oodml/select/8
  82             (mapcar #'(lambda (e) (slot-value e 'married))
  83              (clsql:select 'employee :flatp t :order-by [emplid] :caching nil))
  84           (t t t nil nil nil nil nil nil nil))
  85
  86         (deftest :oodml/select/9
  87             (mapcar #'(lambda (pair)
  88                         (list
  89                          (typep (car pair) 'address)
  90                          (typep (second pair) 'employee-address)
  91                          (slot-value (car pair) 'addressid)
  92                          (slot-value (second pair) 'aaddressid)
  93                          (slot-value (second pair) 'aemplid)))
  94              (employee-addresses employee1))
  95           ((t t 1 1 1) (t t 2 2 1)))
  96
  97         (deftest :oodml/select/10
  98             (mapcar #'(lambda (pair)
  99                         (list
 100                          (typep (car pair) 'address)
 101                          (typep (second pair) 'employee-address)
 102                          (slot-value (car pair) 'addressid)
 103                          (slot-value (second pair) 'aaddressid)
 104                          (slot-value (second pair) 'aemplid)))
 105              (employee-addresses employee2))
 106           ((t t 2 2 2)))
 107
 108         (deftest :oodml/select/11
 109          (values (mapcar #'(lambda (x) (slot-value x 'emplid))
 110                          (clsql:select 'employee :order-by '(([emplid] :asc))
 111                                        :flatp t))
 112           (mapcar #'(lambda (x) (slot-value x 'emplid))
 113            (clsql:select 'employee :order-by '(([emplid] :desc))
 114                          :flatp t)))
 115          (1 2 3 4 5 6 7 8 9 10)
 116          (10 9 8 7 6 5 4 3 2 1))
 117
 118         ;; test retrieval is deferred
 119         (deftest :oodm/retrieval/1
 120             (every #'(lambda (e) (not (slot-boundp e 'company)))
 121              (select 'employee :flatp t :caching nil))
 122           t)
 123
 124         (deftest :oodm/retrieval/2
 125             (every #'(lambda (e) (not (slot-boundp e 'address)))
 126              (select 'deferred-employee-address :flatp t :caching nil))
 127           t)
 128
 129         ;; :retrieval :immediate should be boundp before accessed
 130         (deftest :oodm/retrieval/3
 131             (every #'(lambda (ea) (slot-boundp ea 'address))
 132              (select 'employee-address :flatp t :caching nil))
 133           t)
 134
 135         (deftest :oodm/retrieval/4
 136             (mapcar #'(lambda (ea) (typep (slot-value ea 'address) 'address))
 137              (select 'employee-address :flatp t :caching nil))
 138           (t t t t t))
 139
 140         (deftest :oodm/retrieval/5
 141             (mapcar #'(lambda (ea) (typep (slot-value ea 'address) 'address))
 142              (select 'deferred-employee-address :flatp t :caching nil))
 143           (t t t t t))
 144
 145         (deftest :oodm/retrieval/6
 146             (every #'(lambda (ea) (slot-boundp (slot-value ea 'address) 'addressid))
 147              (select 'employee-address :flatp t :caching nil))
 148           t)
 149
 150         (deftest :oodm/retrieval/7
 151             (every #'(lambda (ea) (slot-boundp (slot-value ea 'address) 'addressid))
 152              (select 'deferred-employee-address :flatp t :caching nil))
 153           t)
 154
 155         (deftest :oodm/retrieval/8
 156             (mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number))
 157              (select 'employee-address :flatp t :order-by [aaddressid] :caching nil))
 158           (10 10 nil nil nil))
 159
 160         (deftest :oodm/retrieval/9
 161             (mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number))
 162              (select 'deferred-employee-address :flatp t :order-by [aaddressid] :caching nil))
 163           (10 10 nil nil nil))
 164
 165         ;; tests update-records-from-instance
 166         (deftest :oodml/update-records/1
 167             (values
 168              (progn
 169                (let ((lenin (car (clsql:select 'employee
 170                                                :where [= [slot-value 'employee 'emplid]
 171                                                          1]
 172                                                :flatp t
 173                                                :caching nil))))
 174                  (concatenate 'string
 175                               (first-name lenin)
 176                               " "
 177                               (last-name lenin)
 178                               ": "
 179                               (employee-email lenin))))
 180              (progn
 181                (setf (slot-value employee1 'first-name) "Dimitriy"
 182                      (slot-value employee1 'last-name) "Ivanovich"
 183                      (slot-value employee1 'email) "ivanovich@soviet.org")
 184                (clsql:update-records-from-instance employee1)
 185                (let ((lenin (car (clsql:select 'employee
 186                                                :where [= [slot-value 'employee 'emplid]
 187                                                          1]
 188                                                :flatp t
 189                                                :caching nil))))
 190                  (concatenate 'string
 191                               (first-name lenin)
 192                               " "
 193                               (last-name lenin)
 194                               ": "
 195                               (employee-email lenin))))
 196              (progn
 197                (setf (slot-value employee1 'first-name) "Vladimir"
 198                      (slot-value employee1 'last-name) "Lenin"
 199                      (slot-value employee1 'email) "lenin@soviet.org")
 200                (clsql:update-records-from-instance employee1)
 201                (let ((lenin (car (clsql:select 'employee
 202                                                :where [= [slot-value 'employee 'emplid]
 203                                                          1]
 204                                                :flatp t
 205                                                :caching nil))))
 206                  (concatenate 'string
 207                               (first-name lenin)
 208                               " "
 209                               (last-name lenin)
 210                               ": "
 211                               (employee-email lenin)))))
 212           "Vladimir Lenin: lenin@soviet.org"
 213           "Dimitriy Ivanovich: ivanovich@soviet.org"
 214           "Vladimir Lenin: lenin@soviet.org")
 215
 216         ;; tests update-record-from-slot
 217         (deftest :oodml/update-records/2
 218             (values
 219              (employee-email
 220               (car (clsql:select 'employee
 221                                  :where [= [slot-value 'employee 'emplid] 1]
 222                                  :flatp t
 223                                  :caching nil)))
 224              (progn
 225                (setf (slot-value employee1 'email) "lenin-nospam@soviet.org")
 226                (clsql:update-record-from-slot employee1 'email)
 227                (employee-email
 228                 (car (clsql:select 'employee
 229                                    :where [= [slot-value 'employee 'emplid] 1]
 230                                    :flatp t
 231                                    :caching nil))))
 232              (progn
 233                (setf (slot-value employee1 'email) "lenin@soviet.org")
 234                (clsql:update-record-from-slot employee1 'email)
 235                (employee-email
 236                 (car (clsql:select 'employee
 237                                    :where [= [slot-value 'employee 'emplid] 1]
 238                                    :flatp t
 239                                    :caching nil)))))
 240           "lenin@soviet.org" "lenin-nospam@soviet.org" "lenin@soviet.org")
 241
 242         ;; tests update-record-from-slots
 243         (deftest :oodml/update-records/3
 244             (values
 245              (let ((lenin (car (clsql:select 'employee
 246                                              :where [= [slot-value 'employee 'emplid]
 247                                                        1]
 248                                              :flatp t
 249                                              :caching nil))))
 250                (concatenate 'string
 251                             (first-name lenin)
 252                             " "
 253                             (last-name lenin)
 254                             ": "
 255                             (employee-email lenin)))
 256              (progn
 257                (setf (slot-value employee1 'first-name) "Dimitriy"
 258                      (slot-value employee1 'last-name) "Ivanovich"
 259                      (slot-value employee1 'email) "ivanovich@soviet.org")
 260                (clsql:update-record-from-slots employee1 '(first-name last-name email))
 261                (let ((lenin (car (clsql:select 'employee
 262                                                :where [= [slot-value 'employee 'emplid]
 263                                                          1]
 264                                                :flatp t
 265                                                :caching nil))))
 266                  (concatenate 'string
 267                               (first-name lenin)
 268                               " "
 269                               (last-name lenin)
 270                               ": "
 271                               (employee-email lenin))))
 272              (progn
 273                (setf (slot-value employee1 'first-name) "Vladimir"
 274                      (slot-value employee1 'last-name) "Lenin"
 275                      (slot-value employee1 'email) "lenin@soviet.org")
 276                (clsql:update-record-from-slots employee1 '(first-name last-name email))
 277                (let ((lenin (car (clsql:select 'employee
 278                                                :where [= [slot-value 'employee 'emplid]
 279                                                          1]
 280                                                :flatp t
 281                                                :caching nil))))
 282                  (concatenate 'string
 283                               (first-name lenin)
 284                               " "
 285                               (last-name lenin)
 286                               ": "
 287                               (employee-email lenin)))))
 288           "Vladimir Lenin: lenin@soviet.org"
 289           "Dimitriy Ivanovich: ivanovich@soviet.org"
 290           "Vladimir Lenin: lenin@soviet.org")
 291
 292         ;; tests update-instance-from-records
 293         (deftest :oodml/update-instance/1
 294             (values
 295              (concatenate 'string
 296                           (slot-value employee1 'first-name)
 297                           " "
 298                           (slot-value employee1 'last-name)
 299                           ": "
 300                           (slot-value employee1 'email))
 301              (progn
 302                (clsql:update-records [employee]
 303                                      :av-pairs '(([first-name] "Ivan")
 304                                                  ([last-name] "Petrov")
 305                                                  ([email] "petrov@soviet.org"))
 306                                      :where [= [emplid] 1])
 307                (clsql:update-instance-from-records employee1)
 308                (concatenate 'string
 309                             (slot-value employee1 'first-name)
 310                             " "
 311                             (slot-value employee1 'last-name)
 312                             ": "
 313                             (slot-value employee1 'email)))
 314              (progn
 315                (clsql:update-records [employee]
 316                                      :av-pairs '(([first-name] "Vladimir")
 317                                                  ([last-name] "Lenin")
 318                                                  ([email] "lenin@soviet.org"))
 319                                      :where [= [emplid] 1])
 320                (clsql:update-instance-from-records employee1)
 321                (concatenate 'string
 322                             (slot-value employee1 'first-name)
 323                             " "
 324                             (slot-value employee1 'last-name)
 325                             ": "
 326                             (slot-value employee1 'email))))
 327           "Vladimir Lenin: lenin@soviet.org"
 328           "Ivan Petrov: petrov@soviet.org"
 329           "Vladimir Lenin: lenin@soviet.org")
 330
 331         ;; tests update-slot-from-record
 332         (deftest :oodml/update-instance/2
 333             (values
 334              (slot-value employee1 'email)
 335              (progn
 336                (clsql:update-records [employee]
 337                                      :av-pairs '(([email] "lenin-nospam@soviet.org"))
 338                                      :where [= [emplid] 1])
 339                (clsql:update-slot-from-record employee1 'email)
 340                (slot-value employee1 'email))
 341              (progn
 342                (clsql:update-records [employee]
 343                                      :av-pairs '(([email] "lenin@soviet.org"))
 344                                      :where [= [emplid] 1])
 345                (clsql:update-slot-from-record employee1 'email)
 346                (slot-value employee1 'email)))
 347           "lenin@soviet.org" "lenin-nospam@soviet.org" "lenin@soviet.org")
 348
 349
 350         (deftest :oodml/do-query/1
 351             (let ((result '()))
 352               (clsql:do-query ((e) [select 'employee :order-by [emplid]])
 353                 (push (slot-value e 'last-name) result))
 354               result)
 355           ("Putin" "Yeltsin" "Gorbachev" "Chernenko" "Andropov" "Brezhnev" "Kruschev"
 356            "Trotsky" "Stalin" "Lenin"))
 357
 358         (deftest :oodml/do-query/2
 359             (let ((result '()))
 360               (clsql:do-query ((e c) [select 'employee 'company
 361                                              :where [= [slot-value 'employee 'last-name]
 362                                                        "Lenin"]])
 363                 (push (list (slot-value e 'last-name) (slot-value c 'name))
 364                       result))
 365               result)
 366           (("Lenin" "Widgets Inc.")))
 367
 368         (deftest :oodml/map-query/1
 369             (clsql:map-query 'list #'last-name [select 'employee :order-by [emplid]])
 370           ("Lenin" "Stalin" "Trotsky" "Kruschev" "Brezhnev" "Andropov" "Chernenko"
 371            "Gorbachev" "Yeltsin" "Putin"))
 372
 373         (deftest :oodml/map-query/2
 374             (clsql:map-query 'list #'(lambda (e c) (list (slot-value e 'last-name)
 375                                                          (slot-value c 'name)))
 376              [select 'employee 'company :where [= [slot-value 'employee 'last-name]
 377                                                   "Lenin"]])
 378           (("Lenin" "Widgets Inc.")))
 379
 380         (deftest :oodml/iteration/3
 381             (loop for (e) being the records in
 382              [select 'employee :where [< [emplid] 4] :order-by [emplid]]
 383              collect (slot-value e 'last-name))
 384           ("Lenin" "Stalin" "Trotsky"))
 385
 386
 387       (deftest :oodml/cache/1
 388           (progn
 389             (setf (clsql-sys:record-caches *default-database*) nil)
 390             (let ((employees (select 'employee)))
 391               (every #'(lambda (a b) (eq a b))
 392                      employees (select 'employee))))
 393         t)
 394
 395         (deftest :oodml/cache/2
 396             (let ((employees (select 'employee)))
 397               (equal employees (select 'employee :flatp t)))
 398           nil)
 399
 400         (deftest :oodml/refresh/1
 401             (let ((addresses (select 'address)))
 402               (equal addresses (select 'address :refresh t)))
 403           t)
 404
 405         (deftest :oodml/refresh/2
 406             (let* ((addresses (select 'address :order-by [addressid] :flatp t :refresh t))
 407                    (city (slot-value (car addresses) 'city)))
 408               (clsql:update-records [addr]
 409                               :av-pairs '((city_field "A new city"))
 410                               :where [= [addressid] (slot-value (car addresses) 'addressid)])
 411               (let* ((new-addresses (select 'address :order-by [addressid] :refresh t :flatp t))
 412                      (new-city (slot-value (car addresses) 'city))
 413 )
 414                 (clsql:update-records [addr]
 415                                       :av-pairs `((city_field ,city))
 416                                       :where [= [addressid] (slot-value (car addresses) 'addressid)])
 417                 (values (equal addresses new-addresses)
 418                         city
 419                         new-city)))
 420           t "Leningrad" "A new city")
 421
 422         (deftest :oodml/refresh/3
 423             (let* ((addresses (select 'address :order-by [addressid] :flatp t)))
 424               (values
 425                (equal addresses (select 'address :refresh t :flatp t))
 426                (equal addresses (select 'address :flatp t))))
 427           nil nil)
 428
 429         (deftest :oodml/refresh/4
 430             (let* ((addresses (select 'address :order-by [addressid] :flatp t :refresh t))
 431                    (*db-auto-sync* t))
 432               (make-instance 'address :addressid 1000 :city "A new address city")
 433               (let ((new-addresses (select 'address :order-by [addressid] :flatp t :refresh t)))
 434                 (delete-records :from [addr] :where [= [addressid] 1000])
 435                 (values
 436                  (length addresses)
 437                  (length new-addresses)
 438                  (eq (first addresses) (first new-addresses))
 439                  (eq (second addresses) (second new-addresses)))))
 440           2 3 t t)
 441
 442
 443         (deftest :oodml/uoj/1
 444             (progn
 445               (let* ((dea-list (select 'deferred-employee-address :caching nil :order-by ["ea_join" aaddressid]
 446                                        :flatp t))
 447                      (dea-list-copy (copy-seq dea-list))
 448                      (initially-unbound (every #'(lambda (dea) (not (slot-boundp dea 'address))) dea-list)))
 449                 (update-objects-joins dea-list)
 450                 (values
 451                  initially-unbound
 452                  (equal dea-list dea-list-copy)
 453                  (every #'(lambda (dea) (slot-boundp dea 'address)) dea-list)
 454                  (every #'(lambda (dea) (typep (slot-value dea 'address) 'address)) dea-list)
 455                  (mapcar #'(lambda (dea) (slot-value (slot-value dea 'address) 'addressid)) dea-list))))
 456           t t t t (1 1 2 2 2))
 457
 458         ;; update-object-joins needs to be fixed for multiple keys
 459         #+ignore
 460         (deftest :oodml/uoj/2
 461             (progn
 462               (clsql:update-objects-joins (list company1))
 463               (mapcar #'(lambda (e)
 464                           (slot-value e 'ecompanyid))
 465                  (company-employees company1)))
 466           (1 1 1 1 1 1 1 1 1 1))
 467
 468         (deftest :oodml/big/1
 469             (let ((objs (clsql:select 'big :order-by [i] :flatp t)))
 470               (values
 471                (length objs)
 472                (do ((i 0 (1+ i))
 473                     (max (expt 2 60))
 474                     (rest objs (cdr rest)))
 475                    ((= i (length objs)) t)
 476                  (let ((obj (car rest))
 477                        (index (1+ i)))
 478                    (unless (and (eql (slot-value obj 'i) index)
 479                                 (eql (slot-value obj 'bi) (truncate max index)))
 480                      (print index)
 481                      (describe obj)
 482                      (return nil))))))
 483           555 t)
 484
 485         (deftest :oodml/db-auto-sync/1
 486             (values
 487               (progn
 488                 (make-instance 'employee :emplid 20 :groupid 1
 489                                :last-name "Ivanovich")
 490                 (select [last-name] :from [employee] :where [= [emplid] 20]
 491                         :flatp t :field-names nil))
 492              (let ((*db-auto-sync* t))
 493                (make-instance 'employee :emplid 20 :groupid 1
 494                               :last-name "Ivanovich")
 495                (prog1 (select [last-name] :from [employee] :flatp t
 496                               :field-names nil
 497                               :where [= [emplid] 20])
 498                  (delete-records :from [employee] :where [= [emplid] 20]))))
 499           nil ("Ivanovich"))
 500
 501         (deftest :oodml/db-auto-sync/2
 502             (values
 503              (let ((instance (make-instance 'employee :emplid 20 :groupid 1
 504                                             :last-name "Ivanovich")))
 505                (setf (slot-value instance 'last-name) "Bulgakov")
 506                (select [last-name] :from [employee] :where [= [emplid] 20]
 507                        :flatp t :field-names nil))
 508              (let* ((*db-auto-sync* t)
 509                     (instance (make-instance 'employee :emplid 20 :groupid 1
 510                                              :last-name "Ivanovich")))
 511                (setf (slot-value instance 'last-name) "Bulgakov")
 512                (prog1 (select [last-name] :from [employee] :flatp t
 513                               :field-names nil
 514                               :where [= [emplid] 20])
 515                  (delete-records :from [employee] :where [= [emplid] 20]))))
 516           nil ("Bulgakov"))
 517
 518         (deftest :oodml/setf-slot-value/1
 519             (let* ((*db-auto-sync* t)
 520                    (instance (make-instance 'employee :emplid 20 :groupid 1)))
 521               (prog1
 522                   (setf
 523                    (slot-value instance 'first-name) "Mikhail"
 524                    (slot-value instance 'last-name) "Bulgakov")
 525                 (delete-records :from [employee] :where [= [emplid] 20])))
 526           "Bulgakov")
 527
 528         (deftest :oodml/float/1
 529             (let* ((emp1 (car (select 'employee
 530                                       :where [= [slot-value 'employee 'emplid]
 531                                                 1]
 532                                       :flatp t
 533                                       :caching nil)))
 534                    (height (slot-value emp1 'height)))
 535               (prog1
 536                   (progn
 537                     (setf (slot-value emp1 'height) 1.0E0)
 538                     (clsql:update-record-from-slot emp1 'height)
 539                     (= (car (clsql:select [height] :from [employee]
 540                                           :where [= [emplid] 1]
 541                                           :flatp t
 542                                           :field-names nil))
 543                        1))
 544                 (setf (slot-value emp1 'height) height)
 545                 (clsql:update-record-from-slot emp1 'height)))
 546          t)
 547
 548         (deftest :oodml/float/2
 549             (let* ((emp1 (car (select 'employee
 550                                      :where [= [slot-value 'employee 'emplid]
 551                                                1]
 552                                      :flatp t
 553                                      :caching nil)))
 554                    (height (slot-value emp1 'height)))
 555               (prog1
 556                   (progn
 557                     (setf (slot-value emp1 'height) 1.0S0)
 558                     (clsql:update-record-from-slot emp1 'height)
 559                     (= (car (clsql:select [height] :from [employee]
 560                                           :where [= [emplid] 1]
 561                                           :flatp t
 562                                           :field-names nil))
 563                        1))
 564                 (setf (slot-value emp1 'height) height)
 565                 (clsql:update-record-from-slot emp1 'height)))
 566          t)
 567
 568         (deftest :oodml/float/3
 569             (let* ((emp1 (car (select 'employee
 570                                      :where [= [slot-value 'employee 'emplid]
 571                                                1]
 572                                      :flatp t
 573                                      :caching nil)))
 574                    (height (slot-value emp1 'height)))
 575               (prog1
 576                   (progn
 577                     (setf (slot-value emp1 'height) 1.0F0)
 578                     (clsql:update-record-from-slot emp1 'height)
 579                     (= (car (clsql:select [height] :from [employee]
 580                                           :where [= [emplid] 1]
 581                                           :flatp t
 582                                           :field-names nil))
 583                        1))
 584                 (setf (slot-value emp1 'height) height)
 585                 (clsql:update-record-from-slot emp1 'height)))
 586           t)
 587
 588         (deftest :oodml/float/4
 589             (let* ((emp1 (car (select 'employee
 590                                      :where [= [slot-value 'employee 'emplid]
 591                                                1]
 592                                      :flatp t
 593                                      :caching nil)))
 594                    (height (slot-value emp1 'height)))
 595               (prog1
 596                   (progn
 597                     (setf (slot-value emp1 'height) 1.0D0)
 598                     (clsql:update-record-from-slot emp1 'height)
 599                     (= (car (clsql:select [height] :from [employee]
 600                                           :where [= [emplid] 1]
 601                                           :flatp t
 602                                           :field-names nil))
 603                        1))
 604                 (setf (slot-value emp1 'height) height)
 605                 (clsql:update-record-from-slot emp1 'height)))
 606          t)
 607
 608         (deftest :oodml/float/5
 609             (let* ((emp1 (car (select 'employee
 610                                       :where [= [slot-value 'employee 'emplid]
 611                                                 1]
 612                                       :flatp t
 613                                       :caching nil)))
 614                    (height (slot-value emp1 'height)))
 615               (prog1
 616                   (progn
 617                     (setf (slot-value emp1 'height) 1.0L0)
 618                     (clsql:update-record-from-slot emp1 'height)
 619                     (= (car (clsql:select [height] :from [employee]
 620                                           :where [= [emplid] 1]
 621                                           :flatp t
 622                                           :field-names nil))
 623                        1))
 624                 (setf (slot-value emp1 'height) height)
 625                 (clsql:update-record-from-slot emp1 'height)))
 626          t)
 627
 628         ))
 629
 630
 631
 632 #.(clsql:restore-sql-reader-syntax-state)