Commit 367db805 authored by pfdietz's avatar pfdietz
Browse files

Added tests on: structure fields whose names are also special variables, that...

Added tests on: structure fields whose names are also special variables, that default initializers are not executed unless needed, and that the initializers are in the lexical environment in which the defstruct occurs.
parent 0c165507
......@@ -340,3 +340,66 @@
(defstruct-with-tests (struct-test-59 (:include struct-test-58))
"This is struct-test-59" a-59 b-59)
;;; When a field name of a structure is also a special variable,
;;; the constructor must not bind that name.
(defvar *st-60* 100)
(defstruct-with-tests struct-test-60
(a60 *st-60* :type integer)
(*st-60* 0 :type integer)
(b60 *st-60* :type integer))
(deftest structure-60-1
(let ((*st-60* 10))
(let ((s (make-struct-test-60 :*st-60* 200)))
(values (struct-test-60-a60 s)
(struct-test-60-*st-60* s)
(struct-test-60-b60 s))))
10 200 10)
;;; When default initializers of the wrong type are given, they do not
;;; cause an error unless actually invoked
(defstruct struct-test-61
(a nil :type integer)
(b 0 :type symbol))
(deftest structure-61-1
(let ((s (make-struct-test-61 :a 10 :b 'c)))
(values (struct-test-61-a s)
(struct-test-61-b s)))
10 c)
;;; Initializer forms are evaluated only when needed, and are
;;; evaluated in the lexical environment in which they were defined
(eval-when (load eval)
(let ((x nil))
(flet ((%f () x)
(%g (y) (setf x y)))
(defstruct struct-test-62
(a (progn (setf x 'a) nil))
(f #'%f)
(g #'%g)))))
(deftest structure-62-1
(let* ((s (make-struct-test-62 :a 1))
(f (struct-test-62-f s)))
(values
(struct-test-62-a s)
(funcall f)))
1 nil)
(deftest structure-62-2
(let* ((s (make-struct-test-62))
(f (struct-test-62-f s))
(g (struct-test-62-g s)))
(values
(struct-test-62-a s)
(funcall f)
(funcall g nil)
(funcall f)))
nil a nil nil)
......@@ -349,3 +349,67 @@
program-error)
;;; Default constructor w. BOA constructor, and error cases
(defstruct* (sbt-16 (:constructor)
(:constructor sbt-16-con (a b c)))
a b c)
(deftest structure-boa-test-16/1
(sbt-slots 'sbt-16 (make-sbt-16 :a 1 :b 2 :c 3) :a :b :c)
(1 2 3))
(deftest structure-boa-test-16/2
(sbt-slots 'sbt-16 (sbt-16-con 4 5 6) :a :b :c)
(4 5 6))
(deftest structure-boa-test-16/3
(classify-error (make-sbt-16 :d 1))
program-error)
(deftest structure-boa-test-16/4
(classify-error (make-sbt-16 :a))
program-error)
(deftest structure-boa-test-16/5
(classify-error (make-sbt-16 'a))
program-error)
(deftest structure-boa-test-16/6
(classify-error (make-sbt-16 1 1))
program-error)
(deftest structure-boa-test-16/7
(sbt-slots 'sbt-16 (make-sbt-16 :a 1 :b 2 :c 3 :d 5 :allow-other-keys t)
:a :b :c)
(1 2 3))
(deftest structure-boa-test-16/8
(sbt-slots 'sbt-16 (make-sbt-16 :allow-other-keys t :a 1 :b 2 :c 3 :d 5)
:a :b :c)
(1 2 3))
;;; :allow-other-keys turns off keyword error checking, including
;;; invalid (nonsymbol) keyword arguments
(deftest structure-boa-test-16/9
(sbt-slots 'sbt-16 (make-sbt-16 :allow-other-keys t :a 3 :b 6 :c 9 1000 1000)
:a :b :c)
(3 6 9))
;;; Repeated keyword arguments are allowed; the leftmost one is used
(deftest structure-boa-test-16/10
(sbt-slots 'sbt-16 (make-sbt-16 :a 1 :a 2 :b 3 :b 4 :c 5 :c 6) :a :b :c)
(1 3 5))
(deftest structure-boa-test-16/11
(sbt-slots 'sbt-16 (make-sbt-16 :allow-other-keys t
:allow-other-keys nil
:a 1 :b 2 :c 3 :d 5)
:a :b :c)
(1 2 3))
;; Checking of # of keywords is suppressed when :allow-other-keys is true
(deftest structure-boa-test-16/12
(sbt-slots 'sbt-16 (make-sbt-16 :allow-other-keys t :a 3 :b 6 :c 9 :a)
:a :b :c)
(3 6 9))
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