- :presidentid 1
- :companyid 1
- :groupid 1
- :name "Widgets Inc.")
- employee1 (make-instance 'employee
- :emplid 1
- :groupid 1
- :married t
- :height (1+ (random 1.00))
- :bd-utime *test-start-utime*
- :birthday now-time
- :first-name "Vladamir"
- :last-name "Lenin"
- :email "lenin@soviet.org"
- :companyid 1)
- employee2 (make-instance 'employee
- :emplid 2
- :groupid 1
- :height (1+ (random 1.00))
- :married t
- :bd-utime *test-start-utime*
- :birthday now-time
- :first-name "Josef"
- :last-name "Stalin"
- :email "stalin@soviet.org"
- :managerid 1
- :companyid 1)
- employee3 (make-instance 'employee
- :emplid 3
- :groupid 1
- :height (1+ (random 1.00))
- :married t
- :bd-utime *test-start-utime*
- :birthday now-time
- :first-name "Leon"
- :last-name "Trotsky"
- :email "trotsky@soviet.org"
- :managerid 1
- :companyid 1)
- employee4 (make-instance 'employee
- :emplid 4
- :groupid 1
- :height (1+ (random 1.00))
- :married nil
- :bd-utime *test-start-utime*
- :birthday now-time
- :first-name "Nikita"
- :last-name "Kruschev"
- :email "kruschev@soviet.org"
- :managerid 1
- :companyid 1)
- employee5 (make-instance 'employee
- :emplid 5
- :groupid 1
- :married nil
- :height (1+ (random 1.00))
- :bd-utime *test-start-utime*
- :birthday now-time
- :first-name "Leonid"
- :last-name "Brezhnev"
- :email "brezhnev@soviet.org"
- :managerid 1
- :companyid 1)
- employee6 (make-instance 'employee
- :emplid 6
- :groupid 1
- :married nil
- :height (1+ (random 1.00))
- :bd-utime *test-start-utime*
- :birthday now-time
- :first-name "Yuri"
- :last-name "Andropov"
- :email "andropov@soviet.org"
- :managerid 1
- :companyid 1)
- employee7 (make-instance 'employee
- :emplid 7
- :groupid 1
- :height (1+ (random 1.00))
- :married nil
- :bd-utime *test-start-utime*
- :birthday now-time
- :first-name "Konstantin"
- :last-name "Chernenko"
- :email "chernenko@soviet.org"
- :managerid 1
- :companyid 1)
- employee8 (make-instance 'employee
- :emplid 8
- :groupid 1
- :height (1+ (random 1.00))
- :married nil
- :bd-utime *test-start-utime*
- :birthday now-time
- :first-name "Mikhail"
- :last-name "Gorbachev"
- :email "gorbachev@soviet.org"
- :managerid 1
- :companyid 1)
- employee9 (make-instance 'employee
- :emplid 9
- :groupid 1
- :married nil
- :height (1+ (random 1.00))
- :bd-utime *test-start-utime*
- :birthday now-time
- :first-name "Boris"
- :last-name "Yeltsin"
- :email "yeltsin@soviet.org"
- :managerid 1
- :companyid 1)
- employee10 (make-instance 'employee
- :emplid 10
- :groupid 1
- :married nil
- :height (1+ (random 1.00))
- :bd-utime *test-start-utime*
- :birthday now-time
- :first-name "Vladamir"
- :last-name "Putin"
- :email "putin@soviet.org"
- :managerid 1
- :companyid 1)
- address1 (make-instance 'address
- :addressid 1
- :street-number 10
- :street-name "Park Place"
- :city "Leningrad"
- :postal-code 123)
- address2 (make-instance 'address
- :addressid 2)
- employee-address1 (make-instance 'employee-address
- :emplid 1
- :addressid 1
- :verified t)
- employee-address2 (make-instance 'employee-address
- :emplid 2
- :addressid 2
- :verified t)
- employee-address3 (make-instance 'employee-address
- :emplid 3
- :addressid 1
- :verified nil)
- employee-address4 (make-instance 'employee-address
- :emplid 1
- :addressid 2
- :verified nil)
- employee-address5 (make-instance 'employee-address
- :emplid 3
- :addressid 2))
+ :presidentid 1
+ :companyid 1
+ :groupid 1
+ :name "Widgets Inc.")
+ employee1 (make-instance 'employee
+ :emplid 1
+ :groupid 1
+ :married t
+ :height (1+ (random 1.00))
+ :bd-utime *test-start-utime*
+ :birthday now-time
+ :first-name "Vladimir"
+ :last-name "Lenin"
+ :email "lenin@soviet.org"
+ :companyid 1)
+ employee2 (make-instance 'employee
+ :emplid 2
+ :groupid 1
+ :height (1+ (random 1.00))
+ :married t
+ :bd-utime *test-start-utime*
+ :birthday now-time
+ :first-name "Josef"
+ :last-name "Stalin"
+ :email "stalin@soviet.org"
+ :managerid 1
+ :companyid 1)
+ employee3 (make-instance 'employee
+ :emplid 3
+ :groupid 1
+ :height (1+ (random 1.00))
+ :married t
+ :bd-utime *test-start-utime*
+ :birthday now-time
+ :first-name "Leon"
+ :last-name "Trotsky"
+ :email "trotsky@soviet.org"
+ :managerid 1
+ :companyid 1)
+ employee4 (make-instance 'employee
+ :emplid 4
+ :groupid 1
+ :height (1+ (random 1.00))
+ :married nil
+ :bd-utime *test-start-utime*
+ :birthday now-time
+ :first-name "Nikita"
+ :last-name "Kruschev"
+ :email "kruschev@soviet.org"
+ :managerid 1
+ :companyid 1)
+ employee5 (make-instance 'employee
+ :emplid 5
+ :groupid 1
+ :married nil
+ :height (1+ (random 1.00))
+ :bd-utime *test-start-utime*
+ :birthday now-time
+ :first-name "Leonid"
+ :last-name "Brezhnev"
+ :email "brezhnev@soviet.org"
+ :managerid 1
+ :companyid 1)
+ employee6 (make-instance 'employee
+ :emplid 6
+ :groupid 1
+ :married nil
+ :height (1+ (random 1.00))
+ :bd-utime *test-start-utime*
+ :birthday now-time
+ :first-name "Yuri"
+ :last-name "Andropov"
+ :email "andropov@soviet.org"
+ :managerid 1
+ :companyid 1)
+ employee7 (make-instance 'employee
+ :emplid 7
+ :groupid 1
+ :height (1+ (random 1.00))
+ :married nil
+ :bd-utime *test-start-utime*
+ :birthday now-time
+ :first-name "Konstantin"
+ :last-name "Chernenko"
+ :email "chernenko@soviet.org"
+ :managerid 1
+ :companyid 1)
+ employee8 (make-instance 'employee
+ :emplid 8
+ :groupid 1
+ :height (1+ (random 1.00))
+ :married nil
+ :bd-utime *test-start-utime*
+ :birthday now-time
+ :first-name "Mikhail"
+ :last-name "Gorbachev"
+ :email "gorbachev@soviet.org"
+ :managerid 1
+ :companyid 1)
+ employee9 (make-instance 'employee
+ :emplid 9
+ :groupid 1
+ :married nil
+ :height (1+ (random 1.00))
+ :bd-utime *test-start-utime*
+ :birthday now-time
+ :first-name "Boris"
+ :last-name "Yeltsin"
+ :email "yeltsin@soviet.org"
+ :managerid 1
+ :companyid 1)
+ employee10 (make-instance 'employee
+ :emplid 10
+ :groupid 1
+ :married nil
+ :height (1+ (random 1.00))
+ :bd-utime *test-start-utime*
+ :birthday now-time
+ :first-name "Vladimir"
+ :last-name "Putin"
+ :email "putin@soviet.org"
+ :managerid 1
+ :companyid 1)
+ address1 (make-instance 'address
+ :addressid 1
+ :street-number 10
+ :street-name "Park Place"
+ :city "Leningrad"
+ :postal-code 123)
+ address2 (make-instance 'address
+ :addressid 2)
+ employee-address1 (make-instance 'employee-address
+ :emplid 1
+ :addressid 1
+ :verified t)
+ employee-address2 (make-instance 'employee-address
+ :emplid 2
+ :addressid 2
+ :verified t)
+ employee-address3 (make-instance 'employee-address
+ :emplid 3
+ :addressid 1
+ :verified nil)
+ employee-address4 (make-instance 'employee-address
+ :emplid 1
+ :addressid 2
+ :verified nil)
+ employee-address5 (make-instance 'employee-address
+ :emplid 3
+ :addressid 2))
- (compute-tests-for-backend db-type *test-database-underlying-type*)
-
- (write-report-banner "Test Suite" db-type *report-stream*)
-
- (test-initialise-database)
-
- (regression-test:rem-all-tests)
- (dolist (test-form test-forms)
- (eval test-form))
-
- (let ((remaining (regression-test:do-tests *report-stream*)))
- (when (regression-test:pending-tests)
- (incf *error-count* (length remaining))))
-
- (let ((sexp-error (list db-type
- *test-database-underlying-type*
- (get-universal-time)
- (length test-forms)
- (regression-test:pending-tests)
- (lisp-implementation-type)
- (lisp-implementation-version)
- (machine-type))))
- (when *sexp-report-stream*
- (write sexp-error :stream *sexp-report-stream* :readably t))
- (push sexp-error *error-list*))
-
- (format *report-stream* "~&Tests skipped:")
- (if skip-tests
- (dolist (skipped skip-tests)
- (format *report-stream*
- "~& ~20A ~A~%" (car skipped) (cdr skipped)))
- (format *report-stream* " None~%")))
+ (compute-tests-for-backend db-type *test-database-underlying-type*)
+
+ (write-report-banner "Test Suite" db-type *report-stream*)
+
+ (test-initialise-database)
+
+ (regression-test:rem-all-tests)
+ (dolist (test-form test-forms)
+ (eval test-form))
+
+ (let ((remaining (regression-test:do-tests *report-stream*)))
+ (when (regression-test:pending-tests)
+ (incf *error-count* (length remaining))))
+
+ (let ((sexp-error (list db-type
+ *test-database-underlying-type*
+ (get-universal-time)
+ (length test-forms)
+ (regression-test:pending-tests)
+ (lisp-implementation-type)
+ (lisp-implementation-version)
+ (machine-type))))
+ (when *sexp-report-stream*
+ (write sexp-error :stream *sexp-report-stream* :readably t))
+ (push sexp-error *error-list*))
+
+ (format *report-stream* "~&Tests skipped:")
+ (if skip-tests
+ (dolist (skipped skip-tests)
+ (format *report-stream*
+ "~& ~20A ~A~%" (car skipped) (cdr skipped)))
+ (format *report-stream* " None~%")))
- (cond
- ((and (null (clsql-sys:db-type-has-views? db-underlying-type))
- (clsql-sys:in test :fddl/view/1 :fddl/view/2 :fddl/view/3 :fddl/view/4))
- (push (cons test "views not supported") skip-tests))
- ((and (null (clsql-sys:db-type-has-boolean-where? db-underlying-type))
- (clsql-sys:in test :fdml/select/11 :oodml/select/5))
- (push (cons test "boolean where not supported") skip-tests))
- ((and (null (clsql-sys:db-type-has-subqueries? db-underlying-type))
- (clsql-sys:in test :fdml/select/5 :fdml/select/10
+ (cond
+ ((and (null (clsql-sys:db-type-has-views? db-underlying-type))
+ (clsql-sys:in test :fddl/view/1 :fddl/view/2 :fddl/view/3 :fddl/view/4))
+ (push (cons test "views not supported") skip-tests))
+ ((and (null (clsql-sys:db-type-has-boolean-where? db-underlying-type))
+ (clsql-sys:in test :fdml/select/11 :oodml/select/5))
+ (push (cons test "boolean where not supported") skip-tests))
+ ((and (null (clsql-sys:db-type-has-subqueries? db-underlying-type))
+ (clsql-sys:in test :fdml/select/5 :fdml/select/10
- (push (cons test "subqueries not supported") skip-tests))
- ((and (null (clsql-sys:db-type-transaction-capable? db-underlying-type
- *default-database*))
- (clsql-sys:in test :fdml/transaction/1 :fdml/transaction/2 :fdml/transaction/3 :fdml/transaction/4))
- (push (cons test "transactions not supported") skip-tests))
- ((and (null (clsql-sys:db-type-has-fancy-math? db-underlying-type))
- (clsql-sys:in test :fdml/select/1))
- (push (cons test "fancy math not supported") skip-tests))
- ((and (eql *test-database-type* :sqlite)
- (clsql-sys:in test :fddl/view/4 :fdml/select/10
- :fdml/select/21 :fdml/select/32
+ (push (cons test "subqueries not supported") skip-tests))
+ ((and (null (clsql-sys:db-type-transaction-capable? db-underlying-type
+ *default-database*))
+ (clsql-sys:in test :fdml/transaction/1 :fdml/transaction/2 :fdml/transaction/3 :fdml/transaction/4))
+ (push (cons test "transactions not supported") skip-tests))
+ ((and (null (clsql-sys:db-type-has-fancy-math? db-underlying-type))
+ (clsql-sys:in test :fdml/select/1))
+ (push (cons test "fancy math not supported") skip-tests))
+ ((and (eql *test-database-type* :sqlite)
+ (clsql-sys:in test :fddl/view/4 :fdml/select/10
+ :fdml/select/21 :fdml/select/32
- (push (cons test "not supported by sqlite") skip-tests))
- ((and (eql *test-database-type* :sqlite3)
- (clsql-sys:in test :fddl/view/4 :fdml/select/10
- :fdml/select/21 :fdml/select/32
- :fdml/select/33))
- (push (cons test "not supported by sqlite3") skip-tests))
- ((and (not (clsql-sys:db-type-has-bigint? db-type))
- (clsql-sys:in test :basic/bigint/1))
- (push (cons test "bigint not supported") skip-tests))
- ((and (eql *test-database-underlying-type* :mysql)
- (clsql-sys:in test :fdml/select/26))
- (push (cons test "string table aliases not supported on all mysql versions") skip-tests))
- ((and (eql *test-database-underlying-type* :mysql)
- (clsql-sys:in test :fdml/select/22 :fdml/query/5
- :fdml/query/7 :fdml/query/8))
- (push (cons test "not supported by mysql") skip-tests))
- ((and (null (clsql-sys:db-type-has-union? db-underlying-type))
- (clsql-sys:in test :fdml/query/6 :fdml/select/31))
- (push (cons test "union not supported") skip-tests))
- ((and (eq *test-database-type* :oracle)
- (clsql-sys:in test :fdml/query/8 :fdml/select/21
+ (push (cons test "not supported by sqlite") skip-tests))
+ ((and (eql *test-database-type* :sqlite3)
+ (clsql-sys:in test :fddl/view/4 :fdml/select/10
+ :fdml/select/21 :fdml/select/32
+ :fdml/select/33))
+ (push (cons test "not supported by sqlite3") skip-tests))
+ ((and (not (clsql-sys:db-type-has-bigint? db-type))
+ (clsql-sys:in test :basic/bigint/1))
+ (push (cons test "bigint not supported") skip-tests))
+ ((and (eql *test-database-underlying-type* :mysql)
+ (clsql-sys:in test :fdml/select/26))
+ (push (cons test "string table aliases not supported on all mysql versions") skip-tests))
+ ((and (eql *test-database-underlying-type* :mysql)
+ (clsql-sys:in test :fdml/select/22 :fdml/query/5
+ :fdml/query/7 :fdml/query/8))
+ (push (cons test "not supported by mysql") skip-tests))
+ ((and (null (clsql-sys:db-type-has-union? db-underlying-type))
+ (clsql-sys:in test :fdml/query/6 :fdml/select/31))
+ (push (cons test "union not supported") skip-tests))
+ ((and (eq *test-database-type* :oracle)
+ (clsql-sys:in test :fdml/query/8 :fdml/select/21