1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
|
;;;; -*- 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 11085 2006-09-03 02:12:03Z kevin $
;;;;
;;;; 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
:hyperlink-parameters (("narrow" . "yes"))
: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
: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"))
(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 :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
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 :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
")
|
