From: Kevin M. Rosenberg Date: Sun, 11 Apr 2004 02:49:49 +0000 (+0000) Subject: r8936: merged classic-tests into tests X-Git-Tag: v3.8.6~680 X-Git-Url: http://git.kpe.io/?p=clsql.git;a=commitdiff_plain;h=fa32c4233b4a02ae631602dbb0a234ab10df8aaf r8936: merged classic-tests into tests --- diff --git a/ChangeLog b/ChangeLog index 248570e..ebc1347 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +10 Apr 2004 Kevin Rosenberg (kevin@rosenberg.net) + * Version 2.6.1: documentation fixes, merged + classic-tests into tests + 10 Apr 2004 Kevin Rosenberg (kevin@rosenberg.net) * Version 2.6.0 released: New API functions CREATE-DATABASE, DESTORY-DATABASE, PROBE-DATABASE diff --git a/NEWS b/NEWS index 3d158e3..edc7097 100644 --- a/NEWS +++ b/NEWS @@ -1,2 +1,4 @@ -CLSQL now supports the CommonSQL-API with the merge of the orphaned -UncommonSQL package. +Three new API functions added: create-database, destroy-database, +and probe-database. + +CLSQL now supports the CommonSQL-API. diff --git a/classic-tests/README b/classic-tests/README deleted file mode 100644 index 4fb0437..0000000 --- a/classic-tests/README +++ /dev/null @@ -1,8 +0,0 @@ -This test suite looks for a configuration file named -".clsql-test.config" located in the users home directory. This file -contains a single assoc-list that specifies the connection specs for -each database type to be tested. There is an example file in contained -in CLSQL's examples directory. - -These tests require the downloading of the rtest and ptester packages -from http://files.b9.com/. diff --git a/classic-tests/old-tests/xptest-clsql.lisp b/classic-tests/old-tests/xptest-clsql.lisp deleted file mode 100644 index 51fad13..0000000 --- a/classic-tests/old-tests/xptest-clsql.lisp +++ /dev/null @@ -1,224 +0,0 @@ -;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- -;;;; ************************************************************************* -;;;; FILE IDENTIFICATION -;;;; -;;;; Name: xptest-clsql.cl -;;;; Purpose: Test of CLSQL using XPTest package -;;;; Programmer: Kevin M. Rosenberg -;;;; Date Started: Mar 2002 -;;;; -;;;; $Id$ -;;;; -;;;; The XPTest package can be downloaded from -;;;; http://alpha.onshored.com/lisp-software/ -;;;; -;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg -;;;; -;;;; CLSQL users are granted the rights to distribute and use this software -;;;; as governed by the terms of the Lisp Lesser GNU Public License -;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. -;;;; ************************************************************************* - - -;;; This test suite looks for a configuration file named "test.config" -;;; This file contains a single a-list that specifies the connection -;;; specs for each database type to be tested. For example, to test all -;;; platforms, a sample "test.config" may look like: -;;; -;;; ((:mysql ("localhost" "a-mysql-db" "user1" "secret")) -;;; (:aodbc ("my-dsn" "a-user" "pass")) -;;; (:paostgresql ("localhost" "another-db" "user2" "dont-tell")) -;;; (:postgresql-socket ("pg-server" "a-db-name" "user" "secret-password"))) - -(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0))) -(in-package :cl-user) -(mk:load-system "XPTest") - -(in-package :clsql-user) -(use-package :xptest) - -(def-test-fixture clsql-fixture () - ((aodbc-spec :accessor aodbc-spec) - (mysql-spec :accessor mysql-spec) - (pgsql-spec :accessor pgsql-spec) - (pgsql-socket-spec :accessor pgsql-socket-spec)) - (:documentation "Test fixture for CLSQL testing")) - -(defvar *config-pathname* (make-pathname :name "test" - :type "config" - :defaults *load-truename*)) -(defmethod setup ((fix clsql-fixture)) - (if (probe-file *config-pathname*) - (let (config) - (with-open-file (stream *config-pathname* :direction :input) - (setq config (read stream))) - (setf (aodbc-spec fix) (cadr (assoc :aodbc config))) - (setf (mysql-spec fix) (cadr (assoc :mysql config))) - (setf (pgsql-spec fix) (cadr (assoc :postgresql config))) - (setf (pgsql-socket-spec fix) - (cadr (assoc :postgresql-socket config)))) - (error "XPTest Config file ~S not found" *config-pathname*))) - -(defmethod teardown ((fix clsql-fixture)) - t) - -(defmethod mysql-table-test ((test clsql-fixture)) - (test-table (mysql-spec test) :mysql)) - -(defmethod aodbc-table-test ((test clsql-fixture)) - (test-table (aodbc-spec test) :aodbc)) - -(defmethod pgsql-table-test ((test clsql-fixture)) - (test-table (pgsql-spec test) :postgresql)) - -(defmethod pgsql-socket-table-test ((test clsql-fixture)) - (test-table (pgsql-socket-spec test) :postgresql-socket)) - - -(defmethod test-table (spec type) - (when spec - (let ((db (clsql:connect spec :database-type type :if-exists :new))) - (unwind-protect - (progn - (create-test-table db) - (dolist (row (query "select * from test_clsql" :database db :types :auto)) - (test-table-row row :auto)) - (dolist (row (query "select * from test_clsql" :database db :types nil)) - (test-table-row row nil)) - (loop for row across (map-query 'vector #'list "select * from test_clsql" - :database db :types :auto) - do (test-table-row row :auto)) - (loop for row across (map-query 'vector #'list "select * from test_clsql" - :database db :types nil) - do (test-table-row row nil)) - (loop for row in (map-query 'list #'list "select * from test_clsql" - :database db :types nil) - do (test-table-row row nil)) - (loop for row in (map-query 'list #'list "select * from test_clsql" - :database db :types :auto) - do (test-table-row row :auto)) - (when (map-query nil #'list "select * from test_clsql" - :database db :types :auto) - (failure "Expected NIL result from map-query nil")) - (do-query ((int float bigint str) "select * from test_clsql") - (test-table-row (list int float bigint str) nil)) - (do-query ((int float bigint str) "select * from test_clsql" :types :auto) - (test-table-row (list int float bigint str) :auto)) - (drop-test-table db) - ) - (disconnect :database db))))) - - -(defmethod mysql-low-level ((test clsql-fixture)) - (let ((spec (mysql-spec test))) - (when spec - (let ((db (clsql-mysql::database-connect spec :mysql))) - (clsql-mysql::database-execute-command "DROP TABLE IF EXISTS test_clsql" db) - (clsql-mysql::database-execute-command - "CREATE TABLE test_clsql (i integer, sqrt double, sqrt_str CHAR(20))" db) - (dotimes (i 10) - (clsql-mysql::database-execute-command - (format nil "INSERT INTO test_clsql VALUES (~d,~d,'~a')" - i (number-to-sql-string (sqrt i)) - (number-to-sql-string (sqrt i))) - db)) - (let ((res (clsql-mysql::database-query-result-set "select * from test_clsql" db :full-set t :types nil))) - (unless (= 10 (mysql:mysql-num-rows (clsql-mysql::mysql-result-set-res-ptr res))) - (failure "Error calling mysql-num-rows")) - (clsql-mysql::database-dump-result-set res db)) - (clsql-mysql::database-execute-command "DROP TABLE test_clsql" db) - (clsql-mysql::database-disconnect db))))) - -(defparameter clsql-test-suite - (make-test-suite - "CLSQL Test Suite" - "Basic test suite for database operations." - ("MySQL Low Level Interface" 'clsql-fixture - :test-thunk 'mysql-low-level - :description "A test of MySQL low-level interface") - ("MySQL Table" 'clsql-fixture - :test-thunk 'mysql-table-test - :description "A test of MySQL") - ("PostgreSQL Table" 'clsql-fixture - :test-thunk 'pgsql-table-test - :description "A test of PostgreSQL tables") - ("PostgreSQL Socket Table" 'clsql-fixture - :test-thunk 'pgsql-socket-table-test - :description "A test of PostgreSQL Socket tables") - )) - -#+allegro -(add-test (make-test-case "AODBC table test" 'clsql-fixture - :test-thunk 'aodbc-table-test - :description "Test AODBC table") - clsql-test-suite) - -;;;; Testing functions - -(defun transform-float-1 (i) - (* i (abs (/ i 2)) (expt 10 (* 2 i)))) - -(defun transform-bigint-1 (i) - (* i (expt 10 (* 3 (abs i))))) - -(defun create-test-table (db) - (ignore-errors - (clsql:execute-command - "DROP TABLE test_clsql" :database db)) - (clsql:execute-command - "CREATE TABLE test_clsql (t_int integer, t_float float, t_bigint BIGINT, t_str CHAR(30))" - :database db) - (dotimes (i 11) - (let* ((test-int (- i 5)) - (test-flt (transform-float-1 test-int))) - (clsql:execute-command - (format nil "INSERT INTO test_clsql VALUES (~a,~a,~a,'~a')" - test-int - (number-to-sql-string test-flt) - (transform-bigint-1 test-int) - (number-to-sql-string test-flt) - ) - :database db)))) - -(defun parse-double (num-str) - (let ((*read-default-float-format* 'double-float)) - (coerce (read-from-string num-str) 'double-float))) - -(defun test-table-row (row types) - (unless (and (listp row) - (= 4 (length row))) - (failure "Row ~S is incorrect format" row)) - (destructuring-bind (int float bigint str) row - (cond - ((eq types :auto) - (unless (and (integerp int) - (typep float 'double-float) - (integerp bigint) - (stringp str)) - (failure "Incorrect field type for row ~S" row))) - ((null types) - (unless (and (stringp int) - (stringp float) - (stringp bigint) - (stringp str)) - (failure "Incorrect field type for row ~S" row)) - (setq int (parse-integer int)) - (setq bigint (parse-integer bigint)) - (setq float (parse-double float))) - ((listp types) - (error "NYI") - ) - (t - (failure "Invalid types field (~S) passed to test-table-row" types))) - (unless (= float (transform-float-1 int)) - (failure "Wrong float value ~A for int ~A (row ~S)" float int row)) - (unless (= float (parse-double str)) - (failure "Wrong string value ~A" str)))) - - -(defun drop-test-table (db) - (clsql:execute-command "DROP TABLE test_clsql")) - -(report-result (run-test clsql-test-suite :handle-errors nil) :verbose t) - - diff --git a/classic-tests/package.lisp b/classic-tests/package.lisp deleted file mode 100644 index b8d23bd..0000000 --- a/classic-tests/package.lisp +++ /dev/null @@ -1,32 +0,0 @@ -;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- -;;;; ************************************************************************* -;;;; FILE IDENTIFICATION -;;;; -;;;; Name: package.lisp -;;;; Purpose: Package file clsql testing suite -;;;; Author: Kevin M. Rosenberg -;;;; Date Started: Apr 2003 -;;;; -;;;; $Id$ -;;;; ************************************************************************* - -(in-package #:cl-user) - -(defpackage #:clsql-classic-tests - (:use #:asdf #:cl #:clsql #:ptester) - (:export - #:*config-pathname* - #:+all-db-types+ - #:conn-specs - #:aodbc-spec - #:mysql-spec - #:postgresql-spec - #:postgresql-socket-spec - #:sqlite-spec - #:read-specs - #:db-type-spec - #:db-type-ensure-system - )) - - - diff --git a/classic-tests/tables.lisp b/classic-tests/tables.lisp deleted file mode 100644 index 44d7ad2..0000000 --- a/classic-tests/tables.lisp +++ /dev/null @@ -1,262 +0,0 @@ -;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- -;;;; ************************************************************************* -;;;; FILE IDENTIFICATION -;;;; -;;;; Name: tables.lisp -;;;; Purpose: Table creation tests in CLSQL -;;;; Programmer: Kevin M. Rosenberg -;;;; Date Started: Mar 2002 -;;;; -;;;; $Id$ -;;;; -;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg -;;;; -;;;; CLSQL users are granted the rights to distribute and use this software -;;;; as governed by the terms of the Lisp Lesser GNU Public License -;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. -;;;; ************************************************************************* - -;;; This test suite looks for a configuration file named ".clsql-test.config" -;;; located in the users home directory. -;;; -;;; This file contains a single a-list that specifies the connection -;;; specs for each database type to be tested. For example, to test all -;;; platforms, a sample "test.config" may look like: -;;; -;;; ((:mysql ("localhost" "a-mysql-db" "user1" "secret")) -;;; (:aodbc ("my-dsn" "a-user" "pass")) -;;; (:postgresql ("localhost" "another-db" "user2" "dont-tell")) -;;; (:postgresql-socket ("pg-server" "a-db-name" "user" "secret-password"))) - -(in-package #:clsql-classic-tests) - -(defvar *config-pathname* - (make-pathname :default (user-homedir-pathname) - :name ".clsql-test" - :type ".config")) - -(defclass conn-specs () - ((aodbc-spec :accessor aodbc-spec) - (mysql-spec :accessor mysql-spec) - (pgsql-spec :accessor pgsql-spec) - (pgsql-socket-spec :accessor pgsql-socket-spec)) - (:documentation "Test fixture for CLSQL testing")) - - -(defun read-specs (&optional (path *config-pathname*)) - (if (probe-file path) - (with-open-file (stream path :direction :input) - (let ((config (read stream)) - (specs (make-instance 'conn-specs))) - (setf (aodbc-spec specs) (cadr (assoc :aodbc config))) - (setf (mysql-spec specs) (cadr (assoc :mysql config))) - (setf (pgsql-spec specs) (cadr (assoc :postgresql config))) - (setf (pgsql-socket-spec specs) - (cadr (assoc :postgresql-socket config))) - specs)) - (warn "CLSQL tester config file ~S not found" path))) - -(defvar *conn-specs* (read-specs)) - -(defmethod mysql-table-test ((test conn-specs)) - (test-table (mysql-spec test) :mysql)) - -(defmethod aodbc-table-test ((test conn-specs)) - (test-table (aodbc-spec test) :aodbc)) - -(defmethod pgsql-table-test ((test conn-specs)) - (test-table (pgsql-spec test) :postgresql)) - -(defmethod pgsql-socket-table-test ((test conn-specs)) - (test-table (pgsql-socket-spec test) :postgresql-socket)) - -(defmethod test-table (spec type) - (when spec - (let ((db (clsql:connect spec :database-type type :if-exists :new))) - (unwind-protect - (progn - (create-test-table db) - (dolist (row (query "select * from test_clsql" :database db :result-types :auto)) - (test-table-row row :auto type)) - (dolist (row (query "select * from test_clsql" :database db :result-types nil)) - (test-table-row row nil type)) - (loop for row across (map-query 'vector #'list "select * from test_clsql" - :database db :result-types :auto) - do (test-table-row row :auto type)) - (loop for row across (map-query 'vector #'list "select * from test_clsql" - :database db :result-types nil) - do (test-table-row row nil type)) - (loop for row in (map-query 'list #'list "select * from test_clsql" - :database db :result-types nil) - do (test-table-row row nil type)) - (loop for row in (map-query 'list #'list "select * from test_clsql" - :database db :result-types :auto) - do (test-table-row row :auto type)) - (test (map-query nil #'list "select * from test_clsql" - :database db :result-types :auto) - nil - :fail-info "Expected NIL result from map-query nil") - (do-query ((int float bigint str) "select * from test_clsql") - (test-table-row (list int float bigint str) nil type)) - (do-query ((int float bigint str) "select * from test_clsql" :result-types :auto) - (test-table-row (list int float bigint str) :auto type)) - (drop-test-table db) - ) - (disconnect :database db))))) - - -;;;; Testing functions - -(defun transform-float-1 (i) - (coerce (* i (abs (/ i 2)) (expt 10 (* 2 i))) 'double-float)) - -(defun transform-bigint-1 (i) - (* i (expt 10 (* 3 (abs i))))) - -(defun create-test-table (db) - (ignore-errors - (clsql:execute-command - "DROP TABLE test_clsql" :database db)) - (clsql:execute-command - "CREATE TABLE test_clsql (t_int integer, t_float float, t_bigint BIGINT, t_str CHAR(30))" - :database db) - (dotimes (i 11) - (let* ((test-int (- i 5)) - (test-flt (transform-float-1 test-int))) - (clsql:execute-command - (format nil "INSERT INTO test_clsql VALUES (~a,~a,~a,'~a')" - test-int - (number-to-sql-string test-flt) - (transform-bigint-1 test-int) - (number-to-sql-string test-flt) - ) - :database db)))) - -(defun parse-double (num-str) - (let ((*read-default-float-format* 'double-float)) - (coerce (read-from-string num-str) 'double-float))) - -(defun test-table-row (row types db-type) - (test (and (listp row) - (= 4 (length row))) - t - :fail-info - (format nil "Row ~S is incorrect format" row)) - (destructuring-bind (int float bigint str) row - (cond - ((eq types :auto) - (test (and (integerp int) - (typep float 'double-float) - (or (eq db-type :aodbc) ;; aodbc doesn't handle bigint conversions - (integerp bigint)) - (stringp str)) - t - :fail-info - (format nil "Incorrect field type for row ~S (types :auto)" row))) - ((null types) - (test (and (stringp int) - (stringp float) - (stringp bigint) - (stringp str)) - t - :fail-info - (format nil "Incorrect field type for row ~S (types nil)" row)) - (setq int (parse-integer int)) - (setq bigint (parse-integer bigint)) - (setq float (parse-double float))) - ((listp types) - (error "NYI") - ) - (t - (test t nil - :fail-info - (format nil "Invalid types field (~S) passed to test-table-row" types)))) - (test (transform-float-1 int) - float - :test #'eql - :fail-info - (format nil "Wrong float value ~A for int ~A (row ~S)" float int row)) - (test float - (parse-double str) - :test #'double-float-equal - :fail-info (format nil "Wrong string value ~A for double ~A~%Row: ~S" - str float row)))) - - -(defun double-float-equal (a b) - (if (zerop a) - (if (zerop b) - t - nil) - (let ((diff (abs (/ (- a b) a)))) - (if (> diff (* 10 double-float-epsilon)) - nil - t)))) - -(defun drop-test-table (db) - (clsql:execute-command "DROP TABLE test_clsql" :database db)) - - -(deftest lowlevel.mysql.table.1 - (let ((spec (mysql-spec *conn-specs*)) - (result)) - (when spec - (let ((db (clsql-mysql::database-connect spec :mysql))) - (clsql-mysql::database-execute-command "DROP TABLE IF EXISTS test_clsql" db) - (clsql-mysql::database-execute-command - "CREATE TABLE test_clsql (i integer, sqrt double, sqrt_str CHAR(20))" db) - (dotimes (i 10) - (clsql-mysql::database-execute-command - (format nil "INSERT INTO test_clsql VALUES (~d,~d,'~a')" - i (clsql:number-to-sql-string (sqrt i)) - (clsql:number-to-sql-string (sqrt i))) - db)) - (let ((res (clsql-mysql::database-query-result-set "select * from test_clsql" db :full-set t :result-types nil))) - (setq result (mysql:mysql-num-rows - (clsql-mysql::mysql-result-set-res-ptr res))) - (clsql-mysql::database-dump-result-set res db)) - (clsql-mysql::database-execute-command "DROP TABLE test_clsql" db) - (clsql-mysql::database-disconnect db)))) - 10) - -;(mysql-table-test specs) -;(pgsql-table-test specs) -;(pgsql-socket-table-test specs) -;(aodbc-table-test specs) - - - -(defmacro def-test-table (name spec type) - (deftest ,name - (when ,spec - (let ((db (clsql:connect ,spec :database-type ,type :if-exists :new))) - (unwind-protect - (progn - (create-test-table db) - (dolist (row (query "select * from test_clsql" :database db :result-types :auto)) - (test-table-row row :auto type)) - (dolist (row (query "select * from test_clsql" :database db :result-types nil)) - (test-table-row row nil type)) - (loop for row across (map-query 'vector #'list "select * from test_clsql" - :database db :result-types :auto) - do (test-table-row row :auto type)) - (loop for row across (map-query 'vector #'list "select * from test_clsql" - :database db :result-types nil) - do (test-table-row row nil type)) - (loop for row in (map-query 'list #'list "select * from test_clsql" - :database db :result-types nil) - do (test-table-row row nil type)) - (loop for row in (map-query 'list #'list "select * from test_clsql" - :database db :result-types :auto) - do (test-table-row row :auto type)) - (test (map-query nil #'list "select * from test_clsql" - :database db :result-types :auto) - nil - :fail-info "Expected NIL result from map-query nil") - (do-query ((int float bigint str) "select * from test_clsql") - (test-table-row (list int float bigint str) nil type)) - (do-query ((int float bigint str) "select * from test_clsql" :result-types :auto) - (test-table-row (list int float bigint str) :auto type)) - (drop-test-table db) - ) - (disconnect :database db))))) diff --git a/classic-tests/tests.lisp b/classic-tests/tests.lisp deleted file mode 100644 index d94ed47..0000000 --- a/classic-tests/tests.lisp +++ /dev/null @@ -1,289 +0,0 @@ -;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- -;;;; ************************************************************************* -;;;; FILE IDENTIFICATION -;;;; -;;;; Name: classic-tests.lisp -;;;; Purpose: Automated test of CLSQL using ACL's tester -;;;; Programmer: Kevin M. Rosenberg -;;;; Date Started: Mar 2002 -;;;; -;;;; $Id$ -;;;; -;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg -;;;; -;;;; CLSQL users are granted the rights to distribute and use this software -;;;; as governed by the terms of the Lisp Lesser GNU Public License -;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. -;;;; ************************************************************************* - -;;; This test suite looks for a configuration file named ".clsql-test.config" -;;; located in the users home directory. -;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- -;;;; ************************************************************************* -;;;; FILE IDENTIFICATION -;;;; -;;;; File: tests.lisp -;;;; Author: Kevin Rosenberg -;;;; $Id$ -;;;; -;;;; This file is part of CLSQL. -;;;; -;;;; CLSQL users are granted the rights to distribute and use this software -;;;; as governed by the terms of the Lisp Lesser GNU Public License -;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. -;;;; ************************************************************************* - -;;; You need a file named "~/.clsql-tests.config" - -;;; This file contains a single a-list that specifies the connection -;;; specs for each database type to be tested. For example, to test all -;;; platforms, a sample "test.config" may look like: -;;; -;;; ((:mysql ("localhost" "a-mysql-db" "user1" "secret")) -;;; (:aodbc ("my-dsn" "a-user" "pass")) -;;; (:postgresql ("localhost" "another-db" "user2" "dont-tell")) -;;; (:postgresql-socket ("pg-server" "a-db-name" "user" "secret-password")) -;;; (:sqlite ("path-to-sqlite-db"))) - -(in-package #:clsql-classic-tests) - -(defvar *config-pathname* - (make-pathname :defaults (user-homedir-pathname) - :name ".clsql-test" - :type "config")) - -(defvar +all-db-types+ - #-clisp '(:postgresql :postgresql-socket :sqlite :aodbc :mysql) - #+clisp '(:sqlite)) - -(defclass conn-specs () - ((aodbc-spec :accessor aodbc-spec :initform nil) - (mysql-spec :accessor mysql-spec :initform nil) - (pgsql-spec :accessor postgresql-spec :initform nil) - (pgsql-socket-spec :accessor postgresql-socket-spec :initform nil) - (sqlite-spec :accessor sqlite-spec :initform nil)) - (:documentation "Connection specs for CLSQL testing")) - - -(defun read-specs (&optional (path *config-pathname*)) - (if (probe-file path) - (with-open-file (stream path :direction :input) - (let ((config (read stream)) - (specs (make-instance 'conn-specs))) - (setf (aodbc-spec specs) (cadr (assoc :aodbc config))) - (setf (mysql-spec specs) (cadr (assoc :mysql config))) - (setf (postgresql-spec specs) (cadr (assoc :postgresql config))) - (setf (postgresql-socket-spec specs) - (cadr (assoc :postgresql-socket config))) - (setf (sqlite-spec specs) (cadr (assoc :sqlite config))) - specs)) - (progn - (warn "CLSQL test config file ~S not found" path) - nil))) - -(defgeneric test-table (spec type)) - -(defmethod test-table (spec type) - (when spec - (let ((db (clsql:connect spec :database-type type :if-exists :new))) - (unwind-protect - (progn - (create-test-table db) - (dolist (row (query "select * from test_clsql" :database db :result-types :auto)) - (test-table-row row :auto type)) - (dolist (row (query "select * from test_clsql" :database db :result-types nil)) - (test-table-row row nil type)) - (loop for row across (map-query 'vector #'list "select * from test_clsql" - :database db :result-types :auto) - do (test-table-row row :auto type)) - (loop for row across (map-query 'vector #'list "select * from test_clsql" - :database db :result-types nil) - do (test-table-row row nil type)) - (loop for row in (map-query 'list #'list "select * from test_clsql" - :database db :result-types nil) - do (test-table-row row nil type)) - (loop for row in (map-query 'list #'list "select * from test_clsql" - :database db :result-types :auto) - do (test-table-row row :auto type)) - (test (map-query nil #'list "select * from test_clsql" - :database db :result-types :auto) - nil - :fail-info "Expected NIL result from map-query nil") - (do-query ((int float bigint str) "select * from test_clsql") - (test-table-row (list int float bigint str) nil type)) - (do-query ((int float bigint str) "select * from test_clsql" :result-types :auto) - (test-table-row (list int float bigint str) :auto type)) - (drop-test-table db) - ) - (disconnect :database db))))) - -;;; -;;; SQLite is typeless: execute untyped tests only. -;;; -(defmethod test-table (spec (type (eql :sqlite))) - (when spec - (let ((db (clsql:connect spec :database-type type :if-exists :new))) - (unwind-protect - (progn - (create-test-table db) - (dolist (row (query "select * from test_clsql" :database db :result-types nil)) - (test-table-row row nil type)) - (loop for row across (map-query 'vector #'list "select * from test_clsql" - :database db :result-types nil) - do (test-table-row row nil type)) - (loop for row in (map-query 'list #'list "select * from test_clsql" - :database db :result-types nil) - do (test-table-row row nil type)) - - (do-query ((int float bigint str) "select * from test_clsql") - (test-table-row (list int float bigint str) nil type)) - (drop-test-table db) - ) - (disconnect :database db))))) - -(defun mysql-low-level (specs) - #-clisp - (let ((spec (mysql-spec specs))) - (when spec - (let ((db (clsql-mysql::database-connect spec :mysql))) - (clsql-mysql::database-execute-command "DROP TABLE IF EXISTS test_clsql" db) - (clsql-mysql::database-execute-command - "CREATE TABLE test_clsql (i integer, sqrt double, sqrt_str CHAR(20))" db) - (dotimes (i 10) - (clsql-mysql::database-execute-command - (format nil "INSERT INTO test_clsql VALUES (~d,~d,'~a')" - i (clsql-base:number-to-sql-string (sqrt i)) - (clsql-base:number-to-sql-string (sqrt i))) - db)) - (let ((res (clsql-mysql::database-query-result-set "select * from test_clsql" db :full-set t :result-types nil))) - (test (mysql:mysql-num-rows - (clsql-mysql::mysql-result-set-res-ptr res)) - 10 - :test #'eql - :fail-info "Error calling mysql-num-rows") - (clsql-mysql::database-dump-result-set res db)) - (clsql-mysql::database-execute-command "DROP TABLE test_clsql" db) - (clsql-mysql::database-disconnect db))))) - - - -;;;; Testing functions - -(defun transform-float-1 (i) - (coerce (* i (abs (/ i 2)) (expt 10 (* 2 i))) 'double-float)) - -(defun transform-bigint-1 (i) - (* i (expt 10 (* 3 (abs i))))) - -(defun create-test-table (db) - (ignore-errors - (clsql:execute-command - "DROP TABLE test_clsql" :database db)) - (clsql:execute-command - "CREATE TABLE test_clsql (t_int integer, t_float float, t_bigint BIGINT, t_str CHAR(30))" - :database db) - (dotimes (i 11) - (let* ((test-int (- i 5)) - (test-flt (transform-float-1 test-int))) - (clsql:execute-command - (format nil "INSERT INTO test_clsql VALUES (~a,~a,~a,'~a')" - test-int - (clsql-base:number-to-sql-string test-flt) - (transform-bigint-1 test-int) - (clsql-base:number-to-sql-string test-flt) - ) - :database db)))) - -(defun parse-double (num-str) - (let ((*read-default-float-format* 'double-float)) - (coerce (read-from-string num-str) 'double-float))) - -(defun test-table-row (row types db-type) - (test (and (listp row) - (= 4 (length row))) - t - :fail-info - (format nil "Row ~S is incorrect format" row)) - (destructuring-bind (int float bigint str) row - (cond - ((eq types :auto) - (test (and (integerp int) - (typep float 'double-float) - (or (eq db-type :aodbc) ;; aodbc doesn't handle bigint conversions - (integerp bigint)) - (stringp str)) - t - :fail-info - (format nil "Incorrect field type for row ~S (types :auto)" row))) - ((null types) - (test (and (stringp int) - (stringp float) - (stringp bigint) - (stringp str)) - t - :fail-info - (format nil "Incorrect field type for row ~S (types nil)" row)) - (setq int (parse-integer int)) - (setq bigint (parse-integer bigint)) - (setq float (parse-double float))) - ((listp types) - (error "NYI") - ) - (t - (test t nil - :fail-info - (format nil "Invalid types field (~S) passed to test-table-row" types)))) - (unless (eq db-type :sqlite) ; SQLite is typeless. - (test (transform-float-1 int) - float - :test #'eql - :fail-info - (format nil "Wrong float value ~A for int ~A (row ~S)" float int row))) - (test float - (parse-double str) - :test #'double-float-equal - :fail-info (format nil "Wrong string value ~A for double ~A~%Row: ~S" - str float row)))) - - -(defun double-float-equal (a b) - (if (zerop a) - (if (zerop b) - t - nil) - (let ((diff (abs (/ (- a b) a)))) - (if (> diff (* 10 double-float-epsilon)) - nil - t)))) - -(defun drop-test-table (db) - (clsql:execute-command "DROP TABLE test_clsql" :database db)) - -(defun db-type-spec (db-type specs) - (let ((accessor (intern (concatenate 'string (symbol-name db-type) - (symbol-name '#:-spec)) - (find-package '#:clsql-classic-tests)))) - (funcall accessor specs))) - -(defun db-type-ensure-system (db-type) - (unless (find-package (symbol-name db-type)) - (asdf:operate 'asdf:load-op - (intern (concatenate 'string - (symbol-name '#:clsql-) - (symbol-name db-type)))))) - -(defun run-tests () - (let ((specs (read-specs))) - (unless specs - (warn "Not running test because test configuration file is missing") - (return-from run-tests :skipped)) - (mysql-low-level specs) - (with-tests (:name "CLSQL") - (dolist (db-type +all-db-types+) - (let ((spec (db-type-spec db-type specs))) - (when spec - (db-type-ensure-system db-type) - (ignore-errors (destroy-database spec db-type)) - (ignore-errors (create-database spec db-type)) - (test-table spec db-type)))))) - t) diff --git a/clsql-classic-tests.asd b/clsql-classic-tests.asd deleted file mode 100644 index 3d2961f..0000000 --- a/clsql-classic-tests.asd +++ /dev/null @@ -1,37 +0,0 @@ -;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- -;;;; ************************************************************************* -;;;; FILE IDENTIFICATION -;;;; -;;;; Name: clsql-classic-tests.asd -;;;; Purpose: ASDF system definitionf for clsql testing package -;;;; Author: Kevin M. Rosenberg -;;;; Date Started: Apr 2003 -;;;; -;;;; $Id$ -;;;; ************************************************************************* - -(in-package #:cl-user) -(defpackage #:clsql-classic-tests-system (:use #:asdf #:cl)) -(in-package #:clsql-classic-tests-system) - -(defsystem clsql-classic-tests - :name "clsql-classic-tests" - :author "Kevin Rosenberg " - :maintainer "Kevin M. Rosenberg " - :licence "Lessor Lisp General Public License" - :description "Testing suite for CLSQL" - - :depends-on (clsql ptester #-clisp clsql-mysql) - :components - ((:module :classic-tests - :components - ((:file "package") -;; (:file "tables" :depends-on ("package"))) - (:file "tests" :depends-on ("package"))) - ))) - -(defmethod perform ((o test-op) (c (eql (find-system 'clsql-classic-tests)))) - (unless (funcall (intern (symbol-name '#:run-tests) - (find-package '#:clsql-classic-tests))) - (error "test-op failed"))) - diff --git a/clsql-classic.asd b/clsql-classic.asd index a700cfd..73734df 100644 --- a/clsql-classic.asd +++ b/clsql-classic.asd @@ -39,5 +39,4 @@ #+(or allegro lispworks cmu sbcl openmcl mcl scl) (defmethod perform ((o test-op) (c (eql (find-system 'clsql-classic)))) - (operate 'load-op 'clsql-classic-tests) - (operate 'test-op 'clsql-classic-tests)) + (warn "Testing is provided by the CLSQL-TESTS system")) diff --git a/clsql-tests.asd b/clsql-tests.asd index b4cbdb9..eeca182 100644 --- a/clsql-tests.asd +++ b/clsql-tests.asd @@ -25,12 +25,14 @@ :version "" :licence "" :description "A regression test suite for CLSQL." - :depends-on (clsql clsql-classic-tests rt) + :depends-on (clsql ptester rt) :components ((:module tests :serial t :components ((:file "package") + (:file "utils") (:file "test-init") + (:file "test-basic") (:file "test-connection") (:file "test-fddl") (:file "test-fdml") diff --git a/debian/changelog b/debian/changelog index 5d749ae..7669196 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +cl-sql (2.6.1-1) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg Sat, 10 Apr 2004 19:49:58 -0600 + cl-sql (2.6.0-1) unstable; urgency=low * New upstream diff --git a/doc/clsql.pdf b/doc/clsql.pdf index c63b94c..8595497 100644 --- a/doc/clsql.pdf +++ b/doc/clsql.pdf @@ -2049,10 +2049,10 @@ endobj >> endobj 313 0 obj -<< /Length 1446 /Filter [ /ASCII85Decode /FlateDecode ] +<< /Length 1455 /Filter [ /ASCII85Decode /FlateDecode ] >> stream -Gau0C997gc&AJ$C#^`M`_29b"e8'UNofoi(B4c6l$e?NoPUr8tn`=iQ%XG0:^EP^DY>Dcb\]4*RlVB\BrWTG[b?UM5_BjB5/c+)k,g?^js-7m'P*F%sUV4[4b_Q44gerZP;>$4UoF7*^[9Siak+\QMT?]0Ro[tQM6hcfqm%hfB#$:#qh%0YrkLc^os+_?@/9*EP[hE'5FBP/8le/'*>efCj!l-r1d9_cfA^8#4Ra\ldTA/]au:CRDqMH17`tSbq]nI$-dS#-fG6\d'WYl5CFiU9E$%PW&.rJ`G&+#GXL%)e=V6L"`]L$+RBYoKX'k4g,9"uW6IH^*-NSX=BSbX"hngt?KNg(d!t*J5hMp?KOr=0VVtd7ES-i5:jK59?u&:'8qT^*KXbW$NJf%2RN@7]CfIEL)3sT7^fK4)iRI!.8jl5@#K]U=!Kt=jaF!&?o18ZoC_N[*,;DBXKu,:;Eo&9p^R(d[,`R0FZd&o'^]rAhdUj@*_&Xt7ZM!MWSng3;%[Ym8CLLegm*#lG)$Xi"3rUd/D_!Tk/k?dMs"\+10i`sDQP=ega%9gH>R!/_lh5@L6F$SF\eMBALCN?h;CJZ8?'Yk1$8'>D0N=sojT)r*9c5Z3V3^[*NPK5rkQ-oWm%8[HN>X;j_%_NPiS'rgbIOYTc#COdPijNg@b,4lCT0#LY-MFP[7oAG)I+%'(g!G[.7h:207a=?,X"?X;lrIcELddJgLXXm`1JYWG$&RL?@=8pE0$%s]d?GYcZJH`u\RcQ(ml&JMXiQks'8@I]pj?CrkdbLK3l^:aC>o&]_@ZM:KI0q`d*-5#LTV3Z,FX*SJUelGJYU64IHp>j;$9@?e-gWC>;cQn.7>7iUYNrDqLnJU;kQ8]4ge$1mbW#=52WAZ"s4)h9ai_[>JDEn?qU'k)dAKoK@JZI$d@p6/@,_E$=&a*Vme"\+T`9K9M:r-:R>'q4p>-2C&A[IO%:/cI<^6.I&YbG@Xm#b[er6@\r$%Qcb"\="c$IJlF\>8]ng.b'Z7tLDFK>NUD3e#sk9Dl!i5`>>QYm_u:lG)5AR#Cb*L&Vr>cNZVq7#NE7-dP(ccp7Ylb)LO'1sGO:"p@IZLla"?rsP8kg3s~> +Gau0C95iiK&AJ$C#WX``,%aB&H3ItZ-gLq>Cq&&!D6_a[JWZm5=BT`6.:3&O;A(9R%mLOUI,U%Iq9\O<:$VIip])LVUrRUXOlZ+,"n9!Pso,M4B\db;'tO$-VIY9>`!W/S#?VJ,2q7a8B(bUsauX0D8Ur`#CU)U&OtJ.#7ukK((N(.HdVf[;?=G=dqkZ;Jp/Kn>`^q$[`n%;]H4XI5Sc]"]bBJkfKncBO$>HH,dc/_FucYYG6hD^^d6I\nXf;*:U[rC4>_[FFFiJ^NM(g5rRIsRn8D/Jq_/TK3k>G1u8Z.oXoR_\k#spdP^((L#QHqVUERW%*K7]FKINH!uO)uB$Xi58oeBJ>*]C9p;TH_Qki15Yg!,#WFli\$0Sqa5KF7Z5[8S;[6/*tS^RFKSYV^J,2Xd$MafLF-??])oJkMVd9DahD3`O'+KJ\ZVXFP`D2=AL*$.Z?O"[Q[+7H)/M)"=*4hV/;h()+s&JL:MUu>,P8>8hABhZ)3VW$GiJ"rGcU<-\a86cXQ:6rtC4lCT@#79mEEc<0W&<&dZTJ+]M=qb?EB:&E+SolPUB%D1X&fNs(cdDBC%=Q[/_i<)5Im(KhH^C#Xh6r)MQ@o7J&KSPV_o(0i<_fE/R0-;;9I/J/6:mphGVNV(0*N+-Q=R,XD$tqUHLWBf9.u@k-juEgh2M\%]tOhFN8>LYkW`fnFr,G'=Th$6;5#6Sa>Y'[38<.2hi!6`Cup6 endstream endobj 314 0 obj @@ -2064,10 +2064,10 @@ endobj >> endobj 315 0 obj -<< /Length 483 /Filter [ /ASCII85Decode /FlateDecode ] +<< /Length 390 /Filter [ /ASCII85Decode /FlateDecode ] >> stream -GasbW:N(h=(rl#lMB6&t[4P@n)fD$SVu>jsfqC[]7KK@)`,@k.K!m^QH>.lnqn2ChUn'5Q4Jr0(L]CX=#V6u):pVjkj9U0%+SGiZ_=rJ^Uj<(e69RjN65U+HFcgEA(+.<%_$%'rQYU"b]s9o6'c#?+=IN>4PSX':I2+S!>LdJ%eX*hs.-$aD>_r^^>WJe%Y*RTi.mJQt=kQM9gh4[6>S^6%UW#,E(EnUP0FTShQro^;3>(DAn%%6CA7K%^WLndV!,5_=U;5A%PBhp-u1&Rs(1d@qp`cArF[4!dDG1! +Gasakb>,r/&A70VHn5mfI`-*Y>67*H'+`t3#:FMK7?^Wi6/q?QdO:@i.`dt4dI,6FaI.jeDAg4q+s?.VJSg&@EXr7G#&oP-`+pJ6n?S-UUKcPW,H]h3(LTfHJs^VNJ48;'ja_M endstream endobj 316 0 obj @@ -2079,10 +2079,10 @@ endobj >> endobj 317 0 obj -<< /Length 1497 /Filter [ /ASCII85Decode /FlateDecode ] +<< /Length 1540 /Filter [ /ASCII85Decode /FlateDecode ] >> stream -Gb!;d95iiK&AJ$C#W]96,%;s_H3Is_-gN?f/2gdTL`$56l$e8g;O$*PXLqhe*aK^Keq]sB>,74*9YUSgjDGW$%[_Fc&WZ;HX7O-jF;nrE&H-]f)cM/R_R=c?%**'j@]!q)o0G&Z1ti_q!3]boT)XpH+2S1Xu+tAWa1t&0%U]W$UtZ;e-*q7TEq-@]KNcK(l!*eM,9=H35BW+@Pn_$g?^_QX9d[D7c$O^Q3VtrXi"*#50!Nh5ctXJCXX#)9lrrZe5_,(#\`>pF7TlO7oX@Dp*(Jq\9FF9f:h@=?cM^V*8r>Inh9[K!m!:Ff&&Q$:60?(!=L%6c0E(U6!jlI5Pkg0aPQXU_%7,"[%p?4,FQ4&MA*6WE][[Am0JIlnQnWJcfK=0M77P8G,nrH7lGVc7&;0OV<$>q69C=>H]ql5MqL5jL"5\29QSu(W5k>:%JRmf#TA*UoD5)b*T\K.`',`.Lb)Um$QD1:XM"jfNe+G)>%W&*;"FD>J5ffI]r#PP(7A3U9(8m1GId_XP6'><=SJu)HEO"Tu_"AW:'dHnppq"!,q\sA\d-/4(/.%=$V\T>9%"f=[8,`l11*%G~> +Gb!;d>Ap;q'RlZ]Jb%/7X5F!?)QAuKg"C5CeRgam>#h&?E56!\!)F"KR=AQGp=NW)RF`oA5%f7\h`:[PEYC(.5!dFKJ-T@39GWBVZnO@irL'+re;!,^%PV:`Kt6p;r%#q[L%\FQs'g/3Ai:Tqe\K$ZJT';6`Q-Li]YF>Fs0rK(2p:mZ6IRNaflaI`EZO2GU1@=t%8qXC'm`9E#WrB))fri?W_bK7@/1JHRLhHQ](N5)d/2ZJ3)H4\(a-&RcA#u7&!FU%A/Z\6bHclb&Le&,<@KBhEf6]\f[08G`kOXrh-<'UO%_s1HF;MeR:nJuV>As8Xu/@d0It\\aia.%i2?lGBKC?(iYc3O.`c,f;;PG,g"ttG#d4E+KP@Sh^S*iS\bh)bI]^KQ-eE]rfQOf`8s;mMB)YNMp]3%'[EB:Q'kn*fZ`R5NoQPHu#JV;j;H$FWA*S.P1:=rtK,o7?B%U,PV_5bb3S<:]:hc4,:I`qK_Mh;aa+TBJAS?7G+3$c?7WhVPEdCV?k\MHNnt^!a6X9%Oqo<1oks.oRUP&-%WF3tnI/XlNPuRO'j*_HjN]D@"YV-=#@.0fg,A+.(dB9ZDMc]J.q`6I^HNi)3b,2EiAjtNur]o6Oo_%1?/h[J',Td0S!BM<8B:lgl8=ud48uoHHZTYFPr_9YZ.td>uZ76[q5=>kc:$"cqujJ0[9.LO_EABN]e'\Q([=Y[pPV^P!^`hEYU35\po,!ZE`.A)e+e9/QmI.gk endstream endobj 318 0 obj @@ -2094,10 +2094,10 @@ endobj >> endobj 319 0 obj -<< /Length 392 /Filter [ /ASCII85Decode /FlateDecode ] +<< /Length 280 /Filter [ /ASCII85Decode /FlateDecode ] >> stream -Gasakb>,r/&A70VHn5mfFr]\m>G;&/L"pZZ[:Z91"F>sIPTYq^Qr^pDo)pkMp;0LW1B>,csP'c2gl0QMBq1nHLAJ,3WPY8(Gd;D?\C<(_\pHh&pMF87YC+f8j,T#oRZL-7c6/Cu=DZZME2c5d+N>bi^fS-CBm_8K":RHYXp?+.K~> +Gas2D]+2\3$q9o2^a7;CFf33gL0'K1A.PdfH3n7ALt9-cI9bP]LjYPT%A/,RC9k(Kg2h2C?T_$dA20Fic,'W2Nk`)bZ:![,oMkJ3u1n\qIjB^d)!<8=HCgU*1(G2#6#"h_fj=76&=*=[UGQ~> endstream endobj 320 0 obj @@ -2109,10 +2109,10 @@ endobj >> endobj 321 0 obj -<< /Length 1126 /Filter [ /ASCII85Decode /FlateDecode ] +<< /Length 1123 /Filter [ /ASCII85Decode /FlateDecode ] >> stream -Gatm:95iQE&AJ$C#W]7`;)+k;]aF*-%cRQ%L[?r+(dI'+,$3/[I;kVKN>OI/41$O(a7q*/X7hR![Kr+t`gKO1"]i'0N#[rTfb/.Ith2")dK)fgS'0K/&a@J<-FUbl47I@R"aNo+.3#X9]q[^-ur)#LQ0k'p!]7r,ufJq2Ar`%J]iSAX`RllJ7]j0AIA15e`1Mr^A/#`>_Lgu[(KW.VI(C0RC?>Z>uQ^5'"&4CJZ^5V))%`ZXigLf#sj`LdNU>bAPi3]UtN=e@B/(@B<*d(86RQ8Ll7Ke/(82;!-2d@EVQaGO;k?Gb>kisdq=UD2*(kiHH\I'p*sgcMoi3_W=hdVD"+QB)(1pQ*p-Q,n6Y'Wo$Rr2U`B>]QP-GXOdQ=O*fFK^JSNAb`6Up/fe$+0/c\,Ku>@o#NH8-:fh"$.V\Z>en15Qkb;Vl#YmgXb8F'be.g]%<$3e`XA96`9]@:h/MoL_#HbN2nNqrL(Mkc:A(th]7-[#ESSfu2JlSI^7Bm&jg#IOcL8&Xs#G\Vj_N.j>)\-u)TtsbOHsQ&L[s-Gjbm,AX-mk8'THJ91K;ZGNUg=I]aN68CF +Gatm:a_oie&A@rkKH/\kL_s$c[K8&=+:ca>\jbhZl%,-jYu"SF,WU_]^6D'T[,`Ng65Rp\G0[bZ9es;oUQ1+,8-:6]7bDu+&I6L?3(1'W'1>%$1j5%9oDAG9?bhBea%=!94l7EbJCNju"9_/PFW0.eI_2#X\)V"H1VTJd33MGR1?YfUc4/8tD9,CML4ImgDP0\>YXE*Kg`0t>iDX(Kpj+YLHoNI<%s:F!]P()-KHacii-nrir,o%S+"2^_@h^`6dof^\$>qN4lT9\'arVEKVkP^cD/rLbob,[tSgb0Gb4#>HqNsK>#:_c.[okBCLc769oA_3D*&l\7)]Ytpb"jDq[rs5M!)l=4NWb8rqP#KP"Ilsan34>q%glkj&E0[KGnFQPEV,)#7(n8\ZQ:u!%%cb,'KB)PEcH#5QoN3A,Yi\\M5cRloXm8Y%0*Sm:Nm':(tCpLWOk1uTN>b3Pu$R0)WhgU=f\t`eAo2LMI\95hp_&nd_5?f7p>Zk/eLOG8k"(rD#jlMt3la6l4"ZeeCN(U1hUeBqflEn^#4,nLk\/>cR&;6UK\oNNSOs?5;TD*;(,sPd'(9o"8D3t)@&b(`:O\^qAO:^8K,O'#$rZAH0'rq@H$(:e^IuRN2'/6@Bb,95ehe.5:].EMn,dU1W)F-iPd-V&s!:i_hI&skX!je^QaHp/#](t*35@l[jt5:%Y[.;X`s(H_Wbo4GD`#&ac5DXCP#laZ>+.NO<3gaLX+[G^@"(p]Q2il1bbBD+P_d(4VDfhRHk&8bokWYCF9.S(_4[WM=]OdC*c/)H*)/`7KRlfUld/fV2+dGAXdZ+nOc_2JS$"#GfZ;`7#MRrR#(.Eo=(DZ?u(e-`ZX6OWEuESsjm^Q=i(jUts.G?4mE]7DXXZ&k?-e8?VTkc&p#Dra5Sj?i7j?s'!ME3dlPd7r%*$lG^cjijcfZk!P$O:%A&ca`lX/7dWI~> endstream endobj 322 0 obj @@ -4225,9 +4225,9 @@ endobj xref 0 522 0000000000 65535 f -0000154820 00000 n -0000155491 00000 n -0000155584 00000 n +0000154664 00000 n +0000155335 00000 n +0000155428 00000 n 0000000015 00000 n 0000000071 00000 n 0000000427 00000 n @@ -4239,179 +4239,179 @@ xref 0000003670 00000 n 0000003793 00000 n 0000004194 00000 n -0000155749 00000 n +0000155593 00000 n 0000004330 00000 n -0000155815 00000 n +0000155659 00000 n 0000004466 00000 n -0000155881 00000 n +0000155725 00000 n 0000004602 00000 n -0000155949 00000 n +0000155793 00000 n 0000004737 00000 n -0000156017 00000 n +0000155861 00000 n 0000004873 00000 n -0000156085 00000 n +0000155929 00000 n 0000005009 00000 n -0000156153 00000 n +0000155997 00000 n 0000005145 00000 n -0000156221 00000 n +0000156065 00000 n 0000005281 00000 n -0000156289 00000 n +0000156133 00000 n 0000005417 00000 n -0000156355 00000 n +0000156199 00000 n 0000005553 00000 n -0000156423 00000 n +0000156267 00000 n 0000005688 00000 n -0000156491 00000 n +0000156335 00000 n 0000005824 00000 n -0000156559 00000 n +0000156403 00000 n 0000005960 00000 n -0000156627 00000 n +0000156471 00000 n 0000006096 00000 n -0000156695 00000 n +0000156539 00000 n 0000006232 00000 n -0000156763 00000 n +0000156607 00000 n 0000006368 00000 n -0000156831 00000 n +0000156675 00000 n 0000006504 00000 n -0000156899 00000 n +0000156743 00000 n 0000006640 00000 n -0000156965 00000 n +0000156809 00000 n 0000006776 00000 n -0000157032 00000 n +0000156876 00000 n 0000006912 00000 n -0000157100 00000 n +0000156944 00000 n 0000007048 00000 n -0000157167 00000 n +0000157011 00000 n 0000007183 00000 n -0000157234 00000 n +0000157078 00000 n 0000007319 00000 n -0000157301 00000 n +0000157145 00000 n 0000007455 00000 n -0000157368 00000 n +0000157212 00000 n 0000007591 00000 n -0000157434 00000 n +0000157278 00000 n 0000007726 00000 n -0000157493 00000 n +0000157337 00000 n 0000007862 00000 n -0000157559 00000 n +0000157403 00000 n 0000007998 00000 n -0000157625 00000 n +0000157469 00000 n 0000008134 00000 n -0000157691 00000 n +0000157535 00000 n 0000008270 00000 n -0000157757 00000 n +0000157601 00000 n 0000008406 00000 n -0000157823 00000 n +0000157667 00000 n 0000008542 00000 n -0000157889 00000 n +0000157733 00000 n 0000008678 00000 n -0000157955 00000 n +0000157799 00000 n 0000008814 00000 n -0000158021 00000 n +0000157865 00000 n 0000008950 00000 n -0000158087 00000 n +0000157931 00000 n 0000009086 00000 n -0000158153 00000 n +0000157997 00000 n 0000009222 00000 n -0000158219 00000 n +0000158063 00000 n 0000009358 00000 n -0000158285 00000 n +0000158129 00000 n 0000009494 00000 n -0000158351 00000 n +0000158195 00000 n 0000009630 00000 n -0000158417 00000 n +0000158261 00000 n 0000009766 00000 n -0000158483 00000 n +0000158327 00000 n 0000009902 00000 n -0000158549 00000 n +0000158393 00000 n 0000010038 00000 n -0000158615 00000 n +0000158459 00000 n 0000010176 00000 n -0000158682 00000 n +0000158526 00000 n 0000010314 00000 n -0000158749 00000 n +0000158593 00000 n 0000010452 00000 n -0000158816 00000 n +0000158660 00000 n 0000010589 00000 n -0000158883 00000 n +0000158727 00000 n 0000010727 00000 n -0000158950 00000 n +0000158794 00000 n 0000010865 00000 n -0000159017 00000 n +0000158861 00000 n 0000011003 00000 n -0000159084 00000 n +0000158928 00000 n 0000011139 00000 n -0000159151 00000 n +0000158995 00000 n 0000011275 00000 n -0000159218 00000 n +0000159062 00000 n 0000011411 00000 n 0000012490 00000 n 0000012616 00000 n 0000012853 00000 n -0000159285 00000 n +0000159129 00000 n 0000012987 00000 n -0000159352 00000 n +0000159196 00000 n 0000013120 00000 n -0000159419 00000 n +0000159263 00000 n 0000013254 00000 n -0000159486 00000 n +0000159330 00000 n 0000013388 00000 n -0000159553 00000 n +0000159397 00000 n 0000013522 00000 n -0000159620 00000 n +0000159464 00000 n 0000013656 00000 n -0000159687 00000 n +0000159531 00000 n 0000013789 00000 n -0000159754 00000 n +0000159598 00000 n 0000013923 00000 n -0000159814 00000 n +0000159658 00000 n 0000014057 00000 n -0000159881 00000 n +0000159725 00000 n 0000014191 00000 n -0000159948 00000 n +0000159792 00000 n 0000014325 00000 n -0000160017 00000 n +0000159861 00000 n 0000014458 00000 n -0000160086 00000 n +0000159930 00000 n 0000014592 00000 n -0000160155 00000 n +0000159999 00000 n 0000014726 00000 n -0000160224 00000 n +0000160068 00000 n 0000014860 00000 n -0000160293 00000 n +0000160137 00000 n 0000014993 00000 n -0000160362 00000 n +0000160206 00000 n 0000015127 00000 n -0000160429 00000 n +0000160273 00000 n 0000015261 00000 n -0000160498 00000 n +0000160342 00000 n 0000015395 00000 n -0000160567 00000 n +0000160411 00000 n 0000015528 00000 n -0000160636 00000 n +0000160480 00000 n 0000015662 00000 n -0000160703 00000 n +0000160547 00000 n 0000015796 00000 n -0000160772 00000 n +0000160616 00000 n 0000015929 00000 n -0000160841 00000 n +0000160685 00000 n 0000016062 00000 n -0000160910 00000 n +0000160754 00000 n 0000016196 00000 n -0000160977 00000 n +0000160821 00000 n 0000016330 00000 n -0000161046 00000 n +0000160890 00000 n 0000016464 00000 n 0000017073 00000 n 0000017183 00000 n 0000019379 00000 n 0000019505 00000 n 0000019558 00000 n -0000161113 00000 n +0000160957 00000 n 0000019699 00000 n 0000019882 00000 n 0000020056 00000 n -0000161182 00000 n +0000161026 00000 n 0000020197 00000 n 0000021986 00000 n 0000022112 00000 n @@ -4538,214 +4538,214 @@ xref 0000093159 00000 n 0000093296 00000 n 0000093433 00000 n -0000094973 00000 n -0000095083 00000 n -0000095659 00000 n -0000095769 00000 n -0000097360 00000 n -0000097470 00000 n -0000097955 00000 n -0000098065 00000 n -0000099285 00000 n -0000099395 00000 n -0000101005 00000 n -0000101115 00000 n -0000101931 00000 n -0000102057 00000 n -0000102086 00000 n -0000102223 00000 n -0000103822 00000 n -0000103948 00000 n -0000103985 00000 n -0000161251 00000 n -0000104124 00000 n -0000161320 00000 n -0000104263 00000 n -0000104877 00000 n -0000105003 00000 n -0000105032 00000 n -0000105169 00000 n -0000107553 00000 n -0000107679 00000 n -0000107724 00000 n -0000107865 00000 n -0000108004 00000 n -0000161389 00000 n -0000108142 00000 n -0000109239 00000 n -0000109365 00000 n -0000109394 00000 n -0000109531 00000 n -0000112088 00000 n -0000112214 00000 n -0000112267 00000 n -0000112408 00000 n -0000112547 00000 n -0000112688 00000 n -0000112829 00000 n -0000114374 00000 n -0000114500 00000 n -0000114537 00000 n -0000114674 00000 n -0000114811 00000 n -0000117117 00000 n -0000117243 00000 n -0000117296 00000 n -0000117437 00000 n -0000117576 00000 n -0000117717 00000 n -0000117858 00000 n -0000118643 00000 n -0000118769 00000 n -0000118806 00000 n -0000118943 00000 n -0000119080 00000 n -0000121295 00000 n -0000121421 00000 n -0000121458 00000 n -0000121599 00000 n -0000121737 00000 n -0000122959 00000 n -0000123085 00000 n -0000123130 00000 n -0000123267 00000 n -0000123404 00000 n -0000123541 00000 n -0000124097 00000 n -0000124207 00000 n -0000125932 00000 n -0000126058 00000 n -0000126095 00000 n -0000126233 00000 n -0000126367 00000 n -0000126737 00000 n -0000126863 00000 n -0000126892 00000 n -0000127024 00000 n -0000128784 00000 n -0000128894 00000 n -0000130819 00000 n -0000130929 00000 n -0000132750 00000 n -0000132860 00000 n -0000133651 00000 n -0000133761 00000 n -0000135235 00000 n -0000135361 00000 n -0000135390 00000 n -0000161458 00000 n -0000161512 00000 n -0000135528 00000 n -0000161578 00000 n -0000135719 00000 n -0000135920 00000 n -0000136062 00000 n -0000136341 00000 n -0000136468 00000 n -0000136610 00000 n -0000136830 00000 n -0000136939 00000 n -0000137063 00000 n -0000137180 00000 n -0000137493 00000 n -0000137744 00000 n -0000137943 00000 n -0000138151 00000 n -0000161644 00000 n -0000138434 00000 n -0000161713 00000 n -0000138621 00000 n -0000138731 00000 n -0000138884 00000 n -0000139071 00000 n -0000139277 00000 n -0000139444 00000 n -0000139757 00000 n -0000139914 00000 n -0000140155 00000 n -0000140344 00000 n -0000140533 00000 n -0000140722 00000 n -0000140917 00000 n -0000141062 00000 n -0000141235 00000 n -0000141409 00000 n -0000141574 00000 n -0000141780 00000 n -0000141957 00000 n -0000142175 00000 n -0000142416 00000 n -0000142628 00000 n -0000142816 00000 n -0000143046 00000 n -0000143264 00000 n -0000143470 00000 n -0000143676 00000 n -0000143910 00000 n -0000144174 00000 n -0000144416 00000 n -0000144626 00000 n -0000144839 00000 n -0000145045 00000 n -0000145194 00000 n -0000145384 00000 n -0000145562 00000 n -0000145740 00000 n -0000145883 00000 n -0000146044 00000 n -0000146246 00000 n -0000146436 00000 n -0000146632 00000 n -0000146816 00000 n -0000147052 00000 n -0000147242 00000 n -0000147373 00000 n -0000147527 00000 n -0000147675 00000 n -0000147866 00000 n -0000148068 00000 n -0000148334 00000 n -0000148655 00000 n -0000148813 00000 n -0000148953 00000 n -0000149138 00000 n -0000161780 00000 n -0000149409 00000 n -0000161849 00000 n -0000149642 00000 n -0000149905 00000 n -0000150108 00000 n -0000150248 00000 n -0000150433 00000 n -0000161918 00000 n -0000150704 00000 n -0000161987 00000 n -0000150937 00000 n -0000151200 00000 n -0000151444 00000 n -0000151584 00000 n -0000151769 00000 n -0000162056 00000 n -0000152040 00000 n -0000162125 00000 n -0000152273 00000 n -0000152536 00000 n -0000152694 00000 n -0000152834 00000 n -0000153019 00000 n -0000162194 00000 n -0000153290 00000 n -0000162263 00000 n -0000153523 00000 n -0000153786 00000 n -0000153920 00000 n -0000154034 00000 n -0000154145 00000 n -0000154261 00000 n -0000154370 00000 n -0000154482 00000 n -0000154603 00000 n -0000154710 00000 n +0000094982 00000 n +0000095092 00000 n +0000095575 00000 n +0000095685 00000 n +0000097319 00000 n +0000097429 00000 n +0000097802 00000 n +0000097912 00000 n +0000099129 00000 n +0000099239 00000 n +0000100849 00000 n +0000100959 00000 n +0000101775 00000 n +0000101901 00000 n +0000101930 00000 n +0000102067 00000 n +0000103666 00000 n +0000103792 00000 n +0000103829 00000 n +0000161095 00000 n +0000103968 00000 n +0000161164 00000 n +0000104107 00000 n +0000104721 00000 n +0000104847 00000 n +0000104876 00000 n +0000105013 00000 n +0000107397 00000 n +0000107523 00000 n +0000107568 00000 n +0000107709 00000 n +0000107848 00000 n +0000161233 00000 n +0000107986 00000 n +0000109083 00000 n +0000109209 00000 n +0000109238 00000 n +0000109375 00000 n +0000111932 00000 n +0000112058 00000 n +0000112111 00000 n +0000112252 00000 n +0000112391 00000 n +0000112532 00000 n +0000112673 00000 n +0000114218 00000 n +0000114344 00000 n +0000114381 00000 n +0000114518 00000 n +0000114655 00000 n +0000116961 00000 n +0000117087 00000 n +0000117140 00000 n +0000117281 00000 n +0000117420 00000 n +0000117561 00000 n +0000117702 00000 n +0000118487 00000 n +0000118613 00000 n +0000118650 00000 n +0000118787 00000 n +0000118924 00000 n +0000121139 00000 n +0000121265 00000 n +0000121302 00000 n +0000121443 00000 n +0000121581 00000 n +0000122803 00000 n +0000122929 00000 n +0000122974 00000 n +0000123111 00000 n +0000123248 00000 n +0000123385 00000 n +0000123941 00000 n +0000124051 00000 n +0000125776 00000 n +0000125902 00000 n +0000125939 00000 n +0000126077 00000 n +0000126211 00000 n +0000126581 00000 n +0000126707 00000 n +0000126736 00000 n +0000126868 00000 n +0000128628 00000 n +0000128738 00000 n +0000130663 00000 n +0000130773 00000 n +0000132594 00000 n +0000132704 00000 n +0000133495 00000 n +0000133605 00000 n +0000135079 00000 n +0000135205 00000 n +0000135234 00000 n +0000161302 00000 n +0000161356 00000 n +0000135372 00000 n +0000161422 00000 n +0000135563 00000 n +0000135764 00000 n +0000135906 00000 n +0000136185 00000 n +0000136312 00000 n +0000136454 00000 n +0000136674 00000 n +0000136783 00000 n +0000136907 00000 n +0000137024 00000 n +0000137337 00000 n +0000137588 00000 n +0000137787 00000 n +0000137995 00000 n +0000161488 00000 n +0000138278 00000 n +0000161557 00000 n +0000138465 00000 n +0000138575 00000 n +0000138728 00000 n +0000138915 00000 n +0000139121 00000 n +0000139288 00000 n +0000139601 00000 n +0000139758 00000 n +0000139999 00000 n +0000140188 00000 n +0000140377 00000 n +0000140566 00000 n +0000140761 00000 n +0000140906 00000 n +0000141079 00000 n +0000141253 00000 n +0000141418 00000 n +0000141624 00000 n +0000141801 00000 n +0000142019 00000 n +0000142260 00000 n +0000142472 00000 n +0000142660 00000 n +0000142890 00000 n +0000143108 00000 n +0000143314 00000 n +0000143520 00000 n +0000143754 00000 n +0000144018 00000 n +0000144260 00000 n +0000144470 00000 n +0000144683 00000 n +0000144889 00000 n +0000145038 00000 n +0000145228 00000 n +0000145406 00000 n +0000145584 00000 n +0000145727 00000 n +0000145888 00000 n +0000146090 00000 n +0000146280 00000 n +0000146476 00000 n +0000146660 00000 n +0000146896 00000 n +0000147086 00000 n +0000147217 00000 n +0000147371 00000 n +0000147519 00000 n +0000147710 00000 n +0000147912 00000 n +0000148178 00000 n +0000148499 00000 n +0000148657 00000 n +0000148797 00000 n +0000148982 00000 n +0000161624 00000 n +0000149253 00000 n +0000161693 00000 n +0000149486 00000 n +0000149749 00000 n +0000149952 00000 n +0000150092 00000 n +0000150277 00000 n +0000161762 00000 n +0000150548 00000 n +0000161831 00000 n +0000150781 00000 n +0000151044 00000 n +0000151288 00000 n +0000151428 00000 n +0000151613 00000 n +0000161900 00000 n +0000151884 00000 n +0000161969 00000 n +0000152117 00000 n +0000152380 00000 n +0000152538 00000 n +0000152678 00000 n +0000152863 00000 n +0000162038 00000 n +0000153134 00000 n +0000162107 00000 n +0000153367 00000 n +0000153630 00000 n +0000153764 00000 n +0000153878 00000 n +0000153989 00000 n +0000154105 00000 n +0000154214 00000 n +0000154326 00000 n +0000154447 00000 n +0000154554 00000 n trailer << /Size 522 @@ -4753,5 +4753,5 @@ trailer /Info 4 0 R >> startxref -162332 +162176 %%EOF diff --git a/doc/html.tar.gz b/doc/html.tar.gz index 09cc776..891eec5 100644 Binary files a/doc/html.tar.gz and b/doc/html.tar.gz differ diff --git a/doc/ref_clsql.xml b/doc/ref_clsql.xml index 9f5c0d6..0d893a6 100644 --- a/doc/ref_clsql.xml +++ b/doc/ref_clsql.xml @@ -1680,7 +1680,7 @@ The default is &nil;. success - A boolean flag. If &t;, a new database wa + A boolean flag. If &t;, a new database was successfully created. @@ -1700,6 +1700,7 @@ The default is &nil;. => T (create-database '("localhost" "new" "dent" "badpasswd") :database-type :mysql) +=> Error: While trying to access database localhost/new/dent using database-type MYSQL: Error database-create failed: mysqladmin: connect to server at 'localhost' failed @@ -1716,8 +1717,7 @@ error: 'Access denied for user: 'root@localhost' (Using password: YES)' Exceptional Situations An exception will be thrown if the database system does not allow new databases to be created or if database creation - fails. Currently, only the :postgresql-socket - does not allow new databases to be created. + fails. Notes @@ -1762,7 +1762,7 @@ error: 'Access denied for user: 'root@localhost' (Using password: YES)' success - A boolean flag. If &t;, a new database wa + A boolean flag. If &t;, the database was successfully destroyed. @@ -1782,6 +1782,7 @@ error: 'Access denied for user: 'root@localhost' (Using password: YES)' => T (destroy-database '("localhost" "new" "dent" "dent") :database-type :postgresql) +=> Error: While trying to access database localhost/test2/root using database-type POSTGRESQL: Error database-destory failed: dropdb: database removal failed: ERROR: database "test2" does not exist @@ -1797,9 +1798,7 @@ Error: While trying to access database localhost/test2/root Exceptional Situations An exception will be thrown if the database system does not allow databases to be removed, the database does not exist, or - if database removal fails. Currently, only the - :postgresql-socket does not allow - databases to be destroyed. + if database removal fails. Notes @@ -1817,7 +1816,7 @@ Error: While trying to access database localhost/test2/root PROBE-DATABASE - tests for existance of a database + tests for existence of a database Function @@ -1853,7 +1852,7 @@ Error: While trying to access database localhost/test2/root Description - This function tests for the existance of a database in + This function tests for the existence of a database in the database system specified by database-type. @@ -1872,8 +1871,8 @@ Error: While trying to access database localhost/test2/root Exceptional Situations An exception maybe thrown if the database system does - not receive administrator-level authentication. This function - may need to read the administrative table of the database + not receive administrator-level authentication since function + may need to read the administrative database of the database system. diff --git a/tests/package.lisp b/tests/package.lisp index a4333f1..df38db1 100644 --- a/tests/package.lisp +++ b/tests/package.lisp @@ -17,6 +17,6 @@ (in-package #:cl-user) (defpackage #:clsql-tests - (:use #:clsql #:common-lisp #:rtest #:clsql-classic-tests) + (:use #:clsql #:common-lisp #:rtest #:ptester) (:export #:run-tests #:test-initialise-database #:test-connect-to-database) (:documentation "Regression tests for CLSQL.")) diff --git a/tests/test-basic.lisp b/tests/test-basic.lisp new file mode 100644 index 0000000..7664720 --- /dev/null +++ b/tests/test-basic.lisp @@ -0,0 +1,164 @@ +;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- +;;;; ************************************************************************* +;;;; FILE IDENTIFICATION +;;;; +;;;; Name: test-basic.lisp +;;;; Purpose: Tests for clsql-base and result types +;;;; Author: Kevin M. Rosenberg +;;;; Created: Mar 2002 +;;;; +;;;; $Id: tests.lisp 8926 2004-04-10 21:12:52Z kevin $ +;;;; +;;;; This file, part of CLSQL, is Copyright (c) 2002-2004 by Kevin M. Rosenberg +;;;; +;;;; CLSQL users are granted the rights to distribute and use this software +;;;; as governed by the terms of the Lisp Lesser GNU Public License +;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. +;;;; ************************************************************************* + +(in-package #:clsql-tests) + + +(defun test-basic (spec type) + (let ((db (clsql:connect spec :database-type type :if-exists :new))) + (unwind-protect + (if (eq type :sqlite) + (%test-basic-untyped db type) + (%test-basic db type)) + (disconnect :database db)))) + +(defun %test-basic (db type) + (create-test-table db) + (dolist (row (query "select * from test_clsql" :database db :result-types :auto)) + (test-table-row row :auto type)) + (dolist (row (query "select * from test_clsql" :database db :result-types nil)) + (test-table-row row nil type)) + (loop for row across (map-query 'vector #'list "select * from test_clsql" + :database db :result-types :auto) + do (test-table-row row :auto type)) + (loop for row across (map-query 'vector #'list "select * from test_clsql" + :database db :result-types nil) + do (test-table-row row nil type)) + (loop for row in (map-query 'list #'list "select * from test_clsql" + :database db :result-types nil) + do (test-table-row row nil type)) + (loop for row in (map-query 'list #'list "select * from test_clsql" + :database db :result-types :auto) + do (test-table-row row :auto type)) + (test (map-query nil #'list "select * from test_clsql" + :database db :result-types :auto) + nil + :fail-info "Expected NIL result from map-query nil") + (do-query ((int float bigint str) "select * from test_clsql") + (test-table-row (list int float bigint str) nil type)) + (do-query ((int float bigint str) "select * from test_clsql" :result-types :auto) + (test-table-row (list int float bigint str) :auto type)) + (drop-test-table db)) + + +(defun %test-basic-untyped (db type) + (create-test-table db) + (dolist (row (query "select * from test_clsql" :database db :result-types nil)) + (test-table-row row nil type)) + (loop for row across (map-query 'vector #'list "select * from test_clsql" + :database db :result-types nil) + do (test-table-row row nil type)) + (loop for row in (map-query 'list #'list "select * from test_clsql" + :database db :result-types nil) + do (test-table-row row nil type)) + + (do-query ((int float bigint str) "select * from test_clsql") + (test-table-row (list int float bigint str) nil type)) + (drop-test-table db)) + +;;;; Testing functions + +(defun transform-float-1 (i) + (coerce (* i (abs (/ i 2)) (expt 10 (* 2 i))) 'double-float)) + +(defun transform-bigint-1 (i) + (* i (expt 10 (* 3 (abs i))))) + +(defun create-test-table (db) + (ignore-errors + (clsql:execute-command + "DROP TABLE test_clsql" :database db)) + (clsql:execute-command + "CREATE TABLE test_clsql (t_int integer, t_float float, t_bigint BIGINT, t_str CHAR(30))" + :database db) + (dotimes (i 11) + (let* ((test-int (- i 5)) + (test-flt (transform-float-1 test-int))) + (clsql:execute-command + (format nil "INSERT INTO test_clsql VALUES (~a,~a,~a,'~a')" + test-int + (clsql-base:number-to-sql-string test-flt) + (transform-bigint-1 test-int) + (clsql-base:number-to-sql-string test-flt) + ) + :database db)))) + +(defun parse-double (num-str) + (let ((*read-default-float-format* 'double-float)) + (coerce (read-from-string num-str) 'double-float))) + +(defun test-table-row (row types db-type) + (test (and (listp row) + (= 4 (length row))) + t + :fail-info + (format nil "Row ~S is incorrect format" row)) + (destructuring-bind (int float bigint str) row + (cond + ((eq types :auto) + (test (and (integerp int) + (typep float 'double-float) + (or (eq db-type :aodbc) ;; aodbc doesn't handle bigint conversions + (integerp bigint)) + (stringp str)) + t + :fail-info + (format nil "Incorrect field type for row ~S (types :auto)" row))) + ((null types) + (test (and (stringp int) + (stringp float) + (stringp bigint) + (stringp str)) + t + :fail-info + (format nil "Incorrect field type for row ~S (types nil)" row)) + (setq int (parse-integer int)) + (setq bigint (parse-integer bigint)) + (setq float (parse-double float))) + ((listp types) + (error "NYI") + ) + (t + (test t nil + :fail-info + (format nil "Invalid types field (~S) passed to test-table-row" types)))) + (unless (eq db-type :sqlite) ; SQLite is typeless. + (test (transform-float-1 int) + float + :test #'eql + :fail-info + (format nil "Wrong float value ~A for int ~A (row ~S)" float int row))) + (test float + (parse-double str) + :test #'double-float-equal + :fail-info (format nil "Wrong string value ~A for double ~A~%Row: ~S" + str float row)))) + + +(defun double-float-equal (a b) + (if (zerop a) + (if (zerop b) + t + nil) + (let ((diff (abs (/ (- a b) a)))) + (if (> diff (* 10 double-float-epsilon)) + nil + t)))) + +(defun drop-test-table (db) + (clsql:execute-command "DROP TABLE test_clsql" :database db)) diff --git a/tests/test-init.lisp b/tests/test-init.lisp index 1a274d9..db217ec 100644 --- a/tests/test-init.lisp +++ b/tests/test-init.lisp @@ -294,23 +294,38 @@ (unless specs (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+) (let ((spec (db-type-spec db-type specs))) (when spec - (format t -"~& + (do-tests-for-backend spec db-type)))))) + +(defun load-necessary-systems (specs) + (dolist (db-type +all-db-types+) + (when (db-type-spec db-type specs) + (db-type-ensure-system db-type)))) + +(defun do-tests-for-backend (spec db-type) + (format t + "~& ******************************************************************* *** Running CLSQL tests with ~A backend. ******************************************************************* " db-type) - (db-type-ensure-system db-type) - (regression-test:rem-all-tests) - (ignore-errors (destroy-database spec :database-type db-type)) - (ignore-errors (create-database spec :database-type db-type)) - (dolist (test (append *rt-connection* *rt-fddl* *rt-fdml* - *rt-ooddl* *rt-oodml* *rt-syntax*)) - (eval test)) - (test-connect-to-database db-type spec) - (test-initialise-database) - (rtest:do-tests)))))) + (regression-test:rem-all-tests) + + ;; Tests of clsql-base + (ignore-errors (destroy-database spec :database-type db-type)) + (ignore-errors (create-database spec :database-type db-type)) + (with-tests (:name "CLSQL") + (test-basic spec db-type)) + + (ignore-errors (destroy-database spec :database-type db-type)) + (ignore-errors (create-database spec :database-type db-type)) + (dolist (test (append *rt-connection* *rt-fddl* *rt-fdml* + *rt-ooddl* *rt-oodml* *rt-syntax*)) + (eval test)) + (test-connect-to-database db-type spec) + (test-initialise-database) + (rtest:do-tests)) diff --git a/tests/utils.lisp b/tests/utils.lisp new file mode 100644 index 0000000..27cbf94 --- /dev/null +++ b/tests/utils.lisp @@ -0,0 +1,68 @@ +;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- +;;;; ************************************************************************* +;;;; FILE IDENTIFICATION +;;;; +;;;; Name: utils.lisp +;;;; Purpose: Classes and utilities for testing +;;;; Author: Kevin M. Rosenberg +;;;; Created: Mar 2002 +;;;; +;;;; $Id: tests.lisp 8926 2004-04-10 21:12:52Z kevin $ +;;;; +;;;; This file, part of CLSQL, is Copyright (c) 2002-2004 by Kevin M. Rosenberg +;;;; +;;;; CLSQL users are granted the rights to distribute and use this software +;;;; as governed by the terms of the Lisp Lesser GNU Public License +;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. +;;;; ************************************************************************* + +(in-package #:clsql-tests) + +(defvar *config-pathname* + (make-pathname :defaults (user-homedir-pathname) + :name ".clsql-test" + :type "config")) + +(defvar +all-db-types+ + #-clisp '(:postgresql :postgresql-socket :sqlite :aodbc :mysql) + #+clisp '(:sqlite)) + +(defclass conn-specs () + ((aodbc-spec :accessor aodbc-spec :initform nil) + (mysql-spec :accessor mysql-spec :initform nil) + (pgsql-spec :accessor postgresql-spec :initform nil) + (pgsql-socket-spec :accessor postgresql-socket-spec :initform nil) + (sqlite-spec :accessor sqlite-spec :initform nil)) + (:documentation "Connection specs for CLSQL testing")) + + +(defun read-specs (&optional (path *config-pathname*)) + (if (probe-file path) + (with-open-file (stream path :direction :input) + (let ((config (read stream)) + (specs (make-instance 'conn-specs))) + (setf (aodbc-spec specs) (cadr (assoc :aodbc config))) + (setf (mysql-spec specs) (cadr (assoc :mysql config))) + (setf (postgresql-spec specs) (cadr (assoc :postgresql config))) + (setf (postgresql-socket-spec specs) + (cadr (assoc :postgresql-socket config))) + (setf (sqlite-spec specs) (cadr (assoc :sqlite config))) + specs)) + (progn + (warn "CLSQL test config file ~S not found" path) + nil))) + +(defun db-type-spec (db-type specs) + (let ((accessor (intern (concatenate 'string (symbol-name db-type) + (symbol-name '#:-spec)) + (find-package '#:clsql-tests)))) + (funcall accessor specs))) + +(defun db-type-ensure-system (db-type) + (unless (find-package (symbol-name db-type)) + (asdf:operate 'asdf:load-op + (intern (concatenate 'string + (symbol-name '#:clsql-) + (symbol-name db-type)))))) + +