From aa610805927518a648eb0da6a8713cd0a83337df Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Mon, 28 Apr 2003 21:12:27 +0000 Subject: [PATCH] r4665: *** empty log message *** --- attrib-class.lisp | 61 +++++++++++++++++++---------------------------- datetime.lisp | 49 +++++++++++++++++++++++++++++++++++++ debian/changelog | 8 +++++++ debian/compat | 1 + debian/control | 2 +- debian/rules | 22 +++++++++-------- genutils.lisp | 32 +------------------------ kmrcl-tests.asd | 25 +++++++++++++++++++ kmrcl.asd | 26 ++++++++++++++------ strings.lisp | 10 ++++---- tests.lisp | 45 ++++++++++++++++++++++++++++++++++ 11 files changed, 191 insertions(+), 90 deletions(-) create mode 100644 datetime.lisp create mode 100644 debian/compat create mode 100644 kmrcl-tests.asd create mode 100644 tests.lisp diff --git a/attrib-class.lisp b/attrib-class.lisp index 7a7bebe..0b837ad 100644 --- a/attrib-class.lisp +++ b/attrib-class.lisp @@ -7,7 +7,7 @@ ;;;; 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 ;;;; @@ -21,39 +21,51 @@ (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 @@ -61,7 +73,7 @@ normal-slot)) -(defmethod mop::compute-slots ((class attributes-class)) +(defmethod compute-slots ((class attributes-class)) (let* ((normal-slots (call-next-method)) (alist (mapcar @@ -98,28 +110,3 @@ 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)) - -||# diff --git a/datetime.lisp b/datetime.lisp new file mode 100644 index 0000000..9d20449 --- /dev/null +++ b/datetime.lisp @@ -0,0 +1,49 @@ +;;;; -*- 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)))) diff --git a/debian/changelog b/debian/changelog index 53502d2..e8165ab 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,11 @@ +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 Mon, 28 Apr 2003 14:32:16 -0600 + cl-kmrcl (1.30-1) unstable; urgency=low * Really fix typo diff --git a/debian/compat b/debian/compat new file mode 100644 index 0000000..b8626c4 --- /dev/null +++ b/debian/compat @@ -0,0 +1 @@ +4 diff --git a/debian/control b/debian/control index 7c676fa..5e875b3 100644 --- a/debian/control +++ b/debian/control @@ -7,7 +7,7 @@ Standards-Version: 3.5.9.0 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 diff --git a/debian/rules b/debian/rules index fa61826..39e58b4 100755 --- a/debian/rules +++ b/debian/rules @@ -1,17 +1,17 @@ #!/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: @@ -33,7 +33,7 @@ clean: 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 @@ -41,9 +41,11 @@ 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 diff --git a/genutils.lisp b/genutils.lisp index cee438b..cbd78f1 100644 --- a/genutils.lisp +++ b/genutils.lisp @@ -7,7 +7,7 @@ ;;;; 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 ;;;; @@ -18,7 +18,6 @@ (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)) @@ -481,35 +480,6 @@ (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 diff --git a/kmrcl-tests.asd b/kmrcl-tests.asd new file mode 100644 index 0000000..8f5a446 --- /dev/null +++ b/kmrcl-tests.asd @@ -0,0 +1,25 @@ +;;;; -*- 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"))) + diff --git a/kmrcl.asd b/kmrcl.asd index 83ccb5a..6b7ca40 100644 --- a/kmrcl.asd +++ b/kmrcl.asd @@ -7,7 +7,7 @@ ;;;; 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 ;;;; @@ -16,11 +16,18 @@ ;;;; (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 " + :version "1.31+" + :maintainer "Kevin M. Rosenberg " + :licence "LLGPL" -(defsystem :kmrcl - :perform (load-op :after (op kmrcl) - (pushnew :kmrcl cl:*features*)) :components ((:file "package") (:file "console" :depends-on ("package")) @@ -31,11 +38,16 @@ (: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)) diff --git a/strings.lisp b/strings.lisp index 9c6d4d1..d8c0e43 100644 --- a/strings.lisp +++ b/strings.lisp @@ -7,7 +7,7 @@ ;;;; 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 ;;;; @@ -168,10 +168,12 @@ list of characters and replacement strings." (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))) diff --git a/tests.lisp b/tests.lisp new file mode 100644 index 0000000..eebaf13 --- /dev/null +++ b/tests.lisp @@ -0,0 +1,45 @@ +;;;; -*- 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 + -- 2.34.1