* Add regression testing
* Depend on cl-rt package
+ * Use compat file rather than DH_COMPAT
-- Kevin M. Rosenberg <kmr@debian.org> Mon, 28 Apr 2003 11:40:27 -0600
#!/usr/bin/make -f
-export DH_COMPAT=4
-
pkg := hyperobject
pkg-tests := $(pkg)-tests
debpkg := cl-$(pkg)
-
clc-source := usr/share/common-lisp/source
clc-systems := usr/share/common-lisp/systems
clc-files := $(clc-source)/$(pkg)
dh_testroot
rm -f build-stamp configure-stamp
# Add here commands to clean up after the build process.
- rm -f debian/cl-hyperobject.postinst.* debian/cl-hyperobject.prerm.*
+ rm -f debian/$(debpkg).postinst.* debian/$(debpkg).prerm.*
dh_clean
install: build
;;;; Author: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: hyperobject.asd,v 1.22 2003/04/28 19:06:13 kevin Exp $
+;;;; $Id: hyperobject.asd,v 1.23 2003/04/28 21:11:55 kevin Exp $
;;;; *************************************************************************
-(defpackage hyperobject-system
- (:use #:asdf #:cl))
+(defpackage hyperobject-system (:use #:asdf #:cl))
(in-package :hyperobject-system)
#+(or allegro lispworks sbcl cmu scl)
(oos 'test-op 'hyperobject-tests))
+
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: package.lisp,v 1.43 2003/04/24 07:00:02 kevin Exp $
+;;;; $Id: package.lisp,v 1.44 2003/04/28 21:11:55 kevin Exp $
;;;;
;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
;;;; *************************************************************************
#+kmr-sbcl-mop #:sb-mop
#+kmr-cmucl-mop #:mop
#+allegro #:mop
- #+lispworks #:clos)
+ #+lispworks #:clos
+ #+scl #:clos)
(:export
#:package
#:hyperobject
pcl:class-prototype pcl:generic-function-method-class pcl:intern-eql-specializer
pcl:make-method-lambda pcl:generic-function-lambda-list)
#+scl
- '(clos:class-slots clos::standard-class
- clos::slot-definition-name clos:finalize-inheritance
- clos::standard-direct-slot-definition clos::standard-effective-slot-definition
- clos::validate-superclass clos:direct-slot-definition-class
- clos:compute-effective-slot-definition
- clos::compute-effective-slot-definition-initargs
- clos::slot-value-using-class
- clos::class-prototype clos:generic-function-method-class
+ '(clos::compute-effective-slot-definition-initargs
+ clos::class-prototype
;; note: make-method-lambda is not fbound
- clos:intern-eql-specializer clos:make-method-lambda
- clos:generic-function-lambda-list)
+ )
:hyperobject))
(setq cl:*features* (delete :kmr-sbcl-mop cl:*features*))
(setq cl:*features* (delete :kmr-sbcl-pcl cl:*features*))))
-
+#+cmu
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (if (find-package 'mop)
+ (setq cl:*features* (delete :kmr-cmucl-mop cl:*features*))
+ (setq cl:*features* (delete :kmr-cmucl-pcl cl:*features*))))
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2003
;;;;
-;;;; $Id: tests.lisp,v 1.2 2003/04/28 19:06:13 kevin Exp $
+;;;; $Id: tests.lisp,v 1.3 2003/04/28 21:11:55 kevin Exp $
;;;;
;;;; This file is Copyright (c) 2000-2002 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))))
-
(defclass person (hyperobject)
((first-name :initarg :first-name :accessor first-name
:value-type (varchar 20)
(full-name :value-type string :stored nil)
(dob :initarg :dob :accessor dob
:value-type integer
- :print-formatter format-date
+ :print-formatter date-string
:value-constraint integerp
:input-filter convert-to-date)
(resume :initarg :resume :accessor resume
:addresses (list home office)
:resume "Style & Grace"))
-;(format t "~&Text Format~%")
-;(view mary :subobjects t)
-
-;(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)
Staff line 123-0002
Fax 123-0005
")
+
+(deftest p3 (view-to-string mary :category t)
+ "")
+
+(deftest p4 (view-to-string mary :subobjects t :category t)
+ "")
+
+(deftest p5 (view-to-string mary :subobjects t :category :xml-link-labels)
+ "")