X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=tests%2Ftest-oodml.lisp;h=103de94744425a292c693f9e4f7b1f68ea2bd4e6;hb=b8b381951e4f6ebe76620dc3bf93faba4cd703bc;hp=6ab648a03ac1c30ff2a3adc0ca57af96519295fb;hpb=d22f943ae95f7421218d74e68179b773c63c0635;p=clsql.git diff --git a/tests/test-oodml.lisp b/tests/test-oodml.lisp index 6ab648a..103de94 100644 --- a/tests/test-oodml.lisp +++ b/tests/test-oodml.lisp @@ -1,7 +1,6 @@ ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;;; ====================================================================== ;;;; File: test-oodml.lisp -;;;; Author: Marcus Pearce ;;;; Created: 01/04/2004 ;;;; ;;;; Tests for the CLSQL Object Oriented Data Definition Language @@ -458,7 +457,7 @@ (format nil "~a ~a ~a" (slot-value node 'setting-id) (slot-value node 'title) - (slot-value node 'vars))))) + (or (slot-value node 'vars) "NIL"))))) (values (print-fresh-setting) (let ((node (car (clsql:select 'setting @@ -511,7 +510,7 @@ (with-slots (node-id setting-id theme-id title vars doc) node (format nil "~a ~a ~a ~a ~a ~a" node-id setting-id theme-id - title vars doc))))) + title (or vars "NIL") doc))))) (values (print-fresh-theme) (let ((node (car (clsql:select 'setting @@ -588,7 +587,7 @@ :flatp t :caching nil)))) (setf (slot-value sl 'title) "subloc-1") (setf (slot-value sl 'loc) "a subloc") - (clsql:update-record-from-slot sl '(title loc)) + (clsql:update-record-from-slots sl '(title loc)) (print-fresh-subloc))))) "10 subloc-1 a subloc" "10 Altered subloc title Altered loc" @@ -598,7 +597,7 @@ ;; (was failing in Postgresql at somepoint) (deftest :oodml/update-records/10 (with-dataset *ds-employees* - (let ((emp (first (clsql:select 'employee :where [= [emplid] 1] :flatp T)))) + (let ((emp (first (clsql:select 'employee :where [= [emplid] 1] :flatp t)))) (setf (height emp) nil) (clsql-sys:update-record-from-slot emp 'height) (values @@ -659,7 +658,7 @@ (format out "~a ~a ~a ~a" (slot-value theme2 'theme-id) (slot-value theme2 'title) - (slot-value theme2 'vars) + (or (slot-value theme2 'vars) "NIL") (slot-value theme2 'doc))) (progn (clsql:update-records [node] :av-pairs '(([title] "Altered title")) @@ -746,22 +745,22 @@ (print-subloc (sl) (format nil "~a: ~a" (slot-value sl 'node-id) (slot-value sl 'loc)))) - (with-dataset *ds-nodes* - (values - (print-loc loc2) - (print-subloc subloc2) - (progn - (clsql:update-records [node] - :av-pairs '(([title] "altered title")) - :where [= [node-id] 9]) - (clsql:update-slot-from-record loc2 'title) - (print-loc loc2)) - (progn - (clsql:update-records [subloc] - :av-pairs '(([loc] "altered loc")) - :where [= [subloc-id] 11]) - (clsql:update-slot-from-record subloc2 'loc) - (print-subloc subloc2))))) + (with-dataset *ds-nodes* + (values + (print-loc loc2) + (print-subloc subloc2) + (progn + (clsql:update-records [node] + :av-pairs '(([title] "altered title")) + :where [= [node-id] 9]) + (clsql:update-slot-from-record loc2 'title) + (print-loc loc2)) + (progn + (clsql:update-records [subloc] + :av-pairs '(([loc] "altered loc")) + :where [= [subloc-id] 11]) + (clsql:update-slot-from-record subloc2 'loc) + (print-subloc subloc2))))) "9: location-2" "11: second subloc" "9: altered title" "11: altered loc") @@ -971,21 +970,22 @@ (values (let ((inst (make-instance 'theme :title "test-theme" :vars "test-vars" - :doc "test-doc"))) + :doc "test-doc")) + (*print-circle* nil)) (setf (slot-value inst 'title) "alternate-test-theme") (format nil "~a ~a ~a ~a" - (select [title] :from [node] - :where [= [title] "test-theme"] - :flatp t :field-names nil) - (select [vars] :from [setting] - :where [= [vars] "test-vars"] - :flatp t :field-names nil) - (select [doc] :from [theme] - :where [= [doc] "test-doc"] - :flatp t :field-names nil) - (select [title] :from [node] - :where [= [title] "alternate-test-theme"] - :flatp t :field-names nil))) + (or (select [title] :from [node] + :where [= [title] "test-theme"] + :flatp t :field-names nil) "NIL") + (or (select [vars] :from [setting] + :where [= [vars] "test-vars"] + :flatp t :field-names nil) "NIL") + (or (select [doc] :from [theme] + :where [= [doc] "test-doc"] + :flatp t :field-names nil) "NIL") + (or (select [title] :from [node] + :where [= [title] "alternate-test-theme"] + :flatp t :field-names nil) "NIL"))) (let* ((*db-auto-sync* t) (inst (make-instance 'theme :title "test-theme" :vars "test-vars" @@ -993,18 +993,18 @@ (setf (slot-value inst 'title) "alternate-test-theme") (prog1 (format nil "~a ~a ~a ~a" - (select [title] :from [node] - :where [= [title] "test-theme"] - :flatp t :field-names nil) - (select [vars] :from [setting] - :where [= [vars] "test-vars"] - :flatp t :field-names nil) - (select [doc] :from [theme] - :where [= [doc] "test-doc"] - :flatp t :field-names nil) - (select [title] :from [node] - :where [= [title] "alternate-test-theme"] - :flatp t :field-names nil)) + (or (select [title] :from [node] + :where [= [title] "test-theme"] + :flatp t :field-names nil) "NIL") + (or (select [vars] :from [setting] + :where [= [vars] "test-vars"] + :flatp t :field-names nil) "NIL") + (or (select [doc] :from [theme] + :where [= [doc] "test-doc"] + :flatp t :field-names nil) "NIL") + (or (select [title] :from [node] + :where [= [title] "alternate-test-theme"] + :flatp t :field-names nil) "NIL")) (delete-records :from [node] :where [= [title] "alternate-test-theme"]) (delete-records :from [setting] :where [= [vars] "test-vars"]) (delete-records :from [theme] :where [= [doc] "test-doc"])))))