1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
|
;;; object-external.lisp ---
;;
;; Copyright (C) 2010, 2011, 2012 Jan Moringen
;;
;; Author: Jan Moringen <jmoringe@techfak.uni-bielefeld.de>
;;
;; This Program is free software: you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public License
;; as published by the Free Software Foundation, either version 3 of
;; the License, or (at your option) any later version.
;;
;; This Program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Lesser General Public License for more details.
;;
;; You should have received a copy of the GNU Lesser General Public
;; License along with this program. If not, see
;; <http://www.gnu.org/licenses>.
(cl:in-package :hooks.test)
(deftestsuite object-external (object-hook-test
hook-suite)
()
(:documentation
"Tests for object-external hooks."))
(addtest (object-external
:documentation
"Ensure that retrieving a hook object twice yields `eq'
results.")
retrieval-stability
(ensure-same
(external-hook object 'my-hook)
(external-hook object 'my-hook)
:test #'eq
:ignore-multiple-values? t
:report "~@<Retrieving hook ~S twice should yield `eq' results, but ~
did not.~@:>"
:arguments ((external-hook object 'my-hook))))
(addtest (object-external
:documentation
"Test readers of object external hooks")
readers
(exercise-hook-readers (external-hook object 'my-hook)))
(addtest (object-external
:documentation
"Test adding handlers to object external hooks.")
add-to-hook
(let ((hook (external-hook object 'my-hook))
(handler #'(lambda ())))
(multiple-value-bind (added-handler present?)
(add-to-hook hook handler)
(ensure-same added-handler handler)
(ensure-same (length (hook-handlers hook)) 1)
(ensure (not present?)
:report "~@<When adding a handler for the first time, the ~
present? return value should be nil.~@:>"))
(multiple-value-bind (added-handler present?)
(add-to-hook hook handler)
(ensure-same added-handler handler)
(ensure-same (length (hook-handlers hook)) 1)
(ensure present?
:report "~@<When adding a handler twice with :replace ~
policy, the present? return value should be non-nil.~@:>"))
(ensure-condition duplicate-handler
(add-to-hook hook handler
:duplicate-policy :error))))
(addtest (object-external
:documentation
"Test clearing object external hooks.")
clear-hook
(let ((hook (external-hook object 'my-hook)))
(add-to-hook hook (lambda ()))
(add-to-hook hook (lambda ()))
(clear-hook hook)
(ensure-same (hook-handlers hook) nil
:report "~@<Found remaining handlers after clearing the
hook.~@:>")))
|