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          (values
 369           (progn
 370             (let ((base (car (clsql:select 'node
 371                                            :where [= [slot-value 'node 'node-id]
 372                                                      1]
 373                                            :flatp t
 374                                            :caching nil))))
 375               (with-output-to-string (out)
 376                 (format out "~a ~a"
 377                         (slot-value base 'node-id)
 378                         (slot-value base 'title)))))
 379           (progn
 380             (let ((base (car (clsql:select 'node
 381                                            :where [= [slot-value 'node 'node-id]
 382                                                      1]
 383                                            :flatp t
 384                                            :caching nil))))
 385               (setf (slot-value base 'title) "Altered title")
 386               (clsql:update-records-from-instance base)
 387               (with-output-to-string (out)
 388                 (format out "~a ~a"
 389                         (slot-value base 'node-id)
 390                         (slot-value base 'title)))))
 391           (progn
 392             (let ((base (car (clsql:select 'node
 393                                            :where [= [slot-value 'node 'node-id]
 394                                                      1]
 395                                            :flatp t
 396                                            :caching nil))))
 397               (setf (slot-value base 'title) "Bare node")
 398               (clsql:update-records-from-instance base)
 399               (with-output-to-string (out)
 400                 (format out "~a ~a"
 401                         (slot-value base 'node-id)
 402                         (slot-value base 'title))))))
 403           "1 Bare node"
 404           "1 Altered title"
 405           "1 Bare node")
 406
 407         (deftest :oodml/update-records/5
 408          (values
 409           (progn
 410             (let ((node (car (clsql:select 'setting
 411                                            :where [= [slot-value 'setting 'setting-id]
 412                                                      3]
 413                                            :flatp t
 414                                            :caching nil))))
 415               (with-output-to-string (out)
 416                 (format out "~a ~a ~a"
 417                         (slot-value node 'setting-id)
 418                         (slot-value node 'title)
 419                         (slot-value node 'vars)))))
 420           (progn
 421             (let ((node (car (clsql:select 'setting
 422                                            :where [= [slot-value 'setting 'setting-id]
 423                                                      3]
 424                                            :flatp t
 425                                            :caching nil))))
 426               (setf (slot-value node 'title) "Altered title")
 427               (setf (slot-value node 'vars) "Altered vars")
 428               (clsql:update-records-from-instance node)
 429               (with-output-to-string (out)
 430                 (format out "~a ~a ~a"
 431                         (slot-value node 'setting-id)
 432                         (slot-value node 'title)
 433                         (slot-value node 'vars)))))
 434           (progn
 435             (let ((node (car (clsql:select 'setting
 436                                            :where [= [slot-value 'setting 'setting-id]
 437                                                      3]
 438                                            :flatp t
 439                                            :caching nil))))
 440               (setf (slot-value node 'title) "Setting2")
 441               (setf (slot-value node 'vars) "var 2")
 442               (clsql:update-records-from-instance node)
 443               (with-output-to-string (out)
 444                 (format out "~a ~a ~a"
 445                         (slot-value node 'setting-id)
 446                         (slot-value node 'title)
 447                         (slot-value node 'vars))))))
 448           "3 Setting2 var 2"
 449           "3 Altered title Altered vars"
 450           "3 Setting2 var 2")
 451
 452         (deftest :oodml/update-records/6
 453          (values
 454           (progn
 455             (let ((node (car (clsql:select 'setting
 456                                            :where [= [slot-value 'setting 'setting-id]
 457                                                      7]
 458                                            :flatp t
 459                                            :caching nil))))
 460               (with-output-to-string (out)
 461                 (format out "~a ~a ~a"
 462                         (slot-value node 'setting-id)
 463                         (slot-value node 'title)
 464                         (slot-value node 'vars)))))
 465           (progn
 466             (let ((node (car (clsql:select 'setting
 467                                            :where [= [slot-value 'setting 'setting-id]
 468                                                      7]
 469                                            :flatp t
 470                                            :caching nil))))
 471               (setf (slot-value node 'title) "Altered title")
 472               (setf (slot-value node 'vars) "Altered vars")
 473               (clsql:update-records-from-instance node)
 474               (with-output-to-string (out)
 475                 (format out "~a ~a ~a"
 476                         (slot-value node 'setting-id)
 477                         (slot-value node 'title)
 478                         (slot-value node 'vars)))))
 479           (progn
 480             (let ((node (car (clsql:select 'setting
 481                                            :where [= [slot-value 'setting 'setting-id]
 482                                                      7]
 483                                            :flatp t
 484                                            :caching nil))))
 485               (setf (slot-value node 'title) "theme-2")
 486               (setf (slot-value node 'vars) nil)
 487               (clsql:update-records-from-instance node)
 488               (with-output-to-string (out)
 489                 (format out "~a ~a ~a"
 490                         (slot-value node 'setting-id)
 491                         (slot-value node 'title)
 492                         (slot-value node 'vars))))))
 493           "7 theme-2 NIL"
 494           "7 Altered title Altered vars"
 495           "7 theme-2 NIL")
 496
 497         (deftest :oodml/update-records/7
 498          (values
 499           (progn
 500             (let ((node (car (clsql:select 'user
 501                                            :where [= [slot-value 'user 'user-id]
 502                                                      5]
 503                                            :flatp t
 504                                            :caching nil))))
 505               (with-output-to-string (out)
 506                 (format out "~a ~a ~a"
 507                         (slot-value node 'user-id)
 508                         (slot-value node 'title)
 509                         (slot-value node 'nick)))))
 510           (progn
 511             (let ((node (car (clsql:select 'user
 512                                            :where [= [slot-value 'user 'user-id]
 513                                                      5]
 514                                            :flatp t
 515                                            :caching nil))))
 516               (setf (slot-value node 'title) "Altered title")
 517               (setf (slot-value node 'nick) "Altered nick")
 518               (clsql:update-records-from-instance node)
 519               (with-output-to-string (out)
 520                 (format out "~a ~a ~a"
 521                         (slot-value node 'user-id)
 522                         (slot-value node 'title)
 523                         (slot-value node 'nick)))))
 524           (progn
 525             (let ((node (car (clsql:select 'user
 526                                            :where [= [slot-value 'user 'user-id]
 527                                                      5]
 528                                            :flatp t
 529                                            :caching nil))))
 530               (setf (slot-value node 'title) "user-2")
 531               (setf (slot-value node 'nick) "second user")
 532               (clsql:update-records-from-instance node)
 533               (with-output-to-string (out)
 534                 (format out "~a ~a ~a"
 535                         (slot-value node 'user-id)
 536                         (slot-value node 'title)
 537                         (slot-value node 'nick))))))
 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          (values
 544           (progn
 545             (let ((node (car (clsql:select 'theme
 546                                            :where [= [slot-value 'theme 'theme-id]
 547                                                      6]
 548                                            :flatp t
 549                                            :caching nil))))
 550               (with-output-to-string (out)
 551                 (format out "~a ~a ~a ~a ~a ~a"
 552                         (slot-value node 'node-id)
 553                         (slot-value node 'setting-id)
 554                         (slot-value node 'theme-id)
 555                         (slot-value node 'title)
 556                         (slot-value node 'vars)
 557                         (slot-value node 'doc)))))
 558           (progn
 559             (let ((node (car (clsql:select 'setting
 560                                            :where [= [slot-value 'setting 'setting-id]
 561                                                      6]
 562                                            :flatp t
 563                                            :caching nil))))
 564               (setf (slot-value node 'title) "Altered title")
 565               (setf (slot-value node 'vars) nil)
 566               (clsql:update-records-from-instance node)
 567               (with-output-to-string (out)
 568                 (format out "~a ~a ~a"
 569                         (slot-value node 'setting-id)
 570                         (slot-value node 'title)
 571                         (slot-value node 'vars)))))
 572           (progn
 573             (let ((node (car (clsql:select 'theme
 574                                            :where [= [slot-value 'theme 'theme-id]
 575                                                      6]
 576                                            :flatp t
 577                                            :caching nil))))
 578               (setf (slot-value node 'title) "Altered title again")
 579               (setf (slot-value node 'doc) "altered doc")
 580               (clsql:update-records-from-instance node)
 581               (with-output-to-string (out)
 582                 (format out "~a ~a ~a ~a ~a ~a"
 583                         (slot-value node 'node-id)
 584                         (slot-value node 'setting-id)
 585                         (slot-value node 'theme-id)
 586                         (slot-value node 'title)
 587                         (slot-value node 'vars)
 588                         (slot-value node 'doc)))))
 589           (progn
 590             (let ((node (car (clsql:select 'theme
 591                                            :where [= [slot-value 'theme 'theme-id]
 592                                                      6]
 593                                            :flatp t
 594                                            :caching nil))))
 595               (setf (slot-value node 'title) "theme-1")
 596               (setf (slot-value node 'vars) "empty")
 597               (setf (slot-value node 'doc) "first theme")
 598               (clsql:update-records-from-instance node)
 599               (with-output-to-string (out)
 600                 (format out "~a ~a ~a ~a ~a ~a"
 601                         (slot-value node 'node-id)
 602                         (slot-value node 'setting-id)
 603                         (slot-value node 'theme-id)
 604                         (slot-value node 'title)
 605                         (slot-value node 'vars)
 606                         (slot-value node 'doc))))))
 607           "6 6 6 theme-1 empty first theme"
 608           "6 Altered title NIL"
 609           "6 6 6 Altered title again NIL altered doc"
 610           "6 6 6 theme-1 empty first theme")
 611
 612                 (deftest :oodml/update-records/9
 613          (values
 614           (progn
 615             (let ((sl (car (clsql:select 'subloc
 616                                                                                  :where [= [slot-value 'subloc 'subloc-id]
 617                                                                                                    10]
 618                                                                                  :flatp t
 619                                                                                  :caching nil))))
 620               (with-output-to-string (out)
 621                 (format out "~a ~a ~a"
 622                         (slot-value sl 'subloc-id)
 623                         (slot-value sl 'title)
 624                         (slot-value sl 'loc)))))
 625           (progn
 626             (let ((sl (car (clsql:select 'subloc
 627                                                                                  :where [= [slot-value 'subloc 'subloc-id]
 628                                                                                                    10]
 629                                                                                  :flatp t
 630                                                                                  :caching nil))))
 631               (setf (slot-value sl 'title) "Altered subloc title")
 632               (setf (slot-value sl 'loc) "Altered loc")
 633               (clsql:update-records-from-instance sl)
 634               (with-output-to-string (out)
 635                 (format out "~a ~a ~a"
 636                         (slot-value sl 'subloc-id)
 637                         (slot-value sl 'title)
 638                         (slot-value sl 'loc)))))
 639           (progn
 640             (let ((sl (car (clsql:select 'subloc
 641                                                                                  :where [= [slot-value 'subloc 'subloc-id]
 642                                                                                                    10]
 643                                                                                  :flatp t
 644                                                                                  :caching nil))))
 645               (setf (slot-value sl 'title) "subloc-1")
 646               (setf (slot-value sl 'loc) "a subloc")
 647               (clsql:update-records-from-instance sl)
 648               (with-output-to-string (out)
 649                 (format out "~a ~a ~a"
 650                         (slot-value sl 'subloc-id)
 651                         (slot-value sl 'title)
 652                         (slot-value sl 'loc))))))
 653           "10 subloc-1 a subloc"
 654           "10 Altered subloc title Altered loc"
 655           "10 subloc-1 a subloc")
 656
 657         ;; tests update-instance-from-records
 658         (deftest :oodml/update-instance/1
 659             (values
 660              (concatenate 'string
 661                           (slot-value employee1 'first-name)
 662                           " "
 663                           (slot-value employee1 'last-name)
 664                           ": "
 665                           (slot-value employee1 'email))
 666              (progn
 667                (clsql:update-records [employee]
 668                                      :av-pairs '(([first-name] "Ivan")
 669                                                  ([last-name] "Petrov")
 670                                                  ([email] "petrov@soviet.org"))
 671                                      :where [= [emplid] 1])
 672                (clsql:update-instance-from-records employee1)
 673                (concatenate 'string
 674                             (slot-value employee1 'first-name)
 675                             " "
 676                             (slot-value employee1 'last-name)
 677                             ": "
 678                             (slot-value employee1 'email)))
 679              (progn
 680                (clsql:update-records [employee]
 681                                      :av-pairs '(([first-name] "Vladimir")
 682                                                  ([last-name] "Lenin")
 683                                                  ([email] "lenin@soviet.org"))
 684                                      :where [= [emplid] 1])
 685                (clsql:update-instance-from-records employee1)
 686                (concatenate 'string
 687                             (slot-value employee1 'first-name)
 688                             " "
 689                             (slot-value employee1 'last-name)
 690                             ": "
 691                             (slot-value employee1 'email))))
 692           "Vladimir Lenin: lenin@soviet.org"
 693           "Ivan Petrov: petrov@soviet.org"
 694           "Vladimir Lenin: lenin@soviet.org")
 695
 696         ;; tests update-slot-from-record
 697         (deftest :oodml/update-instance/2
 698             (values
 699              (slot-value employee1 'email)
 700              (progn
 701                (clsql:update-records [employee]
 702                                      :av-pairs '(([email] "lenin-nospam@soviet.org"))
 703                                      :where [= [emplid] 1])
 704                (clsql:update-slot-from-record employee1 'email)
 705                (slot-value employee1 'email))
 706              (progn
 707                (clsql:update-records [employee]
 708                                      :av-pairs '(([email] "lenin@soviet.org"))
 709                                      :where [= [emplid] 1])
 710                (clsql:update-slot-from-record employee1 'email)
 711                (slot-value employee1 'email)))
 712           "lenin@soviet.org" "lenin-nospam@soviet.org" "lenin@soviet.org")
 713
 714         ;; tests normalisedp update-instance-from-records
 715         (deftest :oodml/update-instance/3
 716             (values
 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] "Altered title"))
 725                                      :where [= [node-id] 7])
 726                (clsql:update-records [setting] :av-pairs '(([vars] "Altered vars"))
 727                                      :where [= [setting-id] 7])
 728                (clsql:update-records [theme] :av-pairs '(([doc] "Altered doc"))
 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              (progn
 738                (clsql:update-records [node] :av-pairs '(([title] "theme-2"))
 739                                      :where [= [node-id] 7])
 740                (clsql:update-records [setting] :av-pairs '(([vars] nil))
 741                                      :where [= [setting-id] 7])
 742                (clsql:update-records [theme] :av-pairs '(([doc] "second theme"))
 743                                      :where [= [theme-id] 7])
 744                (clsql:update-instance-from-records theme2)
 745                (with-output-to-string (out)
 746                  (format out "~a ~a ~a ~a"
 747                          (slot-value theme2 'theme-id)
 748                          (slot-value theme2 'title)
 749                          (slot-value theme2 'vars)
 750                          (slot-value theme2 'doc)))))
 751           "7 theme-2 NIL second theme"
 752           "7 Altered title Altered vars Altered doc"
 753           "7 theme-2 NIL second theme")
 754
 755         (deftest :oodml/update-instance/4
 756                    (values
 757                         (progn
 758                           (setf loc2 (car (clsql:select 'location
 759                                                                                         :where [= [node-id] 9]
 760                                                                                         :flatp t :caching nil)))
 761                           (with-output-to-string (out)
 762                                 (format out "~a ~a"
 763                                                 (slot-value loc2 'node-id)
 764                                                 (slot-value loc2 'title))))
 765                         (progn
 766                           (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
 767                                                                         :where [= [node-id] 9])
 768                           (clsql:update-instance-from-records loc2)
 769                           (with-output-to-string (out)
 770                                 (format out "~a ~a"
 771                                                 (slot-value loc2 'node-id)
 772                                                 (slot-value loc2 'title))))
 773                         (progn
 774                           (clsql:update-records [node] :av-pairs '(([title] "location-2"))
 775                                                                         :where [= [node-id] 9])
 776                           (clsql:update-instance-from-records loc2)
 777                           (with-output-to-string (out)
 778                                 (format out "~a ~a"
 779                                                 (slot-value loc2 'node-id)
 780                                                 (slot-value loc2 'title)))))
 781           "9 location-2"
 782           "9 Altered title"
 783           "9 location-2")
 784
 785         (deftest :oodml/update-instance/5
 786             (values
 787              (with-output-to-string (out)
 788                (format out "~a ~a ~a"
 789                        (slot-value subloc2 'subloc-id)
 790                        (slot-value subloc2 'title)
 791                        (slot-value subloc2 'loc)))
 792              (progn
 793                (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
 794                                      :where [= [node-id] 11])
 795                (clsql:update-records [subloc] :av-pairs '(([loc] "Altered loc"))
 796                                      :where [= [subloc-id] 11])
 797                (clsql:update-instance-from-records subloc2)
 798                (with-output-to-string (out)
 799                  (format out "~a ~a ~a"
 800                          (slot-value subloc2 'subloc-id)
 801                          (slot-value subloc2 'title)
 802                          (slot-value subloc2 'loc))))
 803              (progn
 804                (clsql:update-records [node] :av-pairs '(([title] "subloc-2"))
 805                                      :where [= [node-id] 11])
 806                (clsql:update-records [subloc] :av-pairs '(([loc] "second subloc"))
 807                                      :where [= [subloc-id] 11])
 808                (clsql:update-instance-from-records subloc2)
 809                (with-output-to-string (out)
 810                  (format out "~a ~a ~a"
 811                          (slot-value subloc2 'subloc-id)
 812                          (slot-value subloc2 'title)
 813                          (slot-value subloc2 'loc)))))
 814           "11 subloc-2 second subloc"
 815           "11 Altered title Altered loc"
 816           "11 subloc-2 second subloc")
 817
 818         ;; tests update-slot-from-record with normalisedp stuff
 819         (deftest :oodml/update-instance/6
 820             (values
 821              (slot-value theme1 'doc)
 822              (slot-value theme1 'vars)
 823              (progn
 824                (clsql:update-records [theme]
 825                                      :av-pairs '(([doc] "altered doc"))
 826                                      :where [= [theme-id] 6])
 827                (clsql:update-slot-from-record theme1 'doc)
 828                (slot-value theme1 'doc))
 829              (progn
 830                (clsql:update-records [setting]
 831                                      :av-pairs '(([vars] "altered vars"))
 832                                      :where [= [setting-id] 6])
 833                (clsql:update-slot-from-record theme1 'vars)
 834                (slot-value theme1 'vars))
 835              (progn
 836                (clsql:update-records [theme]
 837                                      :av-pairs '(([doc] "first theme"))
 838                                      :where [= [theme-id] 6])
 839                (clsql:update-slot-from-record theme1 'doc)
 840                (slot-value theme1 'doc))
 841              (progn
 842                (clsql:update-records [setting]
 843                                      :av-pairs '(([vars] "empty"))
 844                                      :where [= [setting-id] 6])
 845                (clsql:update-slot-from-record theme1 'vars)
 846                (slot-value theme1 'vars)))
 847          "first theme" "empty"
 848          "altered doc" "altered vars"
 849          "first theme" "empty")
 850
 851         (deftest :oodml/update-instance/7
 852             (values
 853              (slot-value loc2 'title)
 854              (slot-value subloc2 'loc)
 855              (progn
 856                (clsql:update-records [node]
 857                                      :av-pairs '(([title] "altered title"))
 858                                      :where [= [node-id] 9])
 859                (clsql:update-slot-from-record loc2 'title)
 860                (slot-value loc2 'title))
 861              (progn
 862                (clsql:update-records [subloc]
 863                                      :av-pairs '(([loc] "altered loc"))
 864                                      :where [= [subloc-id] 11])
 865                (clsql:update-slot-from-record subloc2 'loc)
 866                (slot-value subloc2 'loc))
 867              (progn
 868                (clsql:update-records [node]
 869                                      :av-pairs '(([title] "location-2"))
 870                                      :where [= [node-id] 9])
 871                (clsql:update-slot-from-record loc2 'title)
 872                (slot-value loc2 'title))
 873              (progn
 874                (clsql:update-records [subloc]
 875                                      :av-pairs '(([loc] "second subloc"))
 876                                      :where [= [subloc-id] 11])
 877                (clsql:update-slot-from-record subloc2 'loc)
 878                (slot-value subloc2 'loc)))
 879          "location-2" "second subloc"
 880                  "altered title" "altered loc"
 881          "location-2" "second subloc")
 882
 883         (deftest :oodml/do-query/1
 884             (let ((result '()))
 885               (clsql:do-query ((e) [select 'employee :order-by [emplid]])
 886                 (push (slot-value e 'last-name) result))
 887               result)
 888           ("Putin" "Yeltsin" "Gorbachev" "Chernenko" "Andropov" "Brezhnev" "Kruschev"
 889            "Trotsky" "Stalin" "Lenin"))
 890
 891         (deftest :oodml/do-query/2
 892             (let ((result '()))
 893               (clsql:do-query ((e c) [select 'employee 'company
 894                                              :where [= [slot-value 'employee 'last-name]
 895                                                        "Lenin"]])
 896                 (push (list (slot-value e 'last-name) (slot-value c 'name))
 897                       result))
 898               result)
 899           (("Lenin" "Widgets Inc.")))
 900
 901         (deftest :oodml/map-query/1
 902             (clsql:map-query 'list #'last-name [select 'employee :order-by [emplid]])
 903           ("Lenin" "Stalin" "Trotsky" "Kruschev" "Brezhnev" "Andropov" "Chernenko"
 904            "Gorbachev" "Yeltsin" "Putin"))
 905
 906         (deftest :oodml/map-query/2
 907             (clsql:map-query 'list #'(lambda (e c) (list (slot-value e 'last-name)
 908                                                          (slot-value c 'name)))
 909              [select 'employee 'company :where [= [slot-value 'employee 'last-name]
 910                                                   "Lenin"]])
 911           (("Lenin" "Widgets Inc.")))
 912
 913         (deftest :oodml/iteration/3
 914             (loop for (e) being the records in
 915              [select 'employee :where [< [emplid] 4] :order-by [emplid]]
 916              collect (slot-value e 'last-name))
 917           ("Lenin" "Stalin" "Trotsky"))
 918
 919
 920       (deftest :oodml/cache/1
 921           (progn
 922             (setf (clsql-sys:record-caches *default-database*) nil)
 923             (let ((employees (select 'employee)))
 924               (every #'(lambda (a b) (eq a b))
 925                      employees (select 'employee))))
 926         t)
 927
 928         (deftest :oodml/cache/2
 929             (let ((employees (select 'employee)))
 930               (equal employees (select 'employee :flatp t)))
 931           nil)
 932
 933         (deftest :oodml/refresh/1
 934             (let ((addresses (select 'address)))
 935               (equal addresses (select 'address :refresh t)))
 936           t)
 937
 938         (deftest :oodml/refresh/2
 939             (let* ((addresses (select 'address :order-by [addressid] :flatp t :refresh t))
 940                    (city (slot-value (car addresses) 'city)))
 941               (clsql:update-records [addr]
 942                               :av-pairs '((city_field "A new city"))
 943                               :where [= [addressid] (slot-value (car addresses) 'addressid)])
 944               (let* ((new-addresses (select 'address :order-by [addressid] :refresh t :flatp t))
 945                      (new-city (slot-value (car addresses) 'city))
 946 )
 947                 (clsql:update-records [addr]
 948                                       :av-pairs `((city_field ,city))
 949                                       :where [= [addressid] (slot-value (car addresses) 'addressid)])
 950                 (values (equal addresses new-addresses)
 951                         city
 952                         new-city)))
 953           t "Leningrad" "A new city")
 954
 955         (deftest :oodml/refresh/3
 956             (let* ((addresses (select 'address :order-by [addressid] :flatp t)))
 957               (values
 958                (equal addresses (select 'address :refresh t :flatp t))
 959                (equal addresses (select 'address :flatp t))))
 960           nil nil)
 961
 962         (deftest :oodml/refresh/4
 963             (let* ((addresses (select 'address :order-by [addressid] :flatp t :refresh t))
 964                    (*db-auto-sync* t))
 965               (make-instance 'address :addressid 1000 :city "A new address city")
 966               (let ((new-addresses (select 'address :order-by [addressid] :flatp t :refresh t)))
 967                 (delete-records :from [addr] :where [= [addressid] 1000])
 968                 (values
 969                  (length addresses)
 970                  (length new-addresses)
 971                  (eq (first addresses) (first new-addresses))
 972                  (eq (second addresses) (second new-addresses)))))
 973           2 3 t t)
 974
 975
 976         (deftest :oodml/uoj/1
 977             (progn
 978               (let* ((dea-list (select 'deferred-employee-address :caching nil :order-by ["ea_join" aaddressid]
 979                                        :flatp t))
 980                      (dea-list-copy (copy-seq dea-list))
 981                      (initially-unbound (every #'(lambda (dea) (not (slot-boundp dea 'address))) dea-list)))
 982                 (update-objects-joins dea-list)
 983                 (values
 984                  initially-unbound
 985                  (equal dea-list dea-list-copy)
 986                  (every #'(lambda (dea) (slot-boundp dea 'address)) dea-list)
 987                  (every #'(lambda (dea) (typep (slot-value dea 'address) 'address)) dea-list)
 988                  (mapcar #'(lambda (dea) (slot-value (slot-value dea 'address) 'addressid)) dea-list))))
 989           t t t t (1 1 2 2 2))
 990
 991         ;; update-object-joins needs to be fixed for multiple keys
 992         #+ignore
 993         (deftest :oodml/uoj/2
 994             (progn
 995               (clsql:update-objects-joins (list company1))
 996               (mapcar #'(lambda (e)
 997                           (slot-value e 'ecompanyid))
 998                  (company-employees company1)))
 999           (1 1 1 1 1 1 1 1 1 1))
1000
1001         (deftest :oodml/big/1
1002             (let ((objs (clsql:select 'big :order-by [i] :flatp t)))
1003               (values
1004                (length objs)
1005                (do ((i 0 (1+ i))
1006                     (max (expt 2 60))
1007                     (rest objs (cdr rest)))
1008                    ((= i (length objs)) t)
1009                  (let ((obj (car rest))
1010                        (index (1+ i)))
1011                    (unless (and (eql (slot-value obj 'i) index)
1012                                 (eql (slot-value obj 'bi) (truncate max index)))
1013                      (print index)
1014                      (describe obj)
1015                      (return nil))))))
1016           555 t)
1017
1018         (deftest :oodml/db-auto-sync/1
1019             (values
1020               (progn
1021                 (make-instance 'employee :emplid 20 :groupid 1
1022                                :last-name "Ivanovich")
1023                 (select [last-name] :from [employee] :where [= [emplid] 20]
1024                         :flatp t :field-names nil))
1025              (let ((*db-auto-sync* t))
1026                (make-instance 'employee :emplid 20 :groupid 1
1027                               :last-name "Ivanovich")
1028                (prog1 (select [last-name] :from [employee] :flatp t
1029                               :field-names nil
1030                               :where [= [emplid] 20])
1031                  (delete-records :from [employee] :where [= [emplid] 20]))))
1032           nil ("Ivanovich"))
1033
1034         (deftest :oodml/db-auto-sync/2
1035             (values
1036              (let ((instance (make-instance 'employee :emplid 20 :groupid 1
1037                                             :last-name "Ivanovich")))
1038                (setf (slot-value instance 'last-name) "Bulgakov")
1039                (select [last-name] :from [employee] :where [= [emplid] 20]
1040                        :flatp t :field-names nil))
1041              (let* ((*db-auto-sync* t)
1042                     (instance (make-instance 'employee :emplid 20 :groupid 1
1043                                              :last-name "Ivanovich")))
1044                (setf (slot-value instance 'last-name) "Bulgakov")
1045                (prog1 (select [last-name] :from [employee] :flatp t
1046                               :field-names nil
1047                               :where [= [emplid] 20])
1048                  (delete-records :from [employee] :where [= [emplid] 20]))))
1049           nil ("Bulgakov"))
1050
1051         (deftest :oodml/db-auto-sync/3
1052             (values
1053               (progn
1054                 (make-instance 'theme :title "test-theme" :vars "test-vars"
1055                                :doc "test-doc")
1056                 (select [node-id] :from [node] :where [= [title] "test-theme"]
1057                         :flatp t :field-names nil))
1058              (let ((*db-auto-sync* t))
1059                 (make-instance 'theme :title "test-theme" :vars "test-vars"
1060                                :doc "test-doc")
1061                 (prog1 (select [title] :from [node] :where [= [title] "test-theme"]
1062                         :flatp t :field-names nil)
1063                   (delete-records :from [node] :where [= [title] "test-theme"])
1064                   (delete-records :from [setting] :where [= [vars] "test-vars"])
1065                   (delete-records :from [theme] :where [= [doc] "test-doc"]))))
1066           nil ("test-theme"))
1067
1068         (deftest :oodml/db-auto-sync/4
1069             (values
1070               (let ((inst (make-instance 'theme
1071                                          :title "test-theme" :vars "test-vars"
1072                                          :doc "test-doc")))
1073                 (setf (slot-value inst 'title) "alternate-test-theme")
1074                 (with-output-to-string (out)
1075                   (format out "~a ~a ~a ~a"
1076                           (select [title] :from [node]
1077                                   :where [= [title] "test-theme"]
1078                                   :flatp t :field-names nil)
1079                           (select [vars] :from [setting]
1080                                   :where [= [vars] "test-vars"]
1081                                   :flatp t :field-names nil)
1082                           (select [doc] :from [theme]
1083                                   :where [= [doc] "test-doc"]
1084                                   :flatp t :field-names nil)
1085                           (select [title] :from [node]
1086                                   :where [= [title] "alternate-test-theme"]
1087                                   :flatp t :field-names nil))))
1088              (let* ((*db-auto-sync* t)
1089                     (inst (make-instance 'theme
1090                                          :title "test-theme" :vars "test-vars"
1091                                          :doc "test-doc")))
1092                 (setf (slot-value inst 'title) "alternate-test-theme")
1093                 (prog1
1094                 (with-output-to-string (out)
1095                   (format out "~a ~a ~a ~a"
1096                           (select [title] :from [node]
1097                                   :where [= [title] "test-theme"]
1098                                   :flatp t :field-names nil)
1099                           (select [vars] :from [setting]
1100                                   :where [= [vars] "test-vars"]
1101                                   :flatp t :field-names nil)
1102                           (select [doc] :from [theme]
1103                                   :where [= [doc] "test-doc"]
1104                                   :flatp t :field-names nil)
1105                           (select [title] :from [node]
1106                                   :where [= [title] "alternate-test-theme"]
1107                                   :flatp t :field-names nil)))
1108                   (delete-records :from [node] :where [= [title] "alternate-test-theme"])
1109                   (delete-records :from [setting] :where [= [vars] "test-vars"])
1110                   (delete-records :from [theme] :where [= [doc] "test-doc"]))))
1111          "NIL NIL NIL NIL"
1112          "NIL (test-vars) (test-doc) (alternate-test-theme)")
1113
1114         (deftest :oodml/setf-slot-value/1
1115             (let* ((*db-auto-sync* t)
1116                    (instance (make-instance 'employee :emplid 20 :groupid 1)))
1117               (prog1
1118                   (setf
1119                    (slot-value instance 'first-name) "Mikhail"
1120                    (slot-value instance 'last-name) "Bulgakov")
1121                 (delete-records :from [employee] :where [= [emplid] 20])))
1122           "Bulgakov")
1123
1124         (deftest :oodml/float/1
1125             (let* ((emp1 (car (select 'employee
1126                                       :where [= [slot-value 'employee 'emplid]
1127                                                 1]
1128                                       :flatp t
1129                                       :caching nil)))
1130                    (height (slot-value emp1 'height)))
1131               (prog1
1132                   (progn
1133                     (setf (slot-value emp1 'height) 1.0E0)
1134                     (clsql:update-record-from-slot emp1 'height)
1135                     (= (car (clsql:select [height] :from [employee]
1136                                           :where [= [emplid] 1]
1137                                           :flatp t
1138                                           :field-names nil))
1139                        1))
1140                 (setf (slot-value emp1 'height) height)
1141                 (clsql:update-record-from-slot emp1 'height)))
1142          t)
1143
1144         (deftest :oodml/float/2
1145             (let* ((emp1 (car (select 'employee
1146                                      :where [= [slot-value 'employee 'emplid]
1147                                                1]
1148                                      :flatp t
1149                                      :caching nil)))
1150                    (height (slot-value emp1 'height)))
1151               (prog1
1152                   (progn
1153                     (setf (slot-value emp1 'height) 1.0S0)
1154                     (clsql:update-record-from-slot emp1 'height)
1155                     (= (car (clsql:select [height] :from [employee]
1156                                           :where [= [emplid] 1]
1157                                           :flatp t
1158                                           :field-names nil))
1159                        1))
1160                 (setf (slot-value emp1 'height) height)
1161                 (clsql:update-record-from-slot emp1 'height)))
1162          t)
1163
1164         (deftest :oodml/float/3
1165             (let* ((emp1 (car (select 'employee
1166                                      :where [= [slot-value 'employee 'emplid]
1167                                                1]
1168                                      :flatp t
1169                                      :caching nil)))
1170                    (height (slot-value emp1 'height)))
1171               (prog1
1172                   (progn
1173                     (setf (slot-value emp1 'height) 1.0F0)
1174                     (clsql:update-record-from-slot emp1 'height)
1175                     (= (car (clsql:select [height] :from [employee]
1176                                           :where [= [emplid] 1]
1177                                           :flatp t
1178                                           :field-names nil))
1179                        1))
1180                 (setf (slot-value emp1 'height) height)
1181                 (clsql:update-record-from-slot emp1 'height)))
1182           t)
1183
1184         (deftest :oodml/float/4
1185             (let* ((emp1 (car (select 'employee
1186                                      :where [= [slot-value 'employee 'emplid]
1187                                                1]
1188                                      :flatp t
1189                                      :caching nil)))
1190                    (height (slot-value emp1 'height)))
1191               (prog1
1192                   (progn
1193                     (setf (slot-value emp1 'height) 1.0D0)
1194                     (clsql:update-record-from-slot emp1 'height)
1195                     (= (car (clsql:select [height] :from [employee]
1196                                           :where [= [emplid] 1]
1197                                           :flatp t
1198                                           :field-names nil))
1199                        1))
1200                 (setf (slot-value emp1 'height) height)
1201                 (clsql:update-record-from-slot emp1 'height)))
1202          t)
1203
1204         (deftest :oodml/float/5
1205             (let* ((emp1 (car (select 'employee
1206                                       :where [= [slot-value 'employee 'emplid]
1207                                                 1]
1208                                       :flatp t
1209                                       :caching nil)))
1210                    (height (slot-value emp1 'height)))
1211               (prog1
1212                   (progn
1213                     (setf (slot-value emp1 'height) 1.0L0)
1214                     (clsql:update-record-from-slot emp1 'height)
1215                     (= (car (clsql:select [height] :from [employee]
1216                                           :where [= [emplid] 1]
1217                                           :flatp t
1218                                           :field-names nil))
1219                        1))
1220                 (setf (slot-value emp1 'height) height)
1221                 (clsql:update-record-from-slot emp1 'height)))
1222          t)))
1223
1224
1225
1226 #.(clsql:restore-sql-reader-syntax-state)