--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; ======================================================================
+;;;; File: test-oodml.lisp
+;;;; Author: Marcus Pearce <m.t.pearce@city.ac.uk>
+;;;; Created: 01/04/2004
+;;;; Updated: <04/04/2004 11:51:23 marcusp>
+;;;; ======================================================================
+;;;;
+;;;; Description ==========================================================
+;;;; ======================================================================
+;;;;
+;;;; Tests for the CLSQL-USQL Object Oriented Data Definition Language
+;;;; (OODML).
+;;;;
+;;;; ======================================================================
+
+(in-package :clsql-usql-tests)
+
+#.(usql:locally-enable-sql-reader-syntax)
+
+(deftest :oodml/select/1
+ (mapcar #'(lambda (e) (slot-value e 'last-name))
+ (usql:select 'employee :order-by [last-name]))
+ ("Andropov" "Brezhnev" "Chernenko" "Gorbachev" "Kruschev" "Lenin" "Putin"
+ "Stalin" "Trotsky" "Yeltsin"))
+
+(deftest :oodml/select/2
+ (mapcar #'(lambda (e) (slot-value e 'name))
+ (usql:select 'company))
+ ("Widgets Inc."))
+
+(deftest :oodml/select/3
+ (mapcar #'(lambda (e) (slot-value e 'companyid))
+ (usql:select 'employee
+ :where [and [= [slot-value 'employee 'companyid]
+ [slot-value 'company 'companyid]]
+ [= [slot-value 'company 'name]
+ "Widgets Inc."]]))
+ (1 1 1 1 1 1 1 1 1 1))
+
+(deftest :oodml/select/4
+ (mapcar #'(lambda (e)
+ (concatenate 'string (slot-value e 'first-name)
+ " "
+ (slot-value e 'last-name)))
+ (usql:select 'employee :where [= [slot-value 'employee 'first-name]
+ "Vladamir"]
+ :order-by [last-name]))
+ ("Vladamir Lenin" "Vladamir Putin"))
+
+;; sqlite fails this because it is typeless
+(deftest :oodml/select/5
+ (length (sql:select 'employee :where [married]))
+ 3)
+
+;; tests update-records-from-instance
+(deftest :oodml/update-records/1
+ (values
+ (progn
+ (let ((lenin (car (usql:select 'employee
+ :where [= [slot-value 'employee 'emplid]
+ 1]))))
+ (concatenate 'string
+ (first-name lenin)
+ " "
+ (last-name lenin)
+ ": "
+ (employee-email lenin))))
+ (progn
+ (setf (slot-value employee1 'first-name) "Dimitriy"
+ (slot-value employee1 'last-name) "Ivanovich"
+ (slot-value employee1 'email) "ivanovich@soviet.org")
+ (usql:update-records-from-instance employee1)
+ (let ((lenin (car (usql:select 'employee
+ :where [= [slot-value 'employee 'emplid]
+ 1]))))
+ (concatenate 'string
+ (first-name lenin)
+ " "
+ (last-name lenin)
+ ": "
+ (employee-email lenin))))
+ (progn
+ (setf (slot-value employee1 'first-name) "Vladamir"
+ (slot-value employee1 'last-name) "Lenin"
+ (slot-value employee1 'email) "lenin@soviet.org")
+ (usql:update-records-from-instance employee1)
+ (let ((lenin (car (usql:select 'employee
+ :where [= [slot-value 'employee 'emplid]
+ 1]))))
+ (concatenate 'string
+ (first-name lenin)
+ " "
+ (last-name lenin)
+ ": "
+ (employee-email lenin)))))
+ "Vladamir Lenin: lenin@soviet.org"
+ "Dimitriy Ivanovich: ivanovich@soviet.org"
+ "Vladamir Lenin: lenin@soviet.org")
+
+;; tests update-record-from-slot
+(deftest :oodml/update-records/2
+ (values
+ (employee-email
+ (car (usql:select 'employee
+ :where [= [slot-value 'employee 'emplid] 1])))
+ (progn
+ (setf (slot-value employee1 'email) "lenin-nospam@soviet.org")
+ (usql:update-record-from-slot employee1 'email)
+ (employee-email
+ (car (usql:select 'employee
+ :where [= [slot-value 'employee 'emplid] 1]))))
+ (progn
+ (setf (slot-value employee1 'email) "lenin@soviet.org")
+ (usql:update-record-from-slot employee1 'email)
+ (employee-email
+ (car (usql:select 'employee
+ :where [= [slot-value 'employee 'emplid] 1])))))
+ "lenin@soviet.org" "lenin-nospam@soviet.org" "lenin@soviet.org")
+
+;; tests update-record-from-slots
+(deftest :oodml/update-records/3
+ (values
+ (let ((lenin (car (usql:select 'employee
+ :where [= [slot-value 'employee 'emplid]
+ 1]))))
+ (concatenate 'string
+ (first-name lenin)
+ " "
+ (last-name lenin)
+ ": "
+ (employee-email lenin)))
+ (progn
+ (setf (slot-value employee1 'first-name) "Dimitriy"
+ (slot-value employee1 'last-name) "Ivanovich"
+ (slot-value employee1 'email) "ivanovich@soviet.org")
+ (usql:update-record-from-slots employee1 '(first-name last-name email))
+ (let ((lenin (car (usql:select 'employee
+ :where [= [slot-value 'employee 'emplid]
+ 1]))))
+ (concatenate 'string
+ (first-name lenin)
+ " "
+ (last-name lenin)
+ ": "
+ (employee-email lenin))))
+ (progn
+ (setf (slot-value employee1 'first-name) "Vladamir"
+ (slot-value employee1 'last-name) "Lenin"
+ (slot-value employee1 'email) "lenin@soviet.org")
+ (usql:update-record-from-slots employee1 '(first-name last-name email))
+ (let ((lenin (car (usql:select 'employee
+ :where [= [slot-value 'employee 'emplid]
+ 1]))))
+ (concatenate 'string
+ (first-name lenin)
+ " "
+ (last-name lenin)
+ ": "
+ (employee-email lenin)))))
+ "Vladamir Lenin: lenin@soviet.org"
+ "Dimitriy Ivanovich: ivanovich@soviet.org"
+ "Vladamir Lenin: lenin@soviet.org")
+
+;; tests update-instance-from-records
+(deftest :oodml/update-instance/1
+ (values
+ (concatenate 'string
+ (slot-value employee1 'first-name)
+ " "
+ (slot-value employee1 'last-name)
+ ": "
+ (slot-value employee1 'email))
+ (progn
+ (usql:update-records [employee]
+ :av-pairs '(([first-name] "Ivan")
+ ([last-name] "Petrov")
+ ([email] "petrov@soviet.org"))
+ :where [= [emplid] 1])
+ (usql:update-instance-from-records employee1)
+ (concatenate 'string
+ (slot-value employee1 'first-name)
+ " "
+ (slot-value employee1 'last-name)
+ ": "
+ (slot-value employee1 'email)))
+ (progn
+ (usql:update-records [employee]
+ :av-pairs '(([first-name] "Vladamir")
+ ([last-name] "Lenin")
+ ([email] "lenin@soviet.org"))
+ :where [= [emplid] 1])
+ (usql:update-instance-from-records employee1)
+ (concatenate 'string
+ (slot-value employee1 'first-name)
+ " "
+ (slot-value employee1 'last-name)
+ ": "
+ (slot-value employee1 'email))))
+ "Vladamir Lenin: lenin@soviet.org"
+ "Ivan Petrov: petrov@soviet.org"
+ "Vladamir Lenin: lenin@soviet.org")
+
+;; tests update-slot-from-record
+(deftest :oodml/update-instance/2
+ (values
+ (slot-value employee1 'email)
+ (progn
+ (usql:update-records [employee]
+ :av-pairs '(([email] "lenin-nospam@soviet.org"))
+ :where [= [emplid] 1])
+ (usql:update-slot-from-record employee1 'email)
+ (slot-value employee1 'email))
+ (progn
+ (usql:update-records [employee]
+ :av-pairs '(([email] "lenin@soviet.org"))
+ :where [= [emplid] 1])
+ (usql:update-slot-from-record employee1 'email)
+ (slot-value employee1 'email)))
+ "lenin@soviet.org" "lenin-nospam@soviet.org" "lenin@soviet.org")
+
+
+;(deftest :oodml/iteration/1
+; (usql:do-query ((e) [select 'usql-tests::employee :where [married]
+; :order-by [emplid]])
+; (slot-value e last-name))
+; ("Lenin" "Stalin" "Trotsky"))
+
+;(deftest :oodml/iteration/2
+; (usql:map-query 'list #'last-name [select 'employee :where [married]
+; :order-by [emplid]])
+; ("Lenin" "Stalin" "Trotsky"))
+
+;(deftest :oodml/iteration/3
+; (loop for (e) being the tuples in
+; [select 'employee :where [married] :order-by [emplid]]
+; collect (slot-value e 'last-name))
+; ("Lenin" "Stalin" "Trotsky"))
+
+
+#.(usql:restore-sql-reader-syntax-state)
projects / clsql.git / blobdiff