Commit 88b88cf5 authored by pfdietz's avatar pfdietz
Browse files

Bug fix in eval-when.1 due to Gerd Moellmann.

parent 9ab8da0f
......@@ -29,6 +29,9 @@
;;; Macro to ignore errors, but report them anyway
(defparameter *report-and-ignore-errors-break* nil
"When true, REPORT-AND-IGNORE-ERRORS breaks instead of discarding the error condition.")
(defmacro report-and-ignore-errors (&body body)
`(eval-when (:load-toplevel :compile-toplevel :execute)
(#+sbcl let #+sbcl () #-sbcl progn
......@@ -37,6 +40,7 @@
(error (condition)
(princ condition)
(when *report-and-ignore-errors-break* (break))
(values nil condition))))))
......@@ -49,6 +49,12 @@
(deftest define-method-combination-01.4
(let ((doc (documentation *dmc-times* 'method-combination)))
(or (null doc)
(equalt doc "Multiplicative method combination, version 1")))
(eval-when (:load-toplevel :compile-toplevel :execute)
(defgeneric dmc-gf-02 (x) (:method-combination times))
......@@ -134,3 +140,42 @@
(deftest define-method-combination-04.3
(dmc-gf-04 'a)
(eval-when (:load-toplevel :compile-toplevel :execute)
(defvar *dmc-times-5*
(define-method-combination times-5 :operator *))))
(deftest define-method-combination-05.1
(let* ((doc1 (setf (documentation *dmc-times-5* 'method-combination)
(doc2 (documentation *dmc-times-5* 'method-combination)))
(or (null doc2)
(equalt doc2 "foo"))))
"foo" t)
;; Operator name defaults to the method combination name.
(eval-when (:load-toplevel :compile-toplevel :execute)
(defun times-7 (&rest args) (apply #'* args))
(defvar *dmc-times-7*
(define-method-combination times-7))
(defgeneric dmc-gf-07 (x) (:method-combination times))
(defmethod dmc-gf-07 times ((x integer)) 2)
(defmethod dmc-gf-07 times ((x rational)) 3)
(defmethod dmc-gf-07 times ((x real)) 5)
(defmethod dmc-gf-07 times ((x number)) 7)
(defmethod dmc-gf-07 times ((x complex)) 11)
(deftest define-method-combination-07.1
(dmc-gf-07 1)
(dmc-gf-07 1/2)
(dmc-gf-07 1.0)
(dmc-gf-07 #c(1 2)))
210 105 35 77)
......@@ -25,7 +25,7 @@
(push `(let () (eval-when (,@c ,@l ,@x)
(push '(let ,@c ,@l ,@x) *eval-when.1-collector*)))
(with-open-file (o ff :direction :output)
(with-open-file (o ff :direction :output :if-exists :supersede)
(dolist (f forms)
(prin1 f o)
(terpri o)))
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment