tests/test-oodml.lisp

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