X-Git-Url: http://git.kpe.io/?p=hyperobject.git;a=blobdiff_plain;f=tests.lisp;h=d6a7d2e2e2810e9dce1fa8be5b0c3c1465a5cfed;hp=dd8035a6f8f5d456df37bf7998ea96eb4debe311;hb=6cfefea96a65eb54d12d10e61a1d2b9ecaddc8ae;hpb=c03522d6e56c265fc5b7d859d0a8b324805ddf73 diff --git a/tests.lisp b/tests.lisp index dd8035a..d6a7d2e 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,6 +16,9 @@ (: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) @@ -25,6 +28,7 @@ :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 @@ -37,9 +41,10 @@ :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") @@ -55,11 +60,14 @@ :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) @@ -68,7 +76,8 @@ :value-constraint stringp) (phone-number :initarg :phone-number :accessor phone-number :value-type (varchar 16) - :value-constraint stringp)) + :value-constraint stringp + :hyperlink search-phone-number)) (:metaclass hyperobject-class) (:user-name "Phone Number") (:default-initargs :title nil :phone-number nil) @@ -83,12 +92,14 @@ (defparameter office-phone-3 (make-instance 'phone :title "Fax" :phone-number "123-0005")) (defparameter home (make-instance 'address :title "Home" :street "321 Shady Lane" + :years-at-address 10 :phones (list home-phone-1 home-phone-2))) (defparameter office (make-instance 'address :title "Office" :street "113 Main St." + :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) @@ -102,79 +113,51 @@ (rem-all-tests) -(deftest p1 (view-to-string mary) "Person: +(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: +(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 ") -(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")