tests/test-init.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; ======================================================================
   3 ;;;; File:    test-init.lisp
   4 ;;;; Authors: Marcus Pearce <m.t.pearce@city.ac.uk>, Kevin Rosenberg
   5 ;;;; Created: 30/03/2004
   6 ;;;; Updated: $Id$
   7 ;;;;
   8 ;;;; Initialisation utilities for running regression tests on CLSQL.
   9 ;;;;
  10 ;;;; This file is part of CLSQL.
  11 ;;;;
  12 ;;;; CLSQL users are granted the rights to distribute and use this software
  13 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
  14 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
  15 ;;;; ======================================================================
  16
  17 (in-package #:clsql-tests)
  18
  19 (defvar *report-stream* *standard-output* "Stream to send text report.")
  20 (defvar *sexp-report-stream* nil "Stream to send sexp report.")
  21 (defvar *rt-internal*)
  22 (defvar *rt-basic*)
  23 (defvar *rt-connection*)
  24 (defvar *rt-fddl*)
  25 (defvar *rt-fdml*)
  26 (defvar *rt-ooddl*)
  27 (defvar *rt-oodml*)
  28 (defvar *rt-syntax*)
  29 (defvar *rt-time*)
  30
  31 (defvar *test-database-type* nil)
  32 (defvar *test-database-underlying-type* nil)
  33 (defvar *test-database-user* nil)
  34 (defvar *test-start-utime* nil)
  35
  36 (defclass thing ()
  37   ((extraterrestrial :initform nil :initarg :extraterrestrial)))
  38
  39 (def-view-class person (thing)
  40   ((height :db-kind :base :accessor height :type float
  41            :initarg :height)
  42    (married :db-kind :base :accessor married :type boolean
  43             :initarg :married)
  44    (birthday :type clsql:wall-time :initarg :birthday)
  45    (bd-utime :type clsql:universal-time :initarg :bd-utime)
  46    (hobby :db-kind :virtual :initarg :hobby :initform nil)))
  47
  48 (def-view-class employee (person)
  49   ((emplid
  50     :db-kind :key
  51     :db-constraints (:not-null :unique)
  52     :type integer
  53     :initarg :emplid)
  54    (groupid
  55     :db-kind :key
  56     :db-constraints :not-null
  57     :type integer
  58     :initarg :groupid)
  59    (first-name
  60     :accessor first-name
  61     :type (varchar 30)
  62     :initarg :first-name)
  63    (last-name
  64     :accessor last-name
  65     :type (varchar 30)
  66     :initarg :last-name)
  67    (email
  68     :accessor employee-email
  69     :type (varchar 100)
  70     :initarg :email)
  71    (ecompanyid
  72     :type integer
  73     :initarg :companyid)
  74    (company
  75     :accessor employee-company
  76     :db-kind :join
  77     :db-info (:join-class company
  78                           :home-key ecompanyid
  79                           :foreign-key companyid
  80                           :set nil))
  81    (managerid
  82     :type integer
  83     :initarg :managerid)
  84    (manager
  85     :accessor employee-manager
  86     :db-kind :join
  87     :db-info (:join-class employee
  88                           :home-key managerid
  89                           :foreign-key emplid
  90                           :set nil))
  91    (addresses
  92     :accessor employee-addresses
  93     :db-kind :join
  94     :db-info (:join-class employee-address
  95                           :home-key emplid
  96                           :foreign-key aemplid
  97                           :target-slot address
  98                           :set t)))
  99   (:base-table employee))
 100
 101 (def-view-class company ()
 102   ((companyid
 103     :db-kind :key
 104     :db-constraints :not-null
 105     :type integer
 106     :initarg :companyid)
 107    (groupid
 108     :db-kind :key
 109     :db-constraints :not-null
 110     :type integer
 111     :initarg :groupid)
 112    (name
 113     :type (varchar 100)
 114     :initarg :name)
 115    (presidentid
 116     :type integer
 117     :initarg :presidentid)
 118    (president
 119     :reader president
 120     :db-kind :join
 121     :db-info (:join-class employee
 122                           :home-key presidentid
 123                           :foreign-key emplid
 124                           :set nil))
 125    (employees
 126     :reader company-employees
 127     :db-kind :join
 128     :db-info (:join-class employee
 129                           :home-key (companyid groupid)
 130                           :foreign-key (ecompanyid groupid)
 131                           :set t))))
 132
 133 (def-view-class address ()
 134   ((addressid
 135     :db-kind :key
 136     :db-constraints :not-null
 137     :type integer
 138     :initarg :addressid)
 139    (street-number
 140     :type integer
 141     :initarg :street-number)
 142    (street-name
 143     :type (varchar 30)
 144     :void-value ""
 145     :initarg :street-name)
 146    (city
 147     :column "city_field"
 148     :void-value "no city"
 149     :type (varchar 30)
 150     :initarg :city)
 151    (postal-code
 152     :column zip
 153     :type integer
 154     :void-value 0
 155     :initarg :postal-code))
 156   (:base-table addr))
 157
 158 ;; many employees can reside at many addressess
 159 (def-view-class employee-address ()
 160   ((aemplid :type integer :initarg :emplid)
 161    (aaddressid :type integer :initarg :addressid)
 162    (verified :type boolean :initarg :verified)
 163    (address :db-kind :join
 164             :db-info (:join-class address
 165                                   :home-key aaddressid
 166                                   :foreign-key addressid
 167                                   :retrieval :immediate))
 168    (employee :db-kind :join
 169              :db-info (:join-class employee
 170                                   :home-key aemplid
 171                                   :foreign-key emplid
 172                                   :retrieval :immediate)))
 173   (:base-table "ea_join"))
 174
 175 (def-view-class deferred-employee-address ()
 176   ((aemplid :type integer :initarg :emplid)
 177    (aaddressid :type integer :initarg :addressid)
 178    (verified :type boolean :initarg :verified)
 179    (address :db-kind :join
 180             :db-info (:join-class address
 181                                   :home-key aaddressid
 182                                   :foreign-key addressid
 183                                   :retrieval :deferred
 184                                   :set nil)))
 185   (:base-table "ea_join"))
 186
 187 (def-view-class big ()
 188   ((i :type integer :initarg :i)
 189    (bi :type bigint :initarg :bi)))
 190
 191 (defun test-connect-to-database (db-type spec)
 192   (when (clsql-sys:db-backend-has-create/destroy-db? db-type)
 193     (ignore-errors (destroy-database spec :database-type db-type))
 194     (ignore-errors (create-database spec :database-type db-type)))
 195
 196   (setf *test-database-type* db-type)
 197   (setf *test-database-user*
 198     (cond
 199      ((eq :oracle db-type) (second spec))
 200      ((>= (length spec) 3) (third spec))))
 201
 202   ;; Connect to the database
 203   (clsql:connect spec
 204                  :database-type db-type
 205                  :make-default t
 206                  :if-exists :old)
 207
 208   ;; Ensure database is empty
 209   (truncate-database :database *default-database*)
 210
 211   (setf *test-database-underlying-type*
 212         (clsql-sys:database-underlying-type *default-database*))
 213
 214   *default-database*)
 215
 216 (defparameter company1 nil)
 217 (defparameter employee1 nil)
 218 (defparameter employee2 nil)
 219 (defparameter employee3 nil)
 220 (defparameter employee4 nil)
 221 (defparameter employee5 nil)
 222 (defparameter employee6 nil)
 223 (defparameter employee7 nil)
 224 (defparameter employee8 nil)
 225 (defparameter employee9 nil)
 226 (defparameter employee10 nil)
 227 (defparameter address1 nil)
 228 (defparameter address2 nil)
 229 (defparameter employee-address1 nil)
 230 (defparameter employee-address2 nil)
 231 (defparameter employee-address3 nil)
 232 (defparameter employee-address4 nil)
 233 (defparameter employee-address5 nil)
 234
 235 (defun test-initialise-database ()
 236   (test-basic-initialize)
 237   (let ((*backend-warning-behavior*
 238          (if (member *test-database-type* '(:postgresql :postgresql-socket))
 239              :ignore
 240            :warn)))
 241     (clsql:create-view-from-class 'employee)
 242     (clsql:create-view-from-class 'company)
 243     (clsql:create-view-from-class 'address)
 244     (clsql:create-view-from-class 'employee-address)
 245     (clsql:create-view-from-class 'big))
 246
 247   (setq *test-start-utime* (get-universal-time))
 248   (let* ((*db-auto-sync* t)
 249          (now-time (clsql:utime->time *test-start-utime*)))
 250     (setf company1 (make-instance 'company
 251                                   :presidentid 1
 252                                   :companyid 1
 253                                   :groupid 1
 254                                   :name "Widgets Inc.")
 255           employee1 (make-instance 'employee
 256                                    :emplid 1
 257                                    :groupid 1
 258                                    :married t
 259                                    :height (1+ (random 1.00))
 260                                    :bd-utime *test-start-utime*
 261                                    :birthday now-time
 262                                    :first-name "Vladimir"
 263                                    :last-name "Lenin"
 264                                    :email "lenin@soviet.org"
 265                                    :companyid 1)
 266           employee2 (make-instance 'employee
 267                                    :emplid 2
 268                                    :groupid 1
 269                                    :height (1+ (random 1.00))
 270                                    :married t
 271                                    :bd-utime *test-start-utime*
 272                                    :birthday now-time
 273                                    :first-name "Josef"
 274                                    :last-name "Stalin"
 275                                    :email "stalin@soviet.org"
 276                                    :managerid 1
 277                                    :companyid 1)
 278           employee3 (make-instance 'employee
 279                                    :emplid 3
 280                                    :groupid 1
 281                                    :height (1+ (random 1.00))
 282                                    :married t
 283                                    :bd-utime *test-start-utime*
 284                                    :birthday now-time
 285                                    :first-name "Leon"
 286                                    :last-name "Trotsky"
 287                                    :email "trotsky@soviet.org"
 288                                    :managerid 1
 289                                    :companyid 1)
 290           employee4 (make-instance 'employee
 291                                    :emplid 4
 292                                    :groupid 1
 293                                    :height (1+ (random 1.00))
 294                                    :married nil
 295                                    :bd-utime *test-start-utime*
 296                                    :birthday now-time
 297                                    :first-name "Nikita"
 298                                    :last-name "Kruschev"
 299                                    :email "kruschev@soviet.org"
 300                                    :managerid 1
 301                                    :companyid 1)
 302           employee5 (make-instance 'employee
 303                                    :emplid 5
 304                                    :groupid 1
 305                                    :married nil
 306                                    :height (1+ (random 1.00))
 307                                    :bd-utime *test-start-utime*
 308                                    :birthday now-time
 309                                    :first-name "Leonid"
 310                                    :last-name "Brezhnev"
 311                                    :email "brezhnev@soviet.org"
 312                                    :managerid 1
 313                                    :companyid 1)
 314           employee6 (make-instance 'employee
 315                                    :emplid 6
 316                                    :groupid 1
 317                                    :married nil
 318                                    :height (1+ (random 1.00))
 319                                    :bd-utime *test-start-utime*
 320                                    :birthday now-time
 321                                    :first-name "Yuri"
 322                                    :last-name "Andropov"
 323                                    :email "andropov@soviet.org"
 324                                    :managerid 1
 325                                    :companyid 1)
 326           employee7 (make-instance 'employee
 327                                    :emplid 7
 328                                    :groupid 1
 329                                    :height (1+ (random 1.00))
 330                                    :married nil
 331                                    :bd-utime *test-start-utime*
 332                                    :birthday now-time
 333                                    :first-name "Konstantin"
 334                                    :last-name "Chernenko"
 335                                    :email "chernenko@soviet.org"
 336                                    :managerid 1
 337                                    :companyid 1)
 338           employee8 (make-instance 'employee
 339                                    :emplid 8
 340                                    :groupid 1
 341                                    :height (1+ (random 1.00))
 342                                    :married nil
 343                                    :bd-utime *test-start-utime*
 344                                    :birthday now-time
 345                                    :first-name "Mikhail"
 346                                    :last-name "Gorbachev"
 347                                    :email "gorbachev@soviet.org"
 348                                    :managerid 1
 349                                    :companyid 1)
 350           employee9 (make-instance 'employee
 351                                    :emplid 9
 352                                    :groupid 1
 353                                    :married nil
 354                                    :height (1+ (random 1.00))
 355                                    :bd-utime *test-start-utime*
 356                                    :birthday now-time
 357                                    :first-name "Boris"
 358                                    :last-name "Yeltsin"
 359                                    :email "yeltsin@soviet.org"
 360                                    :managerid 1
 361                                    :companyid 1)
 362           employee10 (make-instance 'employee
 363                                     :emplid 10
 364                                     :groupid 1
 365                                     :married nil
 366                                     :height (1+ (random 1.00))
 367                                     :bd-utime *test-start-utime*
 368                                     :birthday now-time
 369                                     :first-name "Vladimir"
 370                                     :last-name "Putin"
 371                                     :email "putin@soviet.org"
 372                                     :managerid 1
 373                                     :companyid 1)
 374           address1 (make-instance 'address
 375                                   :addressid 1
 376                                   :street-number 10
 377                                   :street-name "Park Place"
 378                                   :city "Leningrad"
 379                                   :postal-code 123)
 380           address2 (make-instance 'address
 381                                   :addressid 2)
 382           employee-address1 (make-instance 'employee-address
 383                                            :emplid 1
 384                                            :addressid 1
 385                                            :verified t)
 386           employee-address2 (make-instance 'employee-address
 387                                            :emplid 2
 388                                            :addressid 2
 389                                            :verified t)
 390           employee-address3 (make-instance 'employee-address
 391                                            :emplid 3
 392                                            :addressid 1
 393                                            :verified nil)
 394           employee-address4 (make-instance 'employee-address
 395                                            :emplid 1
 396                                            :addressid 2
 397                                            :verified nil)
 398           employee-address5 (make-instance 'employee-address
 399                                            :emplid 3
 400                                            :addressid 2))
 401
 402     (let ((max (expt 2 60)))
 403       (dotimes (i 555)
 404         (make-instance 'big :i (1+ i) :bi (truncate max (1+ i))))))
 405
 406   ;; sleep to ensure birthdays are no longer at current time
 407   (sleep 1)
 408
 409   #||
 410   ;; Lenin manages everyone
 411   (clsql:add-to-relation employee2 'manager employee1)
 412   (clsql:add-to-relation employee3 'manager employee1)
 413   (clsql:add-to-relation employee4 'manager employee1)
 414   (clsql:add-to-relation employee5 'manager employee1)
 415   (clsql:add-to-relation employee6 'manager employee1)
 416   (clsql:add-to-relation employee7 'manager employee1)
 417   (clsql:add-to-relation employee8 'manager employee1)
 418   (clsql:add-to-relation employee9 'manager employee1)
 419   (clsql:add-to-relation employee10 'manager employee1)
 420   ;; Everyone works for Widgets Inc.
 421   (clsql:add-to-relation company1 'employees employee1)
 422   (clsql:add-to-relation company1 'employees employee2)
 423   (clsql:add-to-relation company1 'employees employee3)
 424   (clsql:add-to-relation company1 'employees employee4)
 425   (clsql:add-to-relation company1 'employees employee5)
 426   (clsql:add-to-relation company1 'employees employee6)
 427   (clsql:add-to-relation company1 'employees employee7)
 428   (clsql:add-to-relation company1 'employees employee8)
 429   (clsql:add-to-relation company1 'employees employee9)
 430   (clsql:add-to-relation company1 'employees employee10)
 431   ;; Lenin is president of Widgets Inc.
 432   (clsql:add-to-relation company1 'president employee1)
 433   ||#
 434
 435   ;; store these instances
 436   #||
 437   (clsql:update-records-from-instance employee1)
 438   (clsql:update-records-from-instance employee2)
 439   (clsql:update-records-from-instance employee3)
 440   (clsql:update-records-from-instance employee4)
 441   (clsql:update-records-from-instance employee5)
 442   (clsql:update-records-from-instance employee6)
 443   (clsql:update-records-from-instance employee7)
 444   (clsql:update-records-from-instance employee8)
 445   (clsql:update-records-from-instance employee9)
 446   (clsql:update-records-from-instance employee10)
 447   (clsql:update-records-from-instance company1)
 448   (clsql:update-records-from-instance address1)
 449   (clsql:update-records-from-instance address2)
 450   ||#
 451   )
 452
 453 (defvar *error-count* 0)
 454 (defvar *error-list* nil)
 455
 456 (defun run-function-append-report-file (function report-file)
 457     (let* ((report-path (etypecase report-file
 458                         (pathname report-file)
 459                         (string (parse-namestring report-file))))
 460          (sexp-report-path (make-pathname :defaults report-path
 461                                           :type "sexp")))
 462       (with-open-file (rs report-path :direction :output
 463                           :if-exists :append
 464                       :if-does-not-exist :create)
 465         (with-open-file (srs sexp-report-path :direction :output
 466                              :if-exists :append
 467                              :if-does-not-exist :create)
 468           (funcall function :report-stream rs :sexp-report-stream srs)))))
 469
 470 (defun run-tests-append-report-file (report-file)
 471   (run-function-append-report-file 'run-tests report-file))
 472
 473
 474 (defun run-tests (&key (report-stream *standard-output*) (sexp-report-stream nil))
 475   (let ((specs (read-specs))
 476         (*report-stream* report-stream)
 477         (*sexp-report-stream* sexp-report-stream)
 478         (*error-count* 0)
 479         (*error-list* nil))
 480     (unless specs
 481       (warn "Not running tests because test configuration file is missing")
 482       (return-from run-tests :skipped))
 483     (load-necessary-systems specs)
 484     (dolist (db-type +all-db-types+)
 485       (dolist (spec (db-type-spec db-type specs))
 486         (do-tests-for-backend db-type spec))))
 487   (zerop *error-count*))
 488
 489 (defun load-necessary-systems (specs)
 490   (dolist (db-type +all-db-types+)
 491     (when (db-type-spec db-type specs)
 492       (clsql-sys:initialize-database-type :database-type db-type))))
 493
 494 (defun write-report-banner (report-type db-type stream)
 495   (format stream
 496           "~&
 497 ******************************************************************************
 498 ***     CLSQL ~A begun at ~A
 499 ***     ~A
 500 ***     ~A on ~A
 501 ***     Database ~:@(~A~) backend~A.
 502 ******************************************************************************
 503 "
 504           report-type
 505           (clsql:format-time
 506            nil
 507            (clsql:utime->time (get-universal-time)))
 508           (lisp-implementation-type)
 509           (lisp-implementation-version)
 510           (machine-type)
 511           db-type
 512           (if (not (eq db-type *test-database-underlying-type*))
 513               (format nil " with underlying type ~:@(~A~)"
 514                       *test-database-underlying-type*)
 515               "")
 516           ))
 517
 518 (defun do-tests-for-backend (db-type spec)
 519   (test-connect-to-database db-type spec)
 520
 521   (unwind-protect
 522        (multiple-value-bind (test-forms skip-tests)
 523           (compute-tests-for-backend db-type *test-database-underlying-type*)
 524
 525          (write-report-banner "Test Suite" db-type *report-stream*)
 526
 527         (test-initialise-database)
 528
 529         (regression-test:rem-all-tests)
 530         (dolist (test-form test-forms)
 531           (eval test-form))
 532
 533         (let ((remaining (regression-test:do-tests *report-stream*)))
 534           (when (regression-test:pending-tests)
 535             (incf *error-count* (length remaining))))
 536
 537         (let ((sexp-error (list db-type
 538                                 *test-database-underlying-type*
 539                                 (get-universal-time)
 540                                 (length test-forms)
 541                                 (regression-test:pending-tests)
 542                                 (lisp-implementation-type)
 543                                 (lisp-implementation-version)
 544                                 (machine-type))))
 545           (when *sexp-report-stream*
 546             (write sexp-error :stream *sexp-report-stream* :readably t))
 547           (push sexp-error *error-list*))
 548
 549         (format *report-stream* "~&Tests skipped:")
 550         (if skip-tests
 551             (dolist (skipped skip-tests)
 552               (format *report-stream*
 553                       "~&   ~20A ~A~%" (car skipped) (cdr skipped)))
 554           (format *report-stream* " None~%")))
 555     (disconnect)))
 556
 557
 558 (defun compute-tests-for-backend (db-type db-underlying-type)
 559   (let ((test-forms '())
 560         (skip-tests '()))
 561     (dolist (test-form (append *rt-internal* *rt-connection* *rt-basic* *rt-fddl* *rt-fdml*
 562                                *rt-ooddl* *rt-oodml* *rt-syntax*))
 563       (let ((test (second test-form)))
 564         (cond
 565           ((and (null (clsql-sys:db-type-has-views? db-underlying-type))
 566                 (clsql-sys:in test :fddl/view/1 :fddl/view/2 :fddl/view/3 :fddl/view/4))
 567            (push (cons test "views not supported") skip-tests))
 568           ((and (null (clsql-sys:db-type-has-boolean-where? db-underlying-type))
 569                 (clsql-sys:in test :fdml/select/11 :oodml/select/5))
 570            (push (cons test "boolean where not supported") skip-tests))
 571           ((and (null (clsql-sys:db-type-has-subqueries? db-underlying-type))
 572                 (clsql-sys:in test :fdml/select/5 :fdml/select/10
 573                               :fdml/select/32 :fdml/select/33))
 574            (push (cons test "subqueries not supported") skip-tests))
 575           ((and (null (clsql-sys:db-type-transaction-capable? db-underlying-type
 576                                                     *default-database*))
 577                 (clsql-sys:in test :fdml/transaction/1 :fdml/transaction/2 :fdml/transaction/3 :fdml/transaction/4))
 578            (push (cons test "transactions not supported") skip-tests))
 579           ((and (null (clsql-sys:db-type-has-fancy-math? db-underlying-type))
 580                 (clsql-sys:in test :fdml/select/1))
 581            (push (cons test "fancy math not supported") skip-tests))
 582           ((and (eql *test-database-type* :sqlite)
 583                 (clsql-sys:in test :fddl/view/4 :fdml/select/10
 584                                 :fdml/select/21 :fdml/select/32
 585                                 :fdml/select/33))
 586            (push (cons test "not supported by sqlite") skip-tests))
 587           ((and (eql *test-database-type* :sqlite3)
 588                 (clsql-sys:in test :fddl/view/4 :fdml/select/10
 589                               :fdml/select/21 :fdml/select/32
 590                               :fdml/select/33))
 591            (push (cons test "not supported by sqlite3") skip-tests))
 592           ((and (not (clsql-sys:db-type-has-bigint? db-type))
 593                 (clsql-sys:in test :basic/bigint/1))
 594            (push (cons test "bigint not supported") skip-tests))
 595           ((and (eql *test-database-underlying-type* :mysql)
 596                 (clsql-sys:in test :fdml/select/26))
 597            (push (cons test "string table aliases not supported on all mysql versions") skip-tests))
 598           ((and (eql *test-database-underlying-type* :mysql)
 599                 (clsql-sys:in test :fdml/select/22 :fdml/query/5
 600                                 :fdml/query/7 :fdml/query/8))
 601            (push (cons test "not supported by mysql") skip-tests))
 602           ((and (null (clsql-sys:db-type-has-union? db-underlying-type))
 603                 (clsql-sys:in test :fdml/query/6 :fdml/select/31))
 604            (push (cons test "union not supported") skip-tests))
 605           ((and (eq *test-database-type* :oracle)
 606                 (clsql-sys:in test :fdml/query/8 :fdml/select/21
 607                               :fddl/table/6))
 608            (push (cons test "syntax not supported") skip-tests))
 609           ((and (eq *test-database-type* :odbc)
 610                 (eq *test-database-underlying-type* :postgresql)
 611                 (clsql-sys:in test :fddl/owner/1))
 612            (push (cons test "table ownership not supported by postgresql odbc driver") skip-tests))
 613           ((and (not (member *test-database-underlying-type*
 614                              '(:postgresql :oracle)))
 615                 (clsql-sys:in test :fddl/owner/1))
 616            (push (cons test "table ownership not supported") skip-tests))
 617           ((and (null (clsql-sys:db-type-has-intersect? db-underlying-type))
 618                 (clsql-sys:in test :fdml/query/7))
 619            (push (cons test "intersect not supported") skip-tests))
 620           ((and (null (clsql-sys:db-type-has-except? db-underlying-type))
 621                 (clsql-sys:in test :fdml/query/8))
 622            (push (cons test "except not supported") skip-tests))
 623           ((and (eq *test-database-underlying-type* :mssql)
 624                 (clsql-sys:in test :fdml/select/9))
 625            (push (cons test "mssql uses integer math for AVG") skip-tests))
 626           ((and (not (member *test-database-underlying-type*
 627                              '(:postgresql :mysql :sqlite3)))
 628                 (clsql-sys:in test :fdml/select/37 :fdml/select/38))
 629            (push (cons test "LIMIT keyword not supported in SELECT") skip-tests))
 630           (t
 631            (push test-form test-forms)))))
 632       (values (nreverse test-forms) (nreverse skip-tests))))
 633
 634 (defun rapid-load (type &optional (position 0))
 635   "Rapid load for interactive testing."
 636   (when *default-database*
 637       (disconnect :database *default-database*))
 638   (test-connect-to-database type (nth position (db-type-spec type (read-specs))))
 639   (test-initialise-database)
 640   *default-database*)
 641
 642 (defun rl ()
 643   (rapid-load :postgresql))
 644
 645 (defun rlm ()
 646   (rapid-load :mysql))
 647
 648 (defun rlo ()
 649   (rapid-load :oracle))