;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; ;;;; Name: hyperobject-tests.lisp ;;;; Purpose: Hyperobject tests file ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2003 ;;;; ;;;; $Id: tests.lisp,v 1.6 2003/05/14 05:38:09 kevin Exp $ ;;;; ;;;; This file is Copyright (c) 2000-2003 by Kevin M. Rosenberg ;;;; ************************************************************************* (defpackage #:hyperobject-tests (:use #:hyperobject #:cl #:rtest #:kmrcl)) (in-package #:hyperobject-tests) (defclass person (hyperobject) ((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) (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) (resume :initarg :resume :accessor resume :value-type string :value-constraint stringp) ;; (addresses :value-type (list-of subobject) :initarg :addresses :accessor addresses)) (addresses :initarg :addresses :accessor addresses :subobject t)) (:metaclass hyperobject-class) (: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))))) (defclass address (hyperobject) ((title :initarg :title :accessor title :value-type (varchar 20) :value-constraint stringp) (street :initarg :street :accessor street :value-type (varchar 30) :value-constraint stringp) (phones :initarg :phones :accessor phones :subobject t)) (:metaclass hyperobject-class) (:default-initargs :title nil :street nil) (:user-name "Address" "Addresses") (:default-print-slots title street) (:description "An address")) (defclass phone (hyperobject) ((title :initarg :title :accessor title :value-type (varchar 20) :value-constraint stringp) (phone-number :initarg :phone-number :accessor phone-number :value-type (varchar 16) :value-constraint stringp)) (: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")) (defparameter office-phone-1 (make-instance 'phone :title "Main line" :phone-number "123-0001")) (defparameter office-phone-2 (make-instance 'phone :title "Staff line" :phone-number "123-0002")) (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))) (defparameter office (make-instance 'address :title "Office" :street "113 Main St." :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")) (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) "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 Addresses: Home 321 Shady Lane Phone Numbers: Voice 367-9812 Fax 367-9813 Office 113 Main St. Phone Numbers: Main line 123-0001 Staff line 123-0002 Fax 123-0005 ") (deftest p3 (view-to-string mary :category :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 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]]>
")