tests/test-oodml.lisp

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