Commit 0001745a authored by pfdietz's avatar pfdietz
Browse files

Fix to make-load-form to get around a bug in define-condition in gcl. Begin...

Fix to make-load-form to get around a bug in define-condition in gcl.  Begin adding defgeneric tests.
parent 902d1ea2
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat May 17 20:55:50 2003
;;;; Contains: Tests of DEFGENERIC
(in-package :cl-test)
;;; Various error cases
(defun defgeneric-testfn-01 (x) x)
(deftest defgeneric.error.1
;; Cannot make ordinary functions generic
(let* ((name 'defgeneric-testfn-01)
(fn (symbol-function name)))
(if (not (typep fn 'generic-function))
(handler-case
(progn (eval `(defgeneric ,name ())) :bad)
(error () :good))
:good))
:good)
(defmacro defgeneric-testmacro-02 (x) x)
(deftest defgeneric.error.2
;; Cannot make macros generic
(let* ((name 'defgeneric-testmacro-02))
(handler-case
(progn (eval `(defgeneric ,name ())) :bad)
(error () :good)))
:good)
......@@ -30,3 +30,4 @@
(load "make-load-form-saving-slots.lsp")
(load "with-accessors.lsp")
(load "with-slots.lsp")
(load "defgeneric.lsp")
......@@ -25,7 +25,7 @@
(error () :good))
:good)
(define-condition make-load-form-condition-03 () (a b c))
(define-condition make-load-form-condition-03 () ((a) (b) (c)))
(deftest make-load-form.3
(handler-case
......@@ -154,6 +154,34 @@
(nil t t)
((a b c) a))
#|
(defclass make-load-form-class-05a ()
((a :initarg :a)))
(defclass make-load-form-class-05b (make-load-form-class-05a)
((b :initarg :b)))
(defmethod make-load-form ((obj make-load-form-class-05a)
&optional (env t))
(declare (ignore env))
(let ((newobj (gensym)))
`(let ((,newobj (allocate-instance (find-class 'make-load-form-class-04))))
,@(when (slot-boundp obj 'a)
`((setf (slot-value ,newobj 'a) ',(slot-value obj 'a))))
,newobj)))
(defmethod make-load-form :around ((obj make-load-form-class-05b)
&optional (env t))
(declare (ignore env))
(let ((newobj (gensym)))
`(let ((,newobj (allocate-instance (find-class 'make-load-form-class-04))))
,@(when (slot-boundp obj 'a)
`((setf (slot-value ,newobj 'a) ',(slot-value obj 'a))))
,newobj)))
|#
;;; Other error tests
(deftest make-load-form.error.1
......
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