diff options
Diffstat (limited to 'test-suite/tests/hooks.test')
-rw-r--r-- | test-suite/tests/hooks.test | 127 |
1 files changed, 127 insertions, 0 deletions
diff --git a/test-suite/tests/hooks.test b/test-suite/tests/hooks.test new file mode 100644 index 000000000..e6beb491e --- /dev/null +++ b/test-suite/tests/hooks.test @@ -0,0 +1,127 @@ +;;;; hooks.test --- tests guile's hooks implementation -*- scheme -*- +;;;; Copyright (C) 1999, 2001, 2006, 2009, 2010 Free Software Foundation, Inc. +;;;; +;;;; This library 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 library 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 library; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +(define-module (test-suite test-hooks) + #:use-module (test-suite lib)) + +;;; +;;; miscellaneous +;;; + +;; FIXME: Maybe a standard wrong-num-arg exception should be thrown instead +;; of a misc-error? If so, the tests should be changed to expect failure. +(define exception:wrong-num-hook-args + (cons 'misc-error "Hook .* requires .* arguments")) + +;;; +;;; {The tests} +;;; + +(let ((proc1 (lambda (x) (+ x 1))) + (proc2 (lambda (x) (- x 1))) + (bad-proc (lambda (x y) #t))) + (with-test-prefix "hooks" + (pass-if "make-hook" + (make-hook 1) + #t) + + (pass-if "add-hook!" + (let ((x (make-hook 1))) + (add-hook! x proc1) + (add-hook! x proc2) + #t)) + + (with-test-prefix "add-hook!" + (pass-if "append" + (let ((x (make-hook 1))) + (add-hook! x proc1) + (add-hook! x proc2 #t) + (eq? (cadr (hook->list x)) + proc2))) + (pass-if-exception "illegal proc" + exception:wrong-type-arg + (let ((x (make-hook 1))) + (add-hook! x bad-proc))) + (pass-if-exception "illegal hook" + exception:wrong-type-arg + (add-hook! '(foo) proc1))) + (pass-if "run-hook" + (let ((x (make-hook 1))) + (add-hook! x proc1) + (add-hook! x proc2) + (run-hook x 1) + #t)) + (with-test-prefix "run-hook" + (pass-if-exception "bad hook" + exception:wrong-type-arg + (let ((x (cons 'a 'b))) + (run-hook x 1))) + (pass-if-exception "too many args" + exception:wrong-num-hook-args + (let ((x (make-hook 1))) + (add-hook! x proc1) + (add-hook! x proc2) + (run-hook x 1 2))) + + (pass-if + "destructive procs" + (let ((x (make-hook 1)) + (dest-proc1 (lambda (x) + (set-car! x + 'i-sunk-your-battleship))) + (dest-proc2 (lambda (x) (set-cdr! x 'no-way!))) + (val '(a-game-of battleship))) + (add-hook! x dest-proc1) + (add-hook! x dest-proc2 #t) + (run-hook x val) + (and (eq? (car val) 'i-sunk-your-battleship) + (eq? (cdr val) 'no-way!))))) + + (with-test-prefix "remove-hook!" + (pass-if "" + (let ((x (make-hook 1))) + (add-hook! x proc1) + (add-hook! x proc2) + (remove-hook! x proc1) + (not (memq proc1 (hook->list x))))) + ; Maybe it should error, but this is probably + ; more convienient + (pass-if "empty hook" + (let ((x (make-hook 1))) + (remove-hook! x proc1) + #t))) + (pass-if "hook->list" + (let ((x (make-hook 1))) + (add-hook! x proc1) + (add-hook! x proc2) + (and (memq proc1 (hook->list x)) + (memq proc2 (hook->list x)) + #t))) + (pass-if "reset-hook!" + (let ((x (make-hook 1))) + (add-hook! x proc1) + (add-hook! x proc2) + (reset-hook! x) + (null? (hook->list x)))) + (with-test-prefix "reset-hook!" + (pass-if "empty hook" + (let ((x (make-hook 1))) + (reset-hook! x) + #t)) + (pass-if-exception "bad hook" + exception:wrong-type-arg + (reset-hook! '(a b)))))) |