1
;; Filename : test-misc.scm
2
;; About : unit tests for miscellaneous procedures
4
;; Copyright (C) 2006 YAMAMOTO Kengo <yamaken AT bp.iij4u.or.jp>
5
;; Copyright (c) 2007 SigScheme Project <uim AT freedesktop.org>
7
;; All rights reserved.
9
;; Redistribution and use in source and binary forms, with or without
10
;; modification, are permitted provided that the following conditions
13
;; 1. Redistributions of source code must retain the above copyright
14
;; notice, this list of conditions and the following disclaimer.
15
;; 2. Redistributions in binary form must reproduce the above copyright
16
;; notice, this list of conditions and the following disclaimer in the
17
;; documentation and/or other materials provided with the distribution.
18
;; 3. Neither the name of authors nor the names of its contributors
19
;; may be used to endorse or promote products derived from this software
20
;; without specific prior written permission.
22
;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
23
;; IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
24
;; THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
25
;; PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
26
;; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
27
;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
28
;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
29
;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
30
;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
31
;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
32
;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
34
(load "test/unittest.scm")
39
(assert-eq? (tn) #f (procedure? #f))
40
(assert-eq? (tn) #f (procedure? #t))
41
(assert-eq? (tn) #f (procedure? '()))
42
(if (provided? "sigscheme")
44
(assert-eq? (tn) #f (procedure? (eof)))
45
(assert-eq? (tn) #f (procedure? (undef)))))
46
(assert-eq? (tn) #f (procedure? 0))
47
(assert-eq? (tn) #f (procedure? 1))
48
(assert-eq? (tn) #f (procedure? 3))
49
(assert-eq? (tn) #f (procedure? -1))
50
(assert-eq? (tn) #f (procedure? -3))
51
(assert-eq? (tn) #f (procedure? 'symbol))
52
(assert-eq? (tn) #f (procedure? 'SYMBOL))
53
(assert-eq? (tn) #f (procedure? #\a))
54
(assert-eq? (tn) #f (procedure? #\あ))
55
(assert-eq? (tn) #f (procedure? ""))
56
(assert-eq? (tn) #f (procedure? " "))
57
(assert-eq? (tn) #f (procedure? "a"))
58
(assert-eq? (tn) #f (procedure? "A"))
59
(assert-eq? (tn) #f (procedure? "aBc12!"))
60
(assert-eq? (tn) #f (procedure? "あ"))
61
(assert-eq? (tn) #f (procedure? "あ0イう12!"))
62
(assert-eq? (tn) #t (procedure? car))
63
(assert-eq? (tn) #f (procedure? 'car))
64
(assert-eq? (tn) #t (procedure? +))
65
(assert-eq? (tn) #t (procedure? (lambda () #t)))
66
(assert-eq? (tn) #f (procedure? '(lambda () #t)))
68
;; syntactic keywords should not be appeared as operand
71
;; pure syntactic keyword
72
(assert-error (tn) (lambda () (procedure? else)))
74
(assert-error (tn) (lambda () (procedure? do)))))
76
(call-with-current-continuation
78
(assert-eq? (tn) #t (procedure? k))))
79
(assert-eq? (tn) #t (call-with-current-continuation procedure?))
80
(assert-eq? (tn) #f (procedure? (current-output-port)))
81
(assert-eq? (tn) #f (procedure? '(#t . #t)))
82
(assert-eq? (tn) #f (procedure? (cons #t #t)))
83
(assert-eq? (tn) #f (procedure? '(0 1 2)))
84
(assert-eq? (tn) #f (procedure? (list 0 1 2)))
85
(assert-eq? (tn) #f (procedure? '#()))
86
(assert-eq? (tn) #f (procedure? (vector)))
87
(assert-eq? (tn) #f (procedure? '#(0 1 2)))
88
(assert-eq? (tn) #f (procedure? (vector 0 1 2)))