From: Kevin M. Rosenberg Date: Thu, 1 Oct 2020 22:13:10 +0000 (-0600) Subject: Use modern ASDF test-op. SB-MOP changes for latest SBCL. X-Git-Url: http://git.kpe.io/?p=hyperobject.git;a=commitdiff_plain;h=7004f03c13d273f36075f814ca599190deb3030b Use modern ASDF test-op. SB-MOP changes for latest SBCL. --- diff --git a/debian/changelog b/debian/changelog index 68d7c08..8946308 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +cl-hyperobject (2.13-1) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg Thu, 01 Oct 2020 16:11:33 -0600 + cl-hyperobject (2.12.0-1) unstable; urgency=low * New upstream @@ -10,7 +16,7 @@ cl-hyperobject (2.11.0-3) unstable; urgency=low * Build with debhelper extension dh-lisp * control: Add Vcs-Browser field. Fix Depends field. * rules: Fix installation of example file - + -- Kevin M. Rosenberg Mon, 03 Aug 2009 14:02:47 -0600 cl-hyperobject (2.11.0-2) unstable; urgency=low diff --git a/debian/compat b/debian/compat index 7f8f011..b4de394 100644 --- a/debian/compat +++ b/debian/compat @@ -1 +1 @@ -7 +11 diff --git a/debian/control b/debian/control index 3bac1cb..ed06c7e 100644 --- a/debian/control +++ b/debian/control @@ -3,7 +3,7 @@ Section: lisp Priority: optional Maintainer: Kevin M. Rosenberg Build-Depends-Indep: dh-lisp -Build-Depends: debhelper (>= 7.0.0) +Build-Depends: debhelper (>= 11.0.0) Standards-Version: 3.9.2.0 Homepage: http://hyperobject.kpe.io/ Vcs-Git: git://git.kpe.io/hyperobject.git diff --git a/debian/rules b/debian/rules index deaab45..8fed3f6 100755 --- a/debian/rules +++ b/debian/rules @@ -14,9 +14,7 @@ source-files := $(filter-out $(tests-files),$(wildcard *.lisp)) build: build-arch build-indep - build-arch: - build-indep: clean: diff --git a/metaclass.lisp b/metaclass.lisp index 264afa7..8b175e7 100644 --- a/metaclass.lisp +++ b/metaclass.lisp @@ -7,9 +7,6 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; -;;;; $Id$ -;;;; ;;;; This file is Copyright (c) 2000-2006 by Kevin M. Rosenberg ;;;; ************************************************************************* @@ -31,4 +28,3 @@ (defparameter *slot-options-no-initarg* '(:ho-type :sql-type :sql-length) "Slot options that do not have an initarg") - diff --git a/mop.lisp b/mop.lisp index 0771543..43a2f82 100644 --- a/mop.lisp +++ b/mop.lisp @@ -11,8 +11,6 @@ ;;;; in Text, HTML, and XML formats. This includes hyperlinking ;;;; capability and sub-objects. ;;;; -;;;; $Id$ -;;;; ;;;; This file is Copyright (c) 2000-2006 by Kevin M. Rosenberg ;;;; ************************************************************************* @@ -22,10 +20,10 @@ (defclass hyperobject-class (standard-class) ( ;; slots initialized in defclass - (user-name :initarg :user-name :type string :initform nil + (user-name :initarg :user-name :initform nil :accessor user-name :documentation "User name for class") - (user-name-plural :initarg :user-name-plural :type string :initform nil + (user-name-plural :initarg :user-name-plural :initform nil :accessor user-name-plural :documentation "Plural user name for class") (default-print-slots :initarg :default-print-slots :type list :initform nil @@ -541,7 +539,7 @@ SQL name" (setf (documentation cl 'type) (format nil "Hyperobject~A~A~A~A" (aif (user-name cl) - (format nil ": ~A" it "")) + (format nil ": ~A" it) "") (aif (description cl) (format nil "~%Class description: ~A" it) "") (aif (subobjects cl) diff --git a/package.lisp b/package.lisp index 392caa6..a2c4bcd 100644 --- a/package.lisp +++ b/package.lisp @@ -7,19 +7,11 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id$ -;;;; ;;;; This file is Copyright (c) 2000-2003 by Kevin M. Rosenberg ;;;; ************************************************************************* (in-package #:cl-user) -#+sbcl -(eval-when (:compile-toplevel :load-toplevel :execute) - (if (find-package 'sb-mop) - (pushnew :kmr-sbcl-mop cl:*features*) - (pushnew :kmr-sbcl-pcl cl:*features*))) - #+cmu (eval-when (:compile-toplevel :load-toplevel :execute) (if (eq (symbol-package 'pcl:find-class) @@ -27,11 +19,17 @@ (pushnew :kmr-cmucl-mop cl:*features*) (pushnew :kmr-cmucl-pcl cl:*features*))) +(eval-when (:compile-toplevel :load-toplevel :execute) + (when (find-package '#:hyperobject-tests) + (delete-package '#:hyperobject-tests)) + (when (find-package '#:hyperobject-user) + (delete-package '#:hyperobject-user)) + (when (find-package '#:hyperobject) + (delete-package '#:hyperobject))) (defpackage #:hyperobject (:nicknames #:ho) (:use #:common-lisp #:kmrcl - #+kmr-sbcl-mop #:sb-mop #+kmr-cmucl-mop #:mop #+allegro #:mop #+lispworks #:clos @@ -56,28 +54,44 @@ (:nicknames #:ho-user) (:use #:hyperobject #:cl #:cl-user)) - (eval-when (:compile-toplevel :load-toplevel :execute) + #+sbcl + (dolist (name '("CLASS-OF" + "CLASS-NAME" + "CLASS-SLOTS" + "FIND-CLASS" + "STANDARD-CLASS" + "SLOT-DEFINITION-NAME" + "FINALIZE-INHERITANCE" + "STANDARD-DIRECT-SLOT-DEFINITION" + "CLASS-PRECEDENCE-LIST" + "STANDARD-EFFECTIVE-SLOT-DEFINITION" + "VALIDATE-SUPERCLASS" "DIRECT-SLOT-DEFINITION-CLASS" + "EFFECTIVE-SLOT-DEFINITION-CLASS" + "COMPUTE-EFFECTIVE-SLOT-DEFINITION" + "CLASS-DIRECT-SLOTS" + "COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS" + "SLOT-VALUE-USING-CLASS" + "CLASS-PROTOTYPE" + "GENERIC-FUNCTION-METHOD-CLASS" + "INTERN-EQL-SPECIALIZER" + "MAKE-METHOD-LAMBDA" + "GENERIC-FUNCTION-LAMBDA-LIST" + "COMPUTE-SLOTS")) + (let ((sym (find-symbol name "SB-MOP"))) + (if sym + (progn (shadowing-import sym :hyperobject)) + (progn + (setq sym (find-symbol name "SB-PCL")) + (if sym + (shadowing-import sym :hyperobject) + (warn "Can't find function ~A in packages SB-MOP or SB-PCL" name)))))) + #-sbcl (shadowing-import #+allegro '(excl::compute-effective-slot-definition-initargs) #+lispworks '(clos::compute-effective-slot-definition-initargs) - #+kmr-sbcl-mop - '(sb-pcl::compute-effective-slot-definition-initargs) - #+kmr-sbcl-pcl - '(sb-pcl:class-of sb-pcl:class-name sb-pcl:class-slots sb-pcl:find-class - sb-pcl::standard-class - sb-pcl:slot-definition-name sb-pcl::finalize-inheritance - sb-pcl::standard-direct-slot-definition - sb-pcl::standard-effective-slot-definition sb-pcl::validate-superclass - sb-pcl::direct-slot-definition-class sb-pcl::compute-effective-slot-definition - sb-pcl::compute-effective-slot-definition-initargs - sb-pcl::slot-value-using-class - sb-pcl:slot-definition-type - sb-pcl:class-prototype sb-pcl:generic-function-method-class sb-pcl:intern-eql-specializer - sb-pcl:make-method-lambda sb-pcl:generic-function-lambda-list - sb-pcl::class-precedence-list) #+kmr-cmucl-mop '(pcl::compute-effective-slot-definition-initargs) #+kmr-cmucl-pcl @@ -111,15 +125,8 @@ clos:slot-definition-type ;; note: make-method-lambda is not fbound ) - :hyperobject)) -#+sbcl -(eval-when (:compile-toplevel :load-toplevel :execute) - (if (find-package 'sb-mop) - (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) diff --git a/tests.lisp b/tests.lisp index ff66b6f..3859844 100644 --- a/tests.lisp +++ b/tests.lisp @@ -114,11 +114,11 @@ (rem-all-tests) (deftest :p1 (view-to-string mary :vid :compact-text) "Person: - Mary Jackson Thu, 4 May 2000 03:02:01 Style & Grace + 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 + Mary Jackson Thu 4 May 2000 03:02:01 Style & Grace Addresses: Home 321 Shady Lane 10 Phone Numbers: @@ -133,12 +133,12 @@ (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 + 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 + Mary Jackson Thu 4 May 2000 03:02:01 Style & Grace ") (deftest :cv1 (years-at-address home)