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               (format nil "~a ~a"
 748                       (slot-value loc2 'node-id)
 749                       (slot-value loc2 'title)))
 750             (progn
 751               (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
 752                                     :where [= [node-id] 9])
 753               (clsql:update-instance-from-records loc2)
 754               (format nil "~a ~a"
 755                       (slot-value loc2 'node-id)
 756                       (slot-value loc2 'title)))
 757             (progn
 758               (clsql:update-records [node] :av-pairs '(([title] "location-2"))
 759                                     :where [= [node-id] 9])
 760               (clsql:update-instance-from-records loc2)
 761               (format nil "~a ~a"
 762                       (slot-value loc2 'node-id)
 763                       (slot-value loc2 'title))))
 764           "9 location-2"
 765           "9 Altered title"
 766           "9 location-2")
 767
 768         (deftest :oodml/update-instance/5
 769           (values
 770             (format nil "~a ~a ~a"
 771                     (slot-value subloc2 'subloc-id)
 772                     (slot-value subloc2 'title)
 773                     (slot-value subloc2 'loc))
 774             (progn
 775               (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
 776                                     :where [= [node-id] 11])
 777               (clsql:update-records [subloc] :av-pairs '(([loc] "Altered loc"))
 778                                     :where [= [subloc-id] 11])
 779               (clsql:update-instance-from-records subloc2)
 780               (format nil "~a ~a ~a"
 781                       (slot-value subloc2 'subloc-id)
 782                       (slot-value subloc2 'title)
 783                       (slot-value subloc2 'loc)))
 784             (progn
 785               (clsql:update-records [node] :av-pairs '(([title] "subloc-2"))
 786                                     :where [= [node-id] 11])
 787               (clsql:update-records [subloc] :av-pairs '(([loc] "second subloc"))
 788                                     :where [= [subloc-id] 11])
 789               (clsql:update-instance-from-records subloc2)
 790               (format nil "~a ~a ~a"
 791                       (slot-value subloc2 'subloc-id)
 792                       (slot-value subloc2 'title)
 793                       (slot-value subloc2 'loc))))
 794           "11 subloc-2 second subloc"
 795           "11 Altered title Altered loc"
 796           "11 subloc-2 second subloc")
 797
 798         ;; tests update-slot-from-record with normalisedp stuff
 799         (deftest :oodml/update-instance/6
 800             (values
 801              (slot-value theme1 'doc)
 802              (slot-value theme1 'vars)
 803              (progn
 804                (clsql:update-records [theme]
 805                                      :av-pairs '(([doc] "altered doc"))
 806                                      :where [= [theme-id] 6])
 807                (clsql:update-slot-from-record theme1 'doc)
 808                (slot-value theme1 'doc))
 809              (progn
 810                (clsql:update-records [setting]
 811                                      :av-pairs '(([vars] "altered vars"))
 812                                      :where [= [setting-id] 6])
 813                (clsql:update-slot-from-record theme1 'vars)
 814                (slot-value theme1 'vars))
 815              (progn
 816                (clsql:update-records [theme]
 817                                      :av-pairs '(([doc] "first theme"))
 818                                      :where [= [theme-id] 6])
 819                (clsql:update-slot-from-record theme1 'doc)
 820                (slot-value theme1 'doc))
 821              (progn
 822                (clsql:update-records [setting]
 823                                      :av-pairs '(([vars] "empty"))
 824                                      :where [= [setting-id] 6])
 825                (clsql:update-slot-from-record theme1 'vars)
 826                (slot-value theme1 'vars)))
 827          "first theme" "empty"
 828          "altered doc" "altered vars"
 829          "first theme" "empty")
 830
 831         (deftest :oodml/update-instance/7
 832             (values
 833              (slot-value loc2 'title)
 834              (slot-value subloc2 'loc)
 835              (progn
 836                (clsql:update-records [node]
 837                                      :av-pairs '(([title] "altered title"))
 838                                      :where [= [node-id] 9])
 839                (clsql:update-slot-from-record loc2 'title)
 840                (slot-value loc2 'title))
 841              (progn
 842                (clsql:update-records [subloc]
 843                                      :av-pairs '(([loc] "altered loc"))
 844                                      :where [= [subloc-id] 11])
 845                (clsql:update-slot-from-record subloc2 'loc)
 846                (slot-value subloc2 'loc))
 847              (progn
 848                (clsql:update-records [node]
 849                                      :av-pairs '(([title] "location-2"))
 850                                      :where [= [node-id] 9])
 851                (clsql:update-slot-from-record loc2 'title)
 852                (slot-value loc2 'title))
 853              (progn
 854                (clsql:update-records [subloc]
 855                                      :av-pairs '(([loc] "second subloc"))
 856                                      :where [= [subloc-id] 11])
 857                (clsql:update-slot-from-record subloc2 'loc)
 858                (slot-value subloc2 'loc)))
 859          "location-2" "second subloc"
 860                  "altered title" "altered loc"
 861          "location-2" "second subloc")
 862
 863         (deftest :oodml/do-query/1
 864             (let ((result '()))
 865               (clsql:do-query ((e) [select 'employee :order-by [emplid]])
 866                 (push (slot-value e 'last-name) result))
 867               result)
 868           ("Putin" "Yeltsin" "Gorbachev" "Chernenko" "Andropov" "Brezhnev" "Kruschev"
 869            "Trotsky" "Stalin" "Lenin"))
 870
 871         (deftest :oodml/do-query/2
 872             (let ((result '()))
 873               (clsql:do-query ((e c) [select 'employee 'company
 874                                              :where [= [slot-value 'employee 'last-name]
 875                                                        "Lenin"]])
 876                 (push (list (slot-value e 'last-name) (slot-value c 'name))
 877                       result))
 878               result)
 879           (("Lenin" "Widgets Inc.")))
 880
 881         (deftest :oodml/map-query/1
 882             (clsql:map-query 'list #'last-name [select 'employee :order-by [emplid]])
 883           ("Lenin" "Stalin" "Trotsky" "Kruschev" "Brezhnev" "Andropov" "Chernenko"
 884            "Gorbachev" "Yeltsin" "Putin"))
 885
 886         (deftest :oodml/map-query/2
 887             (clsql:map-query 'list #'(lambda (e c) (list (slot-value e 'last-name)
 888                                                          (slot-value c 'name)))
 889              [select 'employee 'company :where [= [slot-value 'employee 'last-name]
 890                                                   "Lenin"]])
 891           (("Lenin" "Widgets Inc.")))
 892
 893         (deftest :oodml/iteration/3
 894             (loop for (e) being the records in
 895              [select 'employee :where [< [emplid] 4] :order-by [emplid]]
 896              collect (slot-value e 'last-name))
 897           ("Lenin" "Stalin" "Trotsky"))
 898
 899
 900       (deftest :oodml/cache/1
 901           (progn
 902             (setf (clsql-sys:record-caches *default-database*) nil)
 903             (let ((employees (select 'employee)))
 904               (every #'(lambda (a b) (eq a b))
 905                      employees (select 'employee))))
 906         t)
 907
 908         (deftest :oodml/cache/2
 909             (let ((employees (select 'employee)))
 910               (equal employees (select 'employee :flatp t)))
 911           nil)
 912
 913         (deftest :oodml/refresh/1
 914             (let ((addresses (select 'address)))
 915               (equal addresses (select 'address :refresh t)))
 916           t)
 917
 918         (deftest :oodml/refresh/2
 919             (let* ((addresses (select 'address :order-by [addressid] :flatp t :refresh t))
 920                    (city (slot-value (car addresses) 'city)))
 921               (clsql:update-records [addr]
 922                               :av-pairs '((city_field "A new city"))
 923                               :where [= [addressid] (slot-value (car addresses) 'addressid)])
 924               (let* ((new-addresses (select 'address :order-by [addressid] :refresh t :flatp t))
 925                      (new-city (slot-value (car addresses) 'city))
 926 )
 927                 (clsql:update-records [addr]
 928                                       :av-pairs `((city_field ,city))
 929                                       :where [= [addressid] (slot-value (car addresses) 'addressid)])
 930                 (values (equal addresses new-addresses)
 931                         city
 932                         new-city)))
 933           t "Leningrad" "A new city")
 934
 935         (deftest :oodml/refresh/3
 936             (let* ((addresses (select 'address :order-by [addressid] :flatp t)))
 937               (values
 938                (equal addresses (select 'address :refresh t :flatp t))
 939                (equal addresses (select 'address :flatp t))))
 940           nil nil)
 941
 942         (deftest :oodml/refresh/4
 943             (let* ((addresses (select 'address :order-by [addressid] :flatp t :refresh t))
 944                    (*db-auto-sync* t))
 945               (make-instance 'address :addressid 1000 :city "A new address city")
 946               (let ((new-addresses (select 'address :order-by [addressid] :flatp t :refresh t)))
 947                 (delete-records :from [addr] :where [= [addressid] 1000])
 948                 (values
 949                  (length addresses)
 950                  (length new-addresses)
 951                  (eq (first addresses) (first new-addresses))
 952                  (eq (second addresses) (second new-addresses)))))
 953           2 3 t t)
 954
 955
 956         (deftest :oodml/uoj/1
 957             (progn
 958               (let* ((dea-list (select 'deferred-employee-address :caching nil :order-by ["ea_join" aaddressid]
 959                                        :flatp t))
 960                      (dea-list-copy (copy-seq dea-list))
 961                      (initially-unbound (every #'(lambda (dea) (not (slot-boundp dea 'address))) dea-list)))
 962                 (update-objects-joins dea-list)
 963                 (values
 964                  initially-unbound
 965                  (equal dea-list dea-list-copy)
 966                  (every #'(lambda (dea) (slot-boundp dea 'address)) dea-list)
 967                  (every #'(lambda (dea) (typep (slot-value dea 'address) 'address)) dea-list)
 968                  (mapcar #'(lambda (dea) (slot-value (slot-value dea 'address) 'addressid)) dea-list))))
 969           t t t t (1 1 2 2 2))
 970
 971         ;; update-object-joins needs to be fixed for multiple keys
 972         #+ignore
 973         (deftest :oodml/uoj/2
 974             (progn
 975               (clsql:update-objects-joins (list company1))
 976               (mapcar #'(lambda (e)
 977                           (slot-value e 'ecompanyid))
 978                  (company-employees company1)))
 979           (1 1 1 1 1 1 1 1 1 1))
 980
 981         (deftest :oodml/big/1
 982             (let ((objs (clsql:select 'big :order-by [i] :flatp t)))
 983               (values
 984                (length objs)
 985                (do ((i 0 (1+ i))
 986                     (max (expt 2 60))
 987                     (rest objs (cdr rest)))
 988                    ((= i (length objs)) t)
 989                  (let ((obj (car rest))
 990                        (index (1+ i)))
 991                    (unless (and (eql (slot-value obj 'i) index)
 992                                 (eql (slot-value obj 'bi) (truncate max index)))
 993                      (print index)
 994                      (describe obj)
 995                      (return nil))))))
 996           555 t)
 997
 998         (deftest :oodml/db-auto-sync/1
 999             (values
1000               (progn
1001                 (make-instance 'employee :emplid 20 :groupid 1
1002                                :last-name "Ivanovich")
1003                 (select [last-name] :from [employee] :where [= [emplid] 20]
1004                         :flatp t :field-names nil))
1005              (let ((*db-auto-sync* t))
1006                (make-instance 'employee :emplid 20 :groupid 1
1007                               :last-name "Ivanovich")
1008                (prog1 (select [last-name] :from [employee] :flatp t
1009                               :field-names nil
1010                               :where [= [emplid] 20])
1011                  (delete-records :from [employee] :where [= [emplid] 20]))))
1012           nil ("Ivanovich"))
1013
1014         (deftest :oodml/db-auto-sync/2
1015             (values
1016              (let ((instance (make-instance 'employee :emplid 20 :groupid 1
1017                                             :last-name "Ivanovich")))
1018                (setf (slot-value instance 'last-name) "Bulgakov")
1019                (select [last-name] :from [employee] :where [= [emplid] 20]
1020                        :flatp t :field-names nil))
1021              (let* ((*db-auto-sync* t)
1022                     (instance (make-instance 'employee :emplid 20 :groupid 1
1023                                              :last-name "Ivanovich")))
1024                (setf (slot-value instance 'last-name) "Bulgakov")
1025                (prog1 (select [last-name] :from [employee] :flatp t
1026                               :field-names nil
1027                               :where [= [emplid] 20])
1028                  (delete-records :from [employee] :where [= [emplid] 20]))))
1029           nil ("Bulgakov"))
1030
1031         (deftest :oodml/db-auto-sync/3
1032             (values
1033               (progn
1034                 (make-instance 'theme :title "test-theme" :vars "test-vars"
1035                                :doc "test-doc")
1036                 (select [node-id] :from [node] :where [= [title] "test-theme"]
1037                         :flatp t :field-names nil))
1038              (let ((*db-auto-sync* t))
1039                 (make-instance 'theme :title "test-theme" :vars "test-vars"
1040                                :doc "test-doc")
1041                 (prog1 (select [title] :from [node] :where [= [title] "test-theme"]
1042                         :flatp t :field-names nil)
1043                   (delete-records :from [node] :where [= [title] "test-theme"])
1044                   (delete-records :from [setting] :where [= [vars] "test-vars"])
1045                   (delete-records :from [theme] :where [= [doc] "test-doc"]))))
1046           nil ("test-theme"))
1047
1048         (deftest :oodml/db-auto-sync/4
1049           (values
1050             (let ((inst (make-instance 'theme
1051                                        :title "test-theme" :vars "test-vars"
1052                                        :doc "test-doc")))
1053               (setf (slot-value inst 'title) "alternate-test-theme")
1054               (format nil "~a ~a ~a ~a"
1055                       (select [title] :from [node]
1056                               :where [= [title] "test-theme"]
1057                               :flatp t :field-names nil)
1058                       (select [vars] :from [setting]
1059                               :where [= [vars] "test-vars"]
1060                               :flatp t :field-names nil)
1061                       (select [doc] :from [theme]
1062                               :where [= [doc] "test-doc"]
1063                               :flatp t :field-names nil)
1064                       (select [title] :from [node]
1065                               :where [= [title] "alternate-test-theme"]
1066                               :flatp t :field-names nil)))
1067             (let* ((*db-auto-sync* t)
1068                    (inst (make-instance 'theme
1069                                         :title "test-theme" :vars "test-vars"
1070                                         :doc "test-doc")))
1071               (setf (slot-value inst 'title) "alternate-test-theme")
1072               (prog1
1073                   (format nil "~a ~a ~a ~a"
1074                           (select [title] :from [node]
1075                                   :where [= [title] "test-theme"]
1076                                   :flatp t :field-names nil)
1077                           (select [vars] :from [setting]
1078                                   :where [= [vars] "test-vars"]
1079                                   :flatp t :field-names nil)
1080                           (select [doc] :from [theme]
1081                                   :where [= [doc] "test-doc"]
1082                                   :flatp t :field-names nil)
1083                           (select [title] :from [node]
1084                                   :where [= [title] "alternate-test-theme"]
1085                                   :flatp t :field-names nil))
1086                 (delete-records :from [node] :where [= [title] "alternate-test-theme"])
1087                 (delete-records :from [setting] :where [= [vars] "test-vars"])
1088                 (delete-records :from [theme] :where [= [doc] "test-doc"]))))
1089           "NIL NIL NIL NIL"
1090           "NIL (test-vars) (test-doc) (alternate-test-theme)")
1091
1092         (deftest :oodml/setf-slot-value/1
1093             (let* ((*db-auto-sync* t)
1094                    (instance (make-instance 'employee :emplid 20 :groupid 1)))
1095               (prog1
1096                   (setf
1097                    (slot-value instance 'first-name) "Mikhail"
1098                    (slot-value instance 'last-name) "Bulgakov")
1099                 (delete-records :from [employee] :where [= [emplid] 20])))
1100           "Bulgakov")
1101
1102         (deftest :oodml/float/1
1103             (let* ((emp1 (car (select 'employee
1104                                       :where [= [slot-value 'employee 'emplid]
1105                                                 1]
1106                                       :flatp t
1107                                       :caching nil)))
1108                    (height (slot-value emp1 'height)))
1109               (prog1
1110                   (progn
1111                     (setf (slot-value emp1 'height) 1.0E0)
1112                     (clsql:update-record-from-slot emp1 'height)
1113                     (= (car (clsql:select [height] :from [employee]
1114                                           :where [= [emplid] 1]
1115                                           :flatp t
1116                                           :field-names nil))
1117                        1))
1118                 (setf (slot-value emp1 'height) height)
1119                 (clsql:update-record-from-slot emp1 'height)))
1120          t)
1121
1122         (deftest :oodml/float/2
1123             (let* ((emp1 (car (select 'employee
1124                                      :where [= [slot-value 'employee 'emplid]
1125                                                1]
1126                                      :flatp t
1127                                      :caching nil)))
1128                    (height (slot-value emp1 'height)))
1129               (prog1
1130                   (progn
1131                     (setf (slot-value emp1 'height) 1.0S0)
1132                     (clsql:update-record-from-slot emp1 'height)
1133                     (= (car (clsql:select [height] :from [employee]
1134                                           :where [= [emplid] 1]
1135                                           :flatp t
1136                                           :field-names nil))
1137                        1))
1138                 (setf (slot-value emp1 'height) height)
1139                 (clsql:update-record-from-slot emp1 'height)))
1140          t)
1141
1142         (deftest :oodml/float/3
1143             (let* ((emp1 (car (select 'employee
1144                                      :where [= [slot-value 'employee 'emplid]
1145                                                1]
1146                                      :flatp t
1147                                      :caching nil)))
1148                    (height (slot-value emp1 'height)))
1149               (prog1
1150                   (progn
1151                     (setf (slot-value emp1 'height) 1.0F0)
1152                     (clsql:update-record-from-slot emp1 'height)
1153                     (= (car (clsql:select [height] :from [employee]
1154                                           :where [= [emplid] 1]
1155                                           :flatp t
1156                                           :field-names nil))
1157                        1))
1158                 (setf (slot-value emp1 'height) height)
1159                 (clsql:update-record-from-slot emp1 'height)))
1160           t)
1161
1162         (deftest :oodml/float/4
1163             (let* ((emp1 (car (select 'employee
1164                                      :where [= [slot-value 'employee 'emplid]
1165                                                1]
1166                                      :flatp t
1167                                      :caching nil)))
1168                    (height (slot-value emp1 'height)))
1169               (prog1
1170                   (progn
1171                     (setf (slot-value emp1 'height) 1.0D0)
1172                     (clsql:update-record-from-slot emp1 'height)
1173                     (= (car (clsql:select [height] :from [employee]
1174                                           :where [= [emplid] 1]
1175                                           :flatp t
1176                                           :field-names nil))
1177                        1))
1178                 (setf (slot-value emp1 'height) height)
1179                 (clsql:update-record-from-slot emp1 'height)))
1180          t)
1181
1182         (deftest :oodml/float/5
1183             (let* ((emp1 (car (select 'employee
1184                                       :where [= [slot-value 'employee 'emplid]
1185                                                 1]
1186                                       :flatp t
1187                                       :caching nil)))
1188                    (height (slot-value emp1 'height)))
1189               (prog1
1190                   (progn
1191                     (setf (slot-value emp1 'height) 1.0L0)
1192                     (clsql:update-record-from-slot emp1 'height)
1193                     (= (car (clsql:select [height] :from [employee]
1194                                           :where [= [emplid] 1]
1195                                           :flatp t
1196                                           :field-names nil))
1197                        1))
1198                 (setf (slot-value emp1 'height) height)
1199                 (clsql:update-record-from-slot emp1 'height)))
1200          t)))
1201
1202
1203
1204 #.(clsql:restore-sql-reader-syntax-state)