Hi Jeff,
Thanks a lot for the bug report. Yes, I should have tested these things more carefully, but I have found the sources for these bugs. See the following responses.
On 10 Aug 2004, at 17:05, Jeff Caldwell wrote:
(defpackage test-aspectl (:use :aspectl :cl-user :cl)) (in-package :test-aspectl)
(define-join-point environment-pointcut do-something) (define-join-point environment-pointcut do-something-else) ; => (#<JOIN-PONT 216EEA1C> #<JOIN-PONT 2068D784>)
(define-aspect-weaver environment-pointcut accept-environment-arg (aspect-weaver join-point) (declare (ignore aspect-weaver)) (create-method (fdefinition (join-point-name join-point)) :qualifiers '(:around) :lambda-list '(args &key (in-environment *some-environment*) &allow-other-keys) :specializers (list (find-class 't)) :declarations '((ignore args)) :body '(progn (if (eq in-environment *some-environment*) (call-next-method) (with-some-environment (in-environment) (call-next-method))))))) ; Error: ; The code from overview.html is missing ; a parenthesis on the last line
Hm, it doesn't seem so. Maybe you have missed something during copy and paste?
; ; Error: ; => Undefined function DO-SOMETHING-ELSE in form ; (SYMBOL-FUNCTION DO-SOMETHING-ELSE)
This cannot work. The example refers to the previous section where I have sketched methods do-something and do-something-else. Without those methods the code cannot work. Check out the sources of al-mixins.lisp for a more complete example. (I should provide a more illustrative example, this one is obviously too abstract.)
(defclass person () ((name :accessor name :initarg :name))) ; => #<STANDARD-CLASS PERSON 217ABAD4>
(with-class 'person (class-add :direct-slots '(age :accessor age :initarg :age))) ; => #<STANDARD-CLASS PERSON 217ABAD4>
(setq *p1* (make-instance 'person)) ; => #<PERSON 20687C04>
(inspect *p1*) ; => ; #<PERSON 211E92A4> is a PERSON ; NAME #<unbound slot> ; ; Error: ; The direct slot 'age' was not added to the class ; 'person
Yep. The bug is in al-mixins.lisp. See the aspect weaver WITH-CLASS ACCEPT-CLASS-ARG. There is a test (if (not (eq 'class *the-class*)) ...). This should read (if (not (eq ,class *the-class*)) ...). (A comma instead of a quote.)
(defmethod print-person-list :around (person-list) (with-special-generic-function-scope (print-person*) (defmethod* print-person* :before ((scope dynamic) person) (print "This person is part of a person list.")) (call-next-method))) ; => #<STANDARD-METHOD PRINT-PERSON-LIST (:AROUND) (T) 2068C044>
My mistake. Instead of WITH-SPECIAL-GENERIC-FUNCTION-SCOPE this should read WITH-SPECIAL-FUNCTION-SCOPE. This is a leftover from 0.5.
Thanks a lot. I am going to update the website soon.
Pascal
-- Tyler: "How's that working out for you?" Jack: "Great." Tyler: "Keep it up, then."