From 88b88cf5decfc0b5d07021aa55c666395b9435ca Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Wed, 16 Jul 2003 11:51:14 +0000 Subject: [PATCH] Bug fix in eval-when.1 due to Gerd Moellmann. --- ansi-tests/ansi-aux-macros.lsp | 4 +++ ansi-tests/define-method-combination.lsp | 45 ++++++++++++++++++++++++ ansi-tests/eval-when.lsp | 2 +- 3 files changed, 50 insertions(+), 1 deletion(-) diff --git a/ansi-tests/ansi-aux-macros.lsp b/ansi-tests/ansi-aux-macros.lsp index 0ea353ba..656561cc 100644 --- a/ansi-tests/ansi-aux-macros.lsp +++ b/ansi-tests/ansi-aux-macros.lsp @@ -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) (terpri) + (when *report-and-ignore-errors-break* (break)) (values nil condition)))))) diff --git a/ansi-tests/define-method-combination.lsp b/ansi-tests/define-method-combination.lsp index 182fc916..95346593 100644 --- a/ansi-tests/define-method-combination.lsp +++ b/ansi-tests/define-method-combination.lsp @@ -49,6 +49,12 @@ *dmc-times* times) +(deftest define-method-combination-01.4 + (let ((doc (documentation *dmc-times* 'method-combination))) + (or (null doc) + (equalt doc "Multiplicative method combination, version 1"))) + t) + (eval-when (:load-toplevel :compile-toplevel :execute) (report-and-ignore-errors (defgeneric dmc-gf-02 (x) (:method-combination times)) @@ -134,3 +140,42 @@ (deftest define-method-combination-04.3 (dmc-gf-04 'a) nil) + +(eval-when (:load-toplevel :compile-toplevel :execute) + (report-and-ignore-errors + (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) + "foo")) + (doc2 (documentation *dmc-times-5* 'method-combination))) + (values + doc1 + (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)) + (report-and-ignore-errors + (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 + (values + (dmc-gf-07 1) + (dmc-gf-07 1/2) + (dmc-gf-07 1.0) + (dmc-gf-07 #c(1 2))) + 210 105 35 77) diff --git a/ansi-tests/eval-when.lsp b/ansi-tests/eval-when.lsp index 92cee582..f403c512 100644 --- a/ansi-tests/eval-when.lsp +++ b/ansi-tests/eval-when.lsp @@ -25,7 +25,7 @@ (push `(let () (eval-when (,@c ,@l ,@x) (push '(let ,@c ,@l ,@x) *eval-when.1-collector*))) forms)))) - (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))) -- GitLab