X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=tests.lisp;h=5f698bd69632e9bef3249918cf2f22f3a9fa467a;hb=90c2e4c13bd89c48de9fe0da126547447b7b9e01;hp=c7dbfa4da5ddfcae27e3e8ad828124cac84667b6;hpb=f45b5a177039ec999d3fd43ddf2f7bad8e8e4fd3;p=hyperobject.git diff --git a/tests.lisp b/tests.lisp index c7dbfa4..5f698bd 100644 --- a/tests.lisp +++ b/tests.lisp @@ -7,72 +7,83 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2003 ;;;; -;;;; $Id: tests.lisp,v 1.1 2003/04/28 16:03:57 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 ;;;; ************************************************************************* - -(in-package :hyperobject-user) + +(defpackage #:hyperobject-tests + (:use #:hyperobject #:cl #:rtest #:kmrcl)) +(in-package #:hyperobject-tests) + +(defvar *now* (get-universal-time)) +(defun get-now () *now*) (defclass person (hyperobject) - ((first-name :value-type (varchar 20) :initarg :first-name :accessor first-name - :value-constraint stringp :null-allowed nil) - (last-name :value-type (varchar 30) :initarg :last-name :accessor last-name + ((first-name :initarg :first-name :accessor first-name + :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) + :hyperlink find-person-by-last-name + :hyperlink-parameters (("narrow" . "yes")) + :null-allowed nil) (full-name :value-type string :stored nil) - (dob :value-type integer :initarg :dob :accessor dob :print-formatter format-date - :value-constraint integerp :input-filter convert-to-date) - (resume :value-type string :initarg :resume :accessor resume + (dob :initarg :dob :accessor dob + :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) -;; (addresses :value-type (list-of subobject) :initarg :addresses :accessor addresses)) - (addresses :subobject t :initarg :addresses :accessor addresses)) + ;; (addresses :value-type (list-of subobject) :initarg :addresses :accessor addresses)) + (addresses :initarg :addresses :accessor addresses + :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))))) - -(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)))) + (setf full-name (concatenate 'string first-name " " last-name))))) (defclass address (hyperobject) - ((title :value-type (varchar 20) :initarg :title :accessor title - :value-constraint stringp) - (street :value-type (varchar 30) :initarg :street :accessor street + ((title :initarg :title :accessor title + :value-type (varchar 20) :value-constraint stringp) - (phones :subobject t :initarg :phones :accessor phones)) + (street :initarg :street :accessor street + :value-type (varchar 30) + :value-constraint stringp) + (phones :initarg :phones :accessor phones + :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 :value-type (varchar 20) :initarg :title :accessor title + ((title :initarg :title :accessor title + :value-type (varchar 20) :value-constraint stringp) - (phone-number :value-type (varchar 16) :initarg :phone-number :accessor phone-number - :value-constraint stringp)) + (phone-number :initarg :phone-number :accessor phone-number + :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) (:default-print-slots title phone-number) (:description "A phone number")) - (defparameter home-phone-1 (make-instance 'phone :title "Voice" :phone-number "367-9812")) (defparameter home-phone-2 (make-instance 'phone :title "Fax" :phone-number "367-9813")) @@ -81,20 +92,61 @@ (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 (get-universal-time) + :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) +(defun view-to-string (obj &rest args) + (with-output-to-string (strm) + (apply #'view obj :stream strm args))) + +(rem-all-tests) + +(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 :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. 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 :s1 (years-at-address home) + 10) + +(deftest :s2 (years-at-address office) + 5) + +(deftest :cv1 (equal (create-time mary) *now*) + t) -(format t "~&XML Format with field labels and hyperlinks~%") -(view mary :subobjects t :category :xml-link-labels)