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