Commit 1ead4b93 authored by pfdietz's avatar pfdietz

Tests for MAKE-INSTANCES-OBSOLETE and (some of the tests for) MAKE-LOAD-FORM.

parent 1807b0a7
......@@ -25,3 +25,6 @@
(load "no-next-method.lsp")
(load "remove-method.lsp")
(load "make-instance.lsp")
(load "make-instances-obsolete.lsp")
(load "make-load-form.lsp")
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat May 17 08:12:35 2003
;;;; Contains: Tests of MAKE-INSTANCES-OBSOLETE
(in-package :cl-test)
(defclass make-instances-obsolete-class-01 ()
((a :initarg :a)
(b :initarg :b :allocation :class)
(c :initarg :c :initform 'abc)
(d :initarg :d :type fixnum :initform 0)))
(deftest make-instances-obsolete.1
(let* ((class (find-class 'make-instances-obsolete-class-01))
(obj (make-instance class :a 'x :b 'y :c 'z :d 17)))
(values
(eqt (class-of obj) class)
(map-slot-value obj '(a b c d))
(eqt (make-instances-obsolete class) class)
(map-slot-value obj '(a b c d))))
t (x y z 17) t (x y z 17))
(deftest make-instances-obsolete.2
(let* ((class (find-class 'make-instances-obsolete-class-01))
(obj (make-instance class :a 'x :b 'y :c 'z :d 17)))
(values
(eqt (class-of obj) class)
(map-slot-value obj '(a b c d))
(eqt (make-instances-obsolete 'make-instances-obsolete-class-01) class)
(map-slot-value obj '(a b c d))))
t (x y z 17) t (x y z 17))
;;; Error cases
(deftest make-instances-obsolete.error.1
(classify-error (make-instances-obsolete))
program-error)
(deftest make-instances-obsolete.error.2
(classify-error (make-instances-obsolete
(find-class 'make-instances-obsolete-class-01)
nil))
program-error)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat May 17 09:16:20 2003
;;;; Contains: Tests of MAKE-LOAD-FORM
(in-package :cl-test)
;;; These tests are just of MAKE-LOAD-FORM itself; tests of file compilation
;;; that depend on MAKE-LOAD-FORM will be found elsewhere.
(defclass make-load-form-class-01 () (a b c))
(deftest make-load-form.1
(handler-case
(progn (make-load-form (make-instance 'make-load-form-class-01))
:bad)
(error () :good))
:good)
(defstruct make-load-form-struct-02 a b c)
(deftest make-load-form.2
(handler-case
(progn (make-load-form (make-make-load-form-struct-02)) :bad)
(error () :good))
:good)
(define-condition make-load-form-condition-03 () (a b c))
(deftest make-load-form.3
(handler-case
(progn (make-load-form (make-condition 'make-load-form-condition-03) :bad))
(error () :good))
:good)
;;; Make sure these errors are due to the method, not due to lack of
;;; methods
(deftest make-load-form.4
(let* ((obj (make-instance 'make-load-form-class-01))
(fun #'make-load-form)
(methods (compute-applicable-methods fun (list obj))))
(values
(typep* fun 'standard-generic-function)
(notnot-mv methods)))
t t)
(deftest make-load-form.5
(let* ((obj (make-make-load-form-struct-02))
(fun #'make-load-form)
(methods (compute-applicable-methods fun (list obj))))
(values
(typep* fun 'standard-generic-function)
(notnot-mv methods)))
t t)
(deftest make-load-form.6
(let* ((obj (make-condition 'make-load-form-condition-03))
(fun #'make-load-form)
(methods (compute-applicable-methods fun (list obj))))
(values
(typep* fun 'standard-generic-function)
(notnot-mv methods)))
t t)
Markdown is supported
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