X-Git-Url: http://git.kpe.io/?p=hyperobject.git;a=blobdiff_plain;f=tests.lisp;h=3859844e077f5d322d4335d03db0398f58fc4daf;hp=dd8035a6f8f5d456df37bf7998ea96eb4debe311;hb=HEAD;hpb=c03522d6e56c265fc5b7d859d0a8b324805ddf73 diff --git a/tests.lisp b/tests.lisp index dd8035a..3859844 100644 --- a/tests.lisp +++ b/tests.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2003 ;;;; -;;;; $Id: tests.lisp,v 1.6 2003/05/14 05:38:09 kevin Exp $ +;;;; $Id$ ;;;; ;;;; This file is Copyright (c) 2000-2003 by Kevin M. Rosenberg ;;;; ************************************************************************* @@ -16,59 +16,68 @@ (:use #:hyperobject #:cl #:rtest #:kmrcl)) (in-package #:hyperobject-tests) +(defvar *now* (get-universal-time)) +(defun get-now () *now*) + (defclass person (hyperobject) ((first-name :initarg :first-name :accessor first-name - :value-type (varchar 20) - :value-constraint stringp - :null-allowed nil) + :value-type (varchar 20) + :value-constraint stringp + :null-allowed nil) (last-name :initarg :last-name :accessor last-name - :value-type (varchar 30) - :value-constraint stringp - :hyperlink find-person-by-last-name - :null-allowed nil) + :value-type (varchar 30) + :value-constraint stringp + :hyperlink find-person-by-last-name + :hyperlink-parameters (("narrow" . "yes")) + :null-allowed nil) (full-name :value-type string :stored nil) (dob :initarg :dob :accessor dob - :value-type integer - :print-formatter date-string - :value-constraint integerp - :input-filter convert-to-date) + :value-type integer + :print-formatter date-string + :value-constraint integerp + :input-filter convert-to-date) (resume :initarg :resume :accessor resume - :value-type string - :value-constraint stringp) + :value-type string + :value-constraint stringp) ;; (addresses :value-type (list-of subobject) :initarg :addresses :accessor addresses)) (addresses :initarg :addresses :accessor addresses - :subobject t)) + :subobject t) + (create-time :accessor create-time :compute-cached-value (get-now))) (:metaclass hyperobject-class) - (:default-initargs :first-name "" :last-name "" :dob 0 :resume nil) + (:default-initargs :first-name "" :last-name "" :dob 0 :resume nil) (:default-print-slots first-name last-name dob resume) (:user-name "Person") (:description "A Person") (:direct-rules (:rule-1 (:dependants (last-name first-name) :volatile full-name) - (setf full-name (concatenate 'string first-name " " last-name))))) + (setf full-name (concatenate 'string first-name " " last-name))))) (defclass address (hyperobject) ((title :initarg :title :accessor title - :value-type (varchar 20) - :value-constraint stringp) + :value-type (varchar 20) + :value-constraint stringp) (street :initarg :street :accessor street - :value-type (varchar 30) - :value-constraint stringp) + :value-type (varchar 30) + :value-constraint stringp) (phones :initarg :phones :accessor phones - :subobject t)) + :subobject t) + (years-at-address :initarg :years-at-address :value-type fixnum + :accessor years-at-address + :value-constraint integerp)) (:metaclass hyperobject-class) - (:default-initargs :title nil :street nil) + (:default-initargs :title nil :street nil) (:user-name "Address" "Addresses") - (:default-print-slots title street) + (:default-print-slots title street years-at-address) (:description "An address")) (defclass phone (hyperobject) ((title :initarg :title :accessor title - :value-type (varchar 20) - :value-constraint stringp) + :value-type (varchar 20) + :value-constraint stringp) (phone-number :initarg :phone-number :accessor phone-number - :value-type (varchar 16) - :value-constraint stringp)) + :value-type (varchar 16) + :value-constraint stringp + :hyperlink search-phone-number)) (:metaclass hyperobject-class) (:user-name "Phone Number") (:default-initargs :title nil :phone-number nil) @@ -83,17 +92,19 @@ (defparameter office-phone-3 (make-instance 'phone :title "Fax" :phone-number "123-0005")) (defparameter home (make-instance 'address :title "Home" :street "321 Shady Lane" - :phones (list home-phone-1 home-phone-2))) + :years-at-address 10 + :phones (list home-phone-1 home-phone-2))) (defparameter office (make-instance 'address :title "Office" :street "113 Main St." - :phones (list office-phone-1 office-phone-2 office-phone-3))) + :years-at-address 5 + :phones (list office-phone-1 office-phone-2 office-phone-3))) + - (defparameter mary (make-instance 'person :first-name "Mary" :last-name "Jackson" - :dob (encode-universal-time - 1 2 3 4 5 2000) - :addresses (list home office) - :resume "Style & Grace")) + :dob (encode-universal-time + 1 2 3 4 5 2000) + :addresses (list home office) + :resume "Style & Grace")) (defun view-to-string (obj &rest args) @@ -102,79 +113,51 @@ (rem-all-tests) -(deftest p1 (view-to-string mary) "Person: - Mary Jackson Thu, 4 May 2000 03:02:01 Style & Grace +(deftest :p1 (view-to-string mary :vid :compact-text) "Person: + Mary Jackson Thu 4 May 2000 03:02:01 Style & Grace ") -(deftest p2 (view-to-string mary :subobjects t) "Person: - Mary Jackson Thu, 4 May 2000 03:02:01 Style & Grace +(deftest :p2 (view-to-string mary :subobjects t :vid :compact-text) "Person: + Mary Jackson Thu 4 May 2000 03:02:01 Style & Grace Addresses: - Home 321 Shady Lane + Home 321 Shady Lane 10 Phone Numbers: Voice 367-9812 Fax 367-9813 - Office 113 Main St. + Office 113 Main St. 5 Phone Numbers: Main line 123-0001 Staff line 123-0002 Fax 123-0005 ") -(deftest p3 (view-to-string mary :category :compact-text-labels) +(deftest :p3 (view-to-string mary :vid :compact-text-labels) "Person: - first-name Mary last-name Jackson dob Thu, 4 May 2000 03:02:01 resume Style & Grace + first-name Mary last-name Jackson dob Thu 4 May 2000 03:02:01 resume Style & Grace ") -(deftest p4 (view-to-string mary :subobjects t :category :html-labels) - "

Person:

+(deftest :p4 (view-to-string mary :vid :compact-text) +"Person: + Mary Jackson Thu 4 May 2000 03:02:01 Style & Grace ") -(deftest p5 (view-to-string mary :subobjects t :category :xml-link-labels) - "Person: - - Addresss: -
<![CDATA[Home]]> - Phone Numbers: - <![CDATA[Voice]]> - - <![CDATA[Fax]]> - - -
-
<![CDATA[Office]]> - Phone Numbers: - <![CDATA[Main line]]> - - <![CDATA[Staff line]]> - - <![CDATA[Fax]]> - - -
- - - -") +(deftest :cv1 (years-at-address home) + 10) + +(deftest :cv2 (years-at-address office) + 5) + +(deftest :cv3 (equal (create-time mary) *now*) + t) + +(deftest :s1 (slot-value (class-of mary) 'ho::user-name) + "Person") + +(deftest :s2 (slot-value (class-of mary) 'ho::user-name-plural) + "Persons") + +(deftest :s3 (slot-value (class-of home) 'ho::user-name-plural) + "Addresses") + +(deftest :s4 (slot-value (class-of mary) 'ho::description) + "A Person")