X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=tests%2Ftest-init.lisp;h=a12d2144d77c767bc568543b119ba7b4d227a439;hp=2481e8321a8bdf754602fda8a726986164dd31ac;hb=374df8f34a7214e08fc4cfc5d734d024acdbf9ca;hpb=f26d09724b4aa3d6bc8eae35582c8b15b9b3f5da diff --git a/tests/test-init.lisp b/tests/test-init.lisp index 2481e83..a12d214 100644 --- a/tests/test-init.lisp +++ b/tests/test-init.lisp @@ -26,6 +26,7 @@ (defvar *rt-oodml*) (defvar *rt-syntax*) (defvar *rt-time*) +(defvar *rt-pool*) ;; Below must be set as nil since test-i18n.lisp is not loaded on all platforms. (defvar *rt-i18n* nil) @@ -63,13 +64,21 @@ (setf *test-database-underlying-type* (clsql-sys:database-underlying-type *default-database*)) + ;; If Postgres, turn off notices to console + (when (eql db-type :postgresql) + (clsql:execute-command "SET client_min_messages = WARNING")) + *default-database*) (defun default-suites () "The default list of tests to run." - (append *rt-internal* *rt-connection* *rt-basic* *rt-fddl* *rt-fdml* + (append *rt-connection* *rt-basic* *rt-fddl* *rt-fdml* *rt-ooddl* *rt-oodml* *rt-syntax* *rt-time* *rt-i18n*)) +(defun internal-suites () + "The default internal suites that should run without any specific backend" + (append *rt-internal* *rt-pool*)) + (defvar *error-count* 0) (defvar *error-list* nil) @@ -93,9 +102,10 @@ (defun run-tests (&key (report-stream *standard-output*) (sexp-report-stream nil) - (suites (default-suites))) + (suites (append (internal-suites) (default-suites)))) ;; clear SQL-OUTPUT cache (setq clsql-sys::*output-hash* (make-hash-table :test #'equal)) + (setf *test-database-underlying-type* nil) (let ((specs (read-specs)) (*report-stream* report-stream) (*sexp-report-stream* sexp-report-stream) @@ -105,11 +115,16 @@ (warn "Not running tests because test configuration file is missing") (return-from run-tests :skipped)) (load-necessary-systems specs) - (dolist (db-type +all-db-types+) - (dolist (spec (db-type-spec db-type specs)) - (let ((*test-connection-spec* spec) - (*test-connection-db-type* db-type)) - (do-tests-for-backend db-type spec :suites suites))))) + ;;run the internal suites + (do-tests-for-internals :suites (intersection suites (internal-suites))) + ;; run backend-specific tests + (let ((suites (intersection suites (default-suites)))) + (when suites + (dolist (db-type +all-db-types+) + (dolist (spec (db-type-spec db-type specs)) + (let ((*test-connection-spec* spec) + (*test-connection-db-type* db-type)) + (do-tests-for-backend db-type spec :suites suites))))))) (zerop *error-count*)) (defun load-necessary-systems (specs) @@ -143,6 +158,34 @@ "") )) +(defun do-tests-for-internals (&key (suites (internal-suites))) + (write-report-banner "Test Suite" "CLSQL Internals" *report-stream* + "N/A") + (%do-tests suites nil)) + +(defun %do-tests (test-forms db-type) + (regression-test:rem-all-tests) + (dolist (test-form test-forms) + (eval test-form)) + + (let* ((cl:*print-right-margin* *test-report-width*) + (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*)) + ) + (defun do-tests-for-backend (db-type spec &key (suites (default-suites)) ) (test-connect-to-database db-type spec) @@ -153,26 +196,7 @@ (write-report-banner "Test Suite" db-type *report-stream* (database-name-from-spec spec db-type)) - (regression-test:rem-all-tests) - (dolist (test-form test-forms) - (eval test-form)) - - (let* ((cl:*print-right-margin* *test-report-width*) - (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*)) + (%do-tests test-forms db-type) (format *report-stream* "~&Tests skipped:") (if skip-tests @@ -238,7 +262,8 @@ ((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)) + :fdml/select/33 + :basic/reallybigintegers/1)) (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)) @@ -283,19 +308,20 @@ (clsql-sys:in test :fdml/select/9)) (push (cons test "mssql uses integer math for AVG.") skip-tests)) ((and (not (member *test-database-underlying-type* - '(:postgresql :mysql :sqlite3))) + '(:postgresql :mysql :sqlite3 ))) (clsql-sys:in test :fdml/select/37 :fdml/select/38)) (push (cons test "LIMIT keyword not supported in SELECT.") skip-tests)) ((and (not (clsql-sys:db-type-has-auto-increment? db-underlying-type)) (clsql-sys:in test :oodml/select/12 :oodml/select/13 :oodml/select/14 :oodml/select/15 :oodml/select/16 :oodml/select/17 :oodml/select/18 :oodml/select/19 :oodml/select/20 - :oodml/select/21 :oodml/select/22 + :oodml/select/21 :oodml/select/22 :oodml/select/23 :oodml/update-records/4 :oodml/update-records/4-slots :oodml/update-records/5 :oodml/update-records/5-slots :oodml/update-records/6 :oodml/update-records/7 :oodml/update-records/8 :oodml/update-records/9 - :oodml/update-records/9-slots :oodml/update-instance/3 + :oodml/update-records/9-slots :oodml/update-records/10 + :oodml/update-records/11 :OODML/UPDATE-RECORDS/12 :oodml/update-instance/3 :oodml/update-instance/4 :oodml/update-instance/5 :oodml/update-instance/6 :oodml/update-instance/7 :oodml/db-auto-sync/3 :oodml/db-auto-sync/4)) @@ -306,6 +332,22 @@ :time/pg/fdml/usec :time/pg/oodml/no-usec :time/pg/oodml/usec)) (push (cons test "Postgres specific test.") skip-tests)) + ((and (eql *test-database-type* :postgresql-socket3) + (clsql-sys:in test :BASIC/SELECT/2 :basic/select/3)) + (push (cons test "Postgres-socket3 always auto types") + skip-tests)) + ((and (eql *test-database-type* :postgresql-socket3) + (clsql-sys:in test :fdml/select/18)) + (push (cons test "Postgres-socket3 doesnt support attribute based type coersion") + skip-tests)) + ((and (eql *test-database-type* :postgresql-socket3) + (clsql-sys:in test :basic/map/1 :basic/map/2 :basic/map/3 :basic/map/4 + :basic/do/1 :basic/do/2 :fdml/do-query/1 :fdml/map-query/1 + :fdml/map-query/2 :fdml/map-query/3 :fdml/map-query/4 :fdml/loop/1 + :fdml/loop/2 :fdml/loop/3 + )) + (push (cons test "postgresql-socket3 doesnt support cursoring interface") + skip-tests)) ((and (member *test-database-underlying-type* '(:mysql)) (clsql-sys:in test :time/cross-platform/msec :time/cross-platform/usec/no-tz :time/cross-platform/usec/tz))