Commit 91a5ac27 authored by pfdietz's avatar pfdietz

Added more make-load-form tests, and tests for make-load-form-saving-slots.

parent 283056a0
......@@ -27,4 +27,4 @@
(load "make-instance.lsp")
(load "make-instances-obsolete.lsp")
(load "make-load-form.lsp")
(load "make-load-form-saving-slots.lsp")
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat May 17 11:54:54 2003
;;;; Contains: Tests of MAKE-LOAD-FORM-SAVING-SLOTS
(in-package :cl-test)
;;; These are tests of MAKE-LOAD-FORM-SAVING-SLOTS proper; tests involving
;;; file compilation will be located elsewhere.
(defstruct mlfss-01 a b c)
(deftest make-load-form-saving-slots.1
(let* ((obj (make-mlfss-01))
(forms (multiple-value-list
(make-load-form-saving-slots obj))))
(values
(length forms)
(let ((newobj (eval (first forms))))
(eval (subst newobj obj (second forms)))
(eqt (class-of obj) (class-of newobj)))))
2 t)
(deftest make-load-form-saving-slots.2
(let* ((obj (make-mlfss-01))
(forms (multiple-value-list
(make-load-form-saving-slots obj :slot-names '(a b)))))
(values
(length forms)
(let ((newobj (eval (first forms))))
(eval (subst newobj obj (second forms)))
(eqt (class-of obj) (class-of newobj)))))
2 t)
(defclass mlfss-02 () ((a :initarg :a) (b :initarg :b) (c :initarg :c)))
(deftest make-load-form-saving-slots.3
(let* ((obj (make-instance 'mlfss-02))
(forms (multiple-value-list
(make-load-form-saving-slots obj))))
(let ((newobj (eval (first forms))))
(eval (subst newobj obj (second forms)))
(values
(length forms)
(eqt (class-of obj) (class-of newobj))
(map-slot-boundp* newobj '(a b c)))))
2 t (nil nil nil))
(deftest make-load-form-saving-slots.4
(let* ((obj (make-instance 'mlfss-02 :a 1 :b 'a :c '(x y z)))
(forms (multiple-value-list
(make-load-form-saving-slots obj :slot-names '(a b c)))))
(let ((newobj (eval (first forms))))
(eval (subst newobj obj (second forms)))
(values
(length forms)
(eqt (class-of obj) (class-of newobj))
(map-slot-boundp* newobj '(a b c))
(map-slot-value newobj '(a b c)))))
2 t (t t t) (1 a (x y z)))
(deftest make-load-form-saving-slots.5
(let* ((obj (make-instance 'mlfss-02 :a #(x y z)))
(forms (multiple-value-list
(make-load-form-saving-slots obj :slot-names '(a b)))))
(let ((newobj (eval (first forms))))
(eval (subst newobj obj (second forms)))
(values
(length forms)
(eqt (class-of obj) (class-of newobj))
(map-slot-boundp* newobj '(a b c))
(slot-value newobj 'a))))
2 t (t nil nil) #(x y z))
......@@ -107,3 +107,51 @@
(notnot-mv methods))))
(%m))
t)
;;; User-defined methods
(defclass make-load-form-class-04 ()
((a :initarg :a) (b :initarg :b) (c :initarg :c)))
(defmethod make-load-form ((obj make-load-form-class-04)
&optional (env t))
(declare (ignore env))
(let ((newobj (gensym)))
`(let ((,newobj (allocate-instance (find-class 'make-load-form-class-04))))
,@(loop for slot-name in '(a b c)
when (slot-boundp obj slot-name)
collect `(setf (slot-value ,newobj ',slot-name)
',(slot-value obj slot-name)))
,newobj)))
(deftest make-load-form.13
(let* ((obj (make-instance 'make-load-form-class-04))
(obj2 (eval (make-load-form obj))))
(values
(eqt (class-of obj2) (class-of obj))
(map-slot-boundp* obj2 '(a b c))))
t (nil nil nil))
(deftest make-load-form.14
(let* ((obj (make-instance 'make-load-form-class-04 :a 1 :b '(a b c) :c 'a))
(obj2 (eval (make-load-form obj))))
(values
(eqt (class-of obj2) (class-of obj))
(map-slot-boundp* obj2 '(a b c))
(map-slot-value obj2 '(a b c))))
t
(t t t)
(1 (a b c) a))
(deftest make-load-form.15
(let* ((obj (make-instance 'make-load-form-class-04 :b '(a b c) :c 'a))
(obj2 (eval (make-load-form obj nil))))
(values
(eqt (class-of obj2) (class-of obj))
(map-slot-boundp* obj2 '(a b c))
(map-slot-value obj2 '(b c))))
t
(nil t t)
((a b c) a))
;;; Additional tests will be in the files testing file compilation
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