From 87dd8f605382a9a3a8777c67e9748a0899adadd3 Mon Sep 17 00:00:00 2001 From: pfdietz Date: Mon, 16 Jun 2003 11:37:43 +0000 Subject: [PATCH] Begin adding tests for define-method-combination; add some cleanup tests for class-name. --- ansi-tests/class-name.lsp | 34 +++++++++ ansi-tests/define-method-combination.lsp | 87 ++++++++++++++++++++++++ ansi-tests/load-objects.lsp | 2 + 3 files changed, 123 insertions(+) create mode 100644 ansi-tests/class-name.lsp create mode 100644 ansi-tests/define-method-combination.lsp diff --git a/ansi-tests/class-name.lsp b/ansi-tests/class-name.lsp new file mode 100644 index 0000000..fca64a2 --- /dev/null +++ b/ansi-tests/class-name.lsp @@ -0,0 +1,34 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Jun 15 12:05:47 2003 +;;;; Contains: Tests of CLASS-NAME + +(in-package :cl-test) + +;;; This is mostly tested elsewhere. + +(deftest class-name.1 + (class-name (find-class 'symbol)) + symbol) + +(defclass class-name-class-01 () (a b c)) + +(defmethod class-name ((x class-name-class-01)) 'silly) + +(deftest class-name.2 + (class-name (make-instance 'class-name-class-01)) + silly) + +;; Tests of (setf class-name) + +(deftest setf-class-name.1 + (typep* #'(setf class-name) 'standard-generic-function) + t) + +(deftest class-name.error.1 + (classify-error (class-name)) + program-error) + +(deftest class-name.error.2 + (classify-error (class-name (find-class 'symbol) nil)) + program-error) diff --git a/ansi-tests/define-method-combination.lsp b/ansi-tests/define-method-combination.lsp new file mode 100644 index 0000000..514faff --- /dev/null +++ b/ansi-tests/define-method-combination.lsp @@ -0,0 +1,87 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Jun 15 10:49:39 2003 +;;;; Contains: Tests of DEFINE-METHOD-COMBINATION + +(in-package :cl-test) + +(define-method-combination times + :documentation "Multiplicative method combination, version 1" + :operator *) + +(defgeneric dmc-gf-01 (x) (:method-combination times)) + +(defmethod dmc-gf-01 times ((x integer)) 2) +(defmethod dmc-gf-01 times ((x rational)) 3) +(defmethod dmc-gf-01 times ((x real)) 5) +(defmethod dmc-gf-01 times ((x number)) 7) +(defmethod dmc-gf-01 times ((x complex)) 11) + +(deftest define-method-combination-01.1 + (values + (dmc-gf-01 1) + (dmc-gf-01 1/2) + (dmc-gf-01 1.0) + (dmc-gf-01 #c(1 2))) + 210 105 35 77) + +(deftest define-method-combination-01.2 + (handler-case + (eval '(locally (declare (optimize (safety 3))) + (dmc-gf-01 'x))) + (error () :good)) + :good) + +(defgeneric dmc-gf-02 (x) (:method-combination times)) + +(defmethod dmc-gf-02 times ((x integer)) 2) +(defmethod dmc-gf-02 :around ((x rational)) (1- (call-next-method))) +(defmethod dmc-gf-02 times ((x real)) 3) +(defmethod dmc-gf-02 times ((x number)) 5) +(defmethod dmc-gf-02 :around ((x (eql 1.0s0))) 1) + +(deftest define-method-combination-02.1 + (values + (dmc-gf-02 1) + (dmc-gf-02 1/3) + (dmc-gf-02 1.0s0) + (dmc-gf-02 13.0) + (dmc-gf-02 #c(1 2))) + 29 14 1 15 5) + +(defgeneric dmc-gf-03 (x) (:method-combination times)) + +(deftest define-method-combination-03.1 + (handler-case + (progn + (eval '(defmethod dmc-gf-03 ((x integer)) t)) + :bad) + (error () :good)) + :good) + +(deftest define-method-combination-03.2 + (handler-case + (progn + (eval '(defmethod dmc-gf-03 :before ((x cons)) t)) + :bad) + (error () :good)) + :good) + +(deftest define-method-combination-03.3 + (handler-case + (progn + (eval '(defmethod dmc-gf-03 :after ((x symbol)) t)) + :bad) + (error () :good)) + :good) + + + + + + + + + + + diff --git a/ansi-tests/load-objects.lsp b/ansi-tests/load-objects.lsp index 2a1be1a..3affa3c 100644 --- a/ansi-tests/load-objects.lsp +++ b/ansi-tests/load-objects.lsp @@ -48,6 +48,8 @@ (load "next-method-p.lsp") (load "call-next-method.lsp") (load "compute-applicable-methods.lsp") +(load "define-method-combination.lsp") (load "find-method.lsp") (load "add-method.lsp") (load "unbound-slot.lsp") +(load "class-name.lsp") -- GitLab