X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=tests%2Ftest-fdml.lisp;h=8d87097e8db1b3de950c3c0197d870b1dcd60664;hb=f716bb1161cf9e89a96945c4a444244f9d303691;hp=ef364ba40b8eb80c4414792409133491e394660b;hpb=70227e5f0b76bb649fc6c1a478d7374953fd815b;p=clsql.git diff --git a/tests/test-fdml.lisp b/tests/test-fdml.lisp index ef364ba..8d87097 100644 --- a/tests/test-fdml.lisp +++ b/tests/test-fdml.lisp @@ -4,14 +4,15 @@ ;;;; Author: Marcus Pearce ;;;; Created: 30/03/2004 ;;;; Updated: $Id$ -;;;; ====================================================================== -;;;; -;;;; Description ========================================================== -;;;; ====================================================================== ;;;; ;;;; Tests for the CLSQL Functional Data Manipulation Language ;;;; (FDML). -;;;; +;;;; +;;;; 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. ;;;; ====================================================================== (in-package #:clsql-tests) @@ -128,14 +129,17 @@ (deftest :fdml/query/1 - (clsql:query "SELECT COUNT(*) FROM EMPLOYEE WHERE (EMAIL LIKE '%org')") + (clsql:query "SELECT COUNT(*) FROM EMPLOYEE WHERE (EMAIL LIKE '%org')" :field-names nil) (("10"))) (deftest :fdml/query/2 - (clsql:query - "SELECT FIRST_NAME,LAST_NAME FROM EMPLOYEE WHERE (EMPLID <= 5) ORDER BY LAST_NAME") + (multiple-value-bind (rows field-names) + (clsql:query + "SELECT FIRST_NAME,LAST_NAME FROM EMPLOYEE WHERE (EMPLID <= 5) ORDER BY LAST_NAME") + (values rows (mapcar 'string-upcase field-names))) (("Leonid" "Brezhnev") ("Nikita" "Kruschev") ("Vladamir" "Lenin") - ("Josef" "Stalin") ("Leon" "Trotsky"))) + ("Josef" "Stalin") ("Leon" "Trotsky")) + ("FIRST_NAME" "LAST_NAME")) (deftest :fdml/execute-command/1 @@ -151,23 +155,22 @@ ;; compare min, max and average hieghts in inches (they're quite short -;; these guys!) -- only works with pgsql +;; these guys!) (deftest :fdml/select/1 - (if (member *test-database-type* '(:postgresql-socket :postgresql)) - (let ((max (clsql:select [function "floor" - [/ [* [max [height]] 100] 2.54]] - :from [employee] - :flatp t)) - (min (clsql:select [function "floor" - [/ [* [min [height]] 100] 2.54]] - :from [employee] - :flatp t)) - (avg (clsql:select [function "floor" - [avg [/ [* [height] 100] 2.54]]] - :from [employee] - :flatp t))) - (apply #'< (mapcar #'parse-integer (append min avg max)))) - t) + (let ((max (clsql:select [function "floor" + [/ [* [max [height]] 100] 2.54]] + :from [employee] + :flatp t)) + (min (clsql:select [function "floor" + [/ [* [min [height]] 100] 2.54]] + :from [employee] + :flatp t)) + (avg (clsql:select [function "floor" + [avg [/ [* [height] 100] 2.54]]] + :from [employee] + :flatp t))) + (apply #'< (mapcar #'(lambda (s) (parse-integer s :junk-allowed t)) + (append min avg max)))) t) (deftest :fdml/select/2 @@ -197,12 +200,12 @@ ("lenin@soviet.org")) (deftest :fdml/select/6 - (if (member *test-database-type* '(:postgresql-socket :postgresql)) - (mapcar #'parse-integer - (clsql:select [function "trunc" [height]] :from [employee] - :flatp t)) - (mapcar #'(lambda (s) (truncate (parse-integer s :junk-allowed t))) - (clsql:select [height] :from [employee] :flatp t))) + (if (db-type-has-fancy-math? *test-database-underlying-type*) + (mapcar #'(lambda (s) (parse-integer s :junk-allowed t)) + (clsql:select [function "trunc" [height]] :from [employee] + :flatp t)) + (mapcar #'(lambda (s) (truncate (parse-integer s :junk-allowed t))) + (clsql:select [height] :from [employee] :flatp t))) (1 1 1 1 1 1 1 1 1 1)) (deftest :fdml/select/7 @@ -220,7 +223,7 @@ (deftest :fdml/select/10 (clsql:select [last-name] :from [employee] :where [not [in [emplid] - [select [managerid] :from [company]]]] + [select [managerid] :from [company]]]] :flatp t :order-by [last-name]) ("Andropov" "Brezhnev" "Chernenko" "Gorbachev" "Kruschev" "Putin" "Stalin" @@ -284,8 +287,7 @@ ;; test if we are in a transaction (push (clsql:in-transaction-p) results) ;;Putin has got to go - (unless (eql *test-database-type* :mysql) - (clsql:delete-records :from [employee] :where [= [last-name] "Putin"])) + (clsql:delete-records :from [employee] :where [= [last-name] "Putin"]) ;;Should be nil (push (clsql:select [*] :from [employee] :where [= [last-name] "Putin"]) @@ -311,10 +313,9 @@ ;; test if we are in a transaction (push (clsql:in-transaction-p) results) ;;Putin has got to go - (unless (eql *test-database-type* :mysql) - (clsql:update-records [employee] - :av-pairs '((email "putin-nospam@soviet.org")) - :where [= [last-name] "Putin"])) + (clsql:update-records [employee] + :av-pairs '((email "putin-nospam@soviet.org")) + :where [= [last-name] "Putin"]) ;;Should be new value (push (clsql:select [email] :from [employee] :where [= [last-name] "Putin"] @@ -363,7 +364,7 @@ :flatp t) results) (apply #'values (nreverse results))) - nil :COMMITTED nil ("lenin-nospam@soviet.org") :COMMITTED + nil :committed nil ("lenin-nospam@soviet.org") :committed nil ("lenin@soviet.org")) ;; runs a valid update and an invalid one within a transaction and checks @@ -372,19 +373,18 @@ (let ((results '())) ;; check status (push (clsql:in-transaction-p) results) - (unless (eql *test-database-type* :mysql) - (handler-case - (clsql:with-transaction () - ;; valid update - (clsql:update-records [employee] - :av-pairs '((email "lenin-nospam@soviet.org")) - :where [= [emplid] 1]) - ;; invalid update which generates an error + (handler-case + (clsql:with-transaction () + ;; valid update + (clsql:update-records [employee] + :av-pairs '((email "lenin-nospam@soviet.org")) + :where [= [emplid] 1]) + ;; invalid update which generates an error (clsql:update-records [employee] - :av-pairs - '((emale "lenin-nospam@soviet.org")) - :where [= [emplid] 1])) - (clsql:clsql-sql-error () + :av-pairs + '((emale "lenin-nospam@soviet.org")) + :where [= [emplid] 1])) + (clsql:clsql-error () (progn ;; check status (push (clsql:in-transaction-p) results) @@ -392,7 +392,7 @@ (push (clsql:select [email] :from [employee] :where [= [emplid] 1] :flatp t) results) - (apply #'values (nreverse results))))))) + (apply #'values (nreverse results)))))) nil nil ("lenin@soviet.org")) ))