(: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)
;; (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-print-slots first-name last-name dob resume)
: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" "Addresses")
- (:default-print-slots title street)
+ (:default-print-slots title street years-at-address)
(:description "An address"))
(defclass phone (hyperobject)
(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)))
(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
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")