Commit 9633db44 authored by pfdietz's avatar pfdietz
Browse files

Tests for WITH-ACCESSORS.

parent 77b60684
......@@ -28,3 +28,4 @@
(load "make-instances-obsolete.lsp")
(load "make-load-form.lsp")
(load "make-load-form-saving-slots.lsp")
(load "with-accessors.lsp")
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat May 17 17:07:29 2003
;;;; Contains: Tests of WITH-ACCESSORS
(in-package :cl-test)
(deftest with-accessors.1
(with-accessors () nil)
nil)
(deftest with-accessors.2
(with-accessors () nil (values)))
(deftest with-accessors.3
(with-accessors () nil (values 'a 'b 'c 'd 'e 'f))
a b c d e f)
(deftest with-accessors.4
(let (x y z)
(with-accessors () (setf x 1) (setf y 5) (setf z 12) (values x y z)))
1 5 12)
;; with-accessors defines an implicit progn, not a tagbody
(deftest with-accessors.5
(block done
(tagbody
(with-accessors
nil nil
(go 10)
10
(return-from done :bad))
10
(return-from done :good)))
:good)
(defclass with-accessors-class-01 ()
((a :initarg :a :accessor wa-a)
(b :initarg :b :accessor wa-b)
(c :initarg :c :accessor wa-c)))
(deftest with-accessors.6
(let ((obj (make-instance 'with-accessors-class-01 :a 'x :b 'y :c 'z)))
(with-accessors
((a wa-a) (b wa-b) (c wa-c))
obj
(values a b c)))
x y z)
(deftest with-accessors.7
(let ((obj (make-instance 'with-accessors-class-01)))
(with-accessors
((a wa-a) (b wa-b) (c wa-c))
obj
(values (setf a 'x) (setf b 'y) (setf c 'z)
(map-slot-value obj '(a b c)))))
x y z (x y z))
(deftest with-accessors.8
(let ((obj (make-instance 'with-accessors-class-01)))
(with-accessors
((a wa-a) (b wa-b) (c wa-c))
obj
(values (setq a 'x) (setq b 'y) (setq c 'z)
(map-slot-value obj '(a b c)))))
x y z (x y z))
(deftest with-accessors.9
(let ((obj (make-instance 'with-accessors-class-01 :a 5 :b 19 :c 312)))
(with-accessors
((a wa-a) (b wa-b) (c wa-c))
obj
(values (incf a 4) (incf b 412) (incf c 75)
(map-slot-value obj '(a b c)))))
9 431 387 (9 431 387))
(deftest with-accessors.10
(let ((obj (make-instance 'with-accessors-class-01 :a 5 :b 19 :c 312)))
(with-accessors
((a wa-a) (b wa-b) (c wa-c))
obj
(declare (optimize (speed 3) (safety 3)))
(values a b c)))
5 19 312)
(deftest with-accessors.11
(let ((obj (make-instance 'with-accessors-class-01 :a 5 :b 19 :c 312)))
(with-accessors
((a wa-a) (b wa-b) (c wa-c))
obj
(declare (optimize (speed 3) (safety 3)))
(declare (special *x*)) ;; not used
(values a b c)))
5 19 312)
;;; with-accessors on structure accessors
(defstruct (with-accessors-struct-02 (:conc-name "WA-2-")) a b c)
(deftest with-accessors.12
(let ((obj (make-with-accessors-struct-02 :a 'x :b 'y :c 'z)))
(with-accessors ((a wa-2-a) (b wa-2-b) (c wa-2-c))
obj
(values a b c)))
x y z)
(deftest with-accessors.13
(let ((obj (make-with-accessors-struct-02)))
(with-accessors
((a wa-2-a) (b wa-2-b) (c wa-2-c))
obj
(values (setf a 'x) (setf b 'y) (setf c 'z)
(wa-2-a obj) (wa-2-b obj) (wa-2-c obj))))
x y z x y z)
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