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