;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: attrib-class.lisp,v 1.4 2002/10/10 16:23:48 kevin Exp $
+;;;; $Id: attrib-class.lisp,v 1.5 2003/04/28 21:12:27 kevin Exp $
;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
(in-package :kmrcl)
-(defclass attributes-dsd (mop::standard-direct-slot-definition)
+(defclass attributes-dsd (standard-direct-slot-definition)
((attributes :initarg :attributes :initform nil
:accessor attributes)))
-(defclass attributes-esd (mop::standard-effective-slot-definition)
+(defclass attributes-esd (standard-effective-slot-definition)
((attributes :initarg :attributes :initform nil
:accessor slot-definition-attributes)))
-(defclass attributes-class (mop::standard-class)
+(defclass attributes-class (standard-class)
()
)
-(defmethod mop::direct-slot-definition-class ((cl attributes-class)
+#+(or cmu scl sbcl)
+(defmethod validate-superclass ((class attributes-class)
+ (superclass standard-class))
+ t)
+
+(defmethod direct-slot-definition-class ((cl attributes-class)
&rest iargs &key attributes)
(declare (ignorable attributes))
;; (format t "attributes:~s iargs:~s~%" attributes iargs)
(find-class 'attributes-dsd))
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (when (>= (length (generic-function-lambda-list
+ (ensure-generic-function
+ 'compute-effective-slot-definition)))
+ 3)
+ (push :ho-named-cesd-fun cl:*features*)))
-(defmethod mop::compute-effective-slot-definition :around
- ((cl attributes-class) slot dsds)
- (declare (ignorable slot))
+(defmethod compute-effective-slot-definition :around
+ ((cl attributes-class) #+ho-named-cesd-fun name dsds)
+ #+ho-named-cesd-fun (declare (ignore name))
(apply
#'make-instance 'attributes-esd
:attributes (remove-duplicates (mapappend #'attributes dsds))
- (excl::compute-effective-slot-definition-initargs cl dsds))
+ (compute-effective-slot-definition-initargs cl dsds))
)
#+ignore
-(defmethod mop::compute-effective-slot-definition ((cl attributes-class) slot dsds)
- (declare (ignorable slot))
+(defmethod compute-effective-slot-definition :around
+ ((cl attributes-class) #+ho-named-cesd-fun name dsds)
+ #+ho-named-cesd-fun (declare (ignore name))
(let ((normal-slot (call-next-method)))
(setf (slot-definition-attributes normal-slot)
(remove-duplicates
normal-slot))
-(defmethod mop::compute-slots ((class attributes-class))
+(defmethod compute-slots ((class attributes-class))
(let* ((normal-slots (call-next-method))
(alist
(mapcar
attr-bucket)))
-#||
-(in-package :kmrcl)
-
-(defclass credit-rating ()
- ((level :attributes (date-set time-set))
- (id :attributes (person-setting)))
- (:metaclass kmrcl:attributes-class))
-(defparameter cr (make-instance 'credit-rating))
-
-(format t "~&date-set: ~a" (slot-attribute cr 'level 'date-set))
-(setf (slot-attribute cr 'level 'date-set) "12/15/1990")
-(format t "~&date-set: ~a" (slot-attribute cr 'level 'date-set))
-
-(defclass monitored-credit-rating (credit-rating)
- ((level :attributes (last-checked interval date-set))
- (cc :initarg :cc)
- (id :attributes (verified))
- )
- (:metaclass attributes-class))
-(defparameter mcr (make-instance 'monitored-credit-rating))
-
-(setf (slot-attribute mcr 'level 'date-set) "01/05/2002")
-(format t "~&date-set for mcr: ~a" (slot-attribute mcr 'level 'date-set))
-
-||#
--- /dev/null
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: datetime.lisp
+;;;; Purpose: Date & Time functions for KMRCL package
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Apr 2000
+;;;;
+;;;; $Id: datetime.lisp,v 1.1 2003/04/28 21:12:27 kevin Exp $
+;;;;
+;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; KMRCL users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
+
+(in-package #:kmrcl)
+
+
+;;; Formatting functions
+
+(defun pretty-date (year month day &optional (hour 12) (m 0) (s 0))
+ (multiple-value-bind (sec min hr dy mn yr wkday)
+ (decode-universal-time
+ (encode-universal-time s m hour day month year))
+ (values (elt '("Monday" "Tuesday" "Wednesday" "Thursday"
+ "Friday" "Saturday" "Sunday")
+ wkday)
+ (elt '("January" "February" "March" "April" "May" "June"
+ "July" "August" "September" "October" "November"
+ "December")
+ (1- mn))
+ (format nil "~A" dy) (format nil "~A" yr)
+ (format nil "~2,'0D:~2,'0D:~2,'0D" hr min sec))))
+
+
+(defun date-string (ut)
+ (if (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))))
+cl-kmrcl (1.31-1) unstable; urgency=low
+
+ * New upstream
+ * Add tests suite, add cl-rt to depends
+ * Use compat file rather than DH_COMPAT variable
+
+ -- Kevin M. Rosenberg <kmr@debian.org> Mon, 28 Apr 2003 14:32:16 -0600
+
cl-kmrcl (1.30-1) unstable; urgency=low
* Really fix typo
Package: cl-kmrcl
Architecture: all
-Depends: ${shlibs:Depends}, common-lisp-controller
+Depends: ${shlibs:Depends}, common-lisp-controller, cl-rt
Description: General Utilities for Common Lisp Programs
This package includes general purpose utilities for Common Lisp
programs. It is packages for Debian primarily to support more complex
#!/usr/bin/make -f
-export DH_COMPAT=4
-
pkg := kmrcl
-debpkg := cl-kmrcl
-
+pkg-tests := $(pkg)-tests
+debpkg := cl-$(pkg)
clc-source := usr/share/common-lisp/source
clc-systems := usr/share/common-lisp/systems
-clc-kmrcl := $(clc-source)/$(pkg)
-
+clc-files := $(clc-source)/$(pkg)
+clc-tests := $(clc-source)/$(pkg-tests)
doc-dir := usr/share/doc/$(debpkg)
+tests-files := tests.lisp
+source-files := $(filter-out $(tests-files),$(wildcard *.lisp))
configure: configure-stamp
configure-stamp:
dh_testroot
rm -f build-stamp configure-stamp
# Add here commands to clean up after the build process.
- rm -f debian/cl-kmrcl.postinst.* debian/cl-kmrcl.prerm.*
+ rm -f debian/$(debpkg).postinst.* debian/$(debpkg).prerm.*
dh_clean
install: build
dh_testroot
dh_clean -k
# Add here commands to install the package into debian/kmrcl.
- dh_installdirs $(clc-systems) $(clc-kmrcl) $(doc-dir)
- dh_install kmrcl.asd $(shell echo *.lisp) $(clc-kmrcl)
- dh_link $(clc-kmrcl)/kmrcl.asd $(clc-systems)/kmrcl.asd
+ dh_installdirs $(clc-systems) $(clc-files) $(clc-tests)
+ dh_install $(pkg).asd $(source-files) $(clc-files)
+ dh_link $(clc-files)/$(pkg).asd $(clc-systems)/$(pkg).asd
+ dh_install $(pkg-tests).asd $(tests-files) $(clc-tests)
+ dh_link $(clc-tests)/$(pkg-tests).asd $(clc-systems)/$(pkg-tests).asd
# Build architecture-independent files here.
binary-indep: build install
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: genutils.lisp,v 1.15 2003/02/07 14:21:55 kevin Exp $
+;;;; $Id: genutils.lisp,v 1.16 2003/04/28 21:12:27 kevin Exp $
;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
(in-package :kmrcl)
-(declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3)))
(defmacro let-when ((var test-form) &body body)
`(let ((,var ,test-form))
(nreverse lines))))
-;;; Formatting functions
-
-(defun pretty-date (year month day &optional (hour 12) (m 0) (s 0))
- (multiple-value-bind (sec min hr dy mn yr wkday)
- (decode-universal-time
- (encode-universal-time s m hour day month year))
- (values (elt '("Monday" "Tuesday" "Wednesday" "Thursday"
- "Friday" "Saturday" "Sunday")
- wkday)
- (elt '("January" "February" "March" "April" "May" "June"
- "July" "August" "September" "October" "November"
- "December")
- (1- mn))
- (format nil "~A" dy) (format nil "~A" yr)
- (format nil "~2,'0D:~2,'0D:~2,'0D" hr min sec))))
-
-
-(defun date-string (ut)
- (if (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))))
-
;; Benchmarking
--- /dev/null
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: kmrcl-tests.asd
+;;;; Purpose: ASDF system definitionf for kmrcl testing package
+;;;; Author: Kevin M. Rosenberg
+;;;; Date Started: Apr 2003
+;;;;
+;;;; $Id: kmrcl-tests.asd,v 1.1 2003/04/28 21:12:27 kevin Exp $
+;;;; *************************************************************************
+
+(defpackage #:kmrcl-tests-system
+ (:use #:asdf #:cl))
+(in-package #:kmrcl-tests-system)
+
+(defsystem kmrcl-tests
+ :depends-on (:rt :kmrcl)
+ :components ((:file "tests")))
+
+(defmethod perform ((o test-op) (c (eql (find-system :kmrcl-tests))))
+ (or (funcall (intern (symbol-name '#:do-tests)
+ (find-package '#:regression-test)))
+ (error "test-op failed")))
+
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: kmrcl.asd,v 1.23 2002/12/13 21:59:57 kevin Exp $
+;;;; $Id: kmrcl.asd,v 1.24 2003/04/28 21:12:27 kevin Exp $
;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;; *************************************************************************
-(in-package :asdf)
+(defpackage #:kmrcl-system (:use #:asdf #:cl))
+(in-package #:kmrcl-system)
+
+#+(or allegro cmucl lispworks sbcl scl) (push :kmr-mop cl:*features*)
+
+(defsystem kmrcl
+ :name "kmrcl"
+ :author "Kevin M. Rosenberg <kevin@rosenberg.net>"
+ :version "1.31+"
+ :maintainer "Kevin M. Rosenberg <kmr@debian.org>"
+ :licence "LLGPL"
-(defsystem :kmrcl
- :perform (load-op :after (op kmrcl)
- (pushnew :kmrcl cl:*features*))
:components
((:file "package")
(:file "console" :depends-on ("package"))
(:file "telnet-server" :depends-on ("genutils"))
(:file "random" :depends-on ("package"))
(:file "cl-symbols" :depends-on ("package"))
+ (:file "datetime" :depends-on ("package"))
(:file "math" :depends-on ("package"))
- #+allegro (:file "attrib-class" :depends-on ("package"))
+ #+kmr-mop (:file "mop" :depends-on ("package"))
+ #+kmr-mop (:file "attrib-class" :depends-on ("package"))
(:file "web-utils" :depends-on ("package"))
(:file "xml-utils" :depends-on ("package")))
)
-
+#+(or allegro lispworks sbcl cmu scl)
+(defmethod perform ((o test-op) (c (eql (find-system :kmrcl))))
+ (oos 'load-op 'kmrcl-tests)
+ (oos 'test-op 'kmrcl-tests))
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: strings.lisp,v 1.8 2003/04/28 16:07:43 kevin Exp $
+;;;; $Id: strings.lisp,v 1.9 2003/04/28 21:12:27 kevin Exp $
;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
(match (assoc c repl-alist :test #'char=)))
(declare (character c))
(if match
- (let ((subst (cdr match)))
- (dotimes (j (length subst))
+ (let* ((subst (cdr match))
+ (len (length match)))
+ (dotimes (j len)
(setf (char new-string i) (char subst j))
- (incf i)))
+ (incf i))
+ (decf i))
(progn
(setf (char new-string i) c)))))
new-string)))
--- /dev/null
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: kmrcl-tests.lisp
+;;;; Purpose: kmrcl tests file
+;;;; Author: Kevin M. Rosenberg
+;;;; Date Started: Apr 2003
+;;;;
+;;;; $Id: tests.lisp,v 1.1 2003/04/28 21:12:27 kevin Exp $
+;;;;
+;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(defpackage #:kmrcl-tests
+ (:use #:kmrcl #:cl #:rtest))
+(in-package #:kmrcl-tests)
+
+(deftest p1 t t)
+
+#+kmrcl-mop
+(progn
+ (defclass credit-rating ()
+ ((level :attributes (date-set time-set))
+ (id :attributes (person-setting)))
+ (:metaclass kmrcl:attributes-class))
+ (defparameter cr (make-instance 'credit-rating))
+
+ (format t "~&date-set: ~a" (slot-attribute cr 'level 'date-set))
+ (setf (slot-attribute cr 'level 'date-set) "12/15/1990")
+(format t "~&date-set: ~a" (slot-attribute cr 'level 'date-set))
+
+(defclass monitored-credit-rating (credit-rating)
+ ((level :attributes (last-checked interval date-set))
+ (cc :initarg :cc)
+ (id :attributes (verified))
+ )
+ (:metaclass attributes-class))
+(defparameter mcr (make-instance 'monitored-credit-rating))
+
+(setf (slot-attribute mcr 'level 'date-set) "01/05/2002")
+(format t "~&date-set for mcr: ~a" (slot-attribute mcr 'level 'date-set))
+) ;; kmrcl-mop
+
projects / kmrcl.git / commitdiff