X-Git-Url: http://git.kpe.io/?p=hyperobject.git;a=blobdiff_plain;f=tests.lisp;h=3859844e077f5d322d4335d03db0398f58fc4daf;hp=135499690d3d8bc91c5687c89e38f7fffad89b00;hb=HEAD;hpb=7b3ca1025e0b572b6511c044e948aeab2147af45 diff --git a/tests.lisp b/tests.lisp index 1354996..3859844 100644 --- a/tests.lisp +++ b/tests.lisp @@ -7,81 +7,77 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2003 ;;;; -;;;; $Id: tests.lisp,v 1.2 2003/04/28 19:06:13 kevin Exp $ -;;;; -;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg +;;;; $Id$ ;;;; +;;;; This file is Copyright (c) 2000-2003 by Kevin M. Rosenberg ;;;; ************************************************************************* (defpackage #:hyperobject-tests - (:use #:hyperobject #:cl #:rtest)) + (:use #:hyperobject #:cl #:rtest #:kmrcl)) (in-package #:hyperobject-tests) -(defun format-date (ut) - (when (typep ut 'integer) - (multiple-value-bind (sec min hr day mon year dow daylight-p zone) - (decode-universal-time ut) - (declare (ignore daylight-p zone)) - (format nil "~[Mon~;Tue~;Wed~;Thu~;Fri~;Sat~;Sun~], ~d ~[Jan~;Feb~;Mar~;Apr~;May~;Jun~;Jul~;Aug~;Sep~;Oct~;Nov~;Dec~] ~d ~2,'0d:~2,'0d:~2,'0d" - dow - day - (1- mon) - year - hr min sec)))) +(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 format-date - :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) - (:user-name "Address") - (:default-print-slots title street) + (:default-initargs :title nil :street nil) + (:user-name "Address" "Addresses") + (: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) @@ -96,23 +92,20 @@ (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")) -;(format t "~&Text Format~%") -;(view mary :subobjects t) +(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")) -;(format t "~&XML Format with field labels and hyperlinks~%") -;(view mary :subobjects t :category :xml-link-labels) (defun view-to-string (obj &rest args) (with-output-to-string (strm) @@ -120,20 +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 - Addresss: - Home 321 Shady Lane +(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 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 :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 :vid :compact-text) +"Person: + Mary Jackson Thu 4 May 2000 03:02:01 Style & Grace +") + +(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")