← Back to branch summary

~ubuntu-branches/ubuntu/maverick/uim/maverick

« back to all changes in this revision

Viewing changes to sigscheme/test/test-eqv.scm

  • Committer: Bazaar Package Importer
  • Author(s): Masahito Omote
  • Date: 2008-06-25 19:56:33 UTC
  • mfrom: (3.1.18 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080625195633-8jljph4rfq00l8o7
Tags: 1:1.5.1-2
http://bugs.debian.org/482659
http://bugs.debian.org/483078
* uim-tcode: provide tutcode-custom.scm, tutcode-bushudic.scm
  and tutcode-rule.scm (Closes: #482659)
* Fix FTBFS: segv during compile (Closes: #483078).
  I personally think this bug is not specific for uim but is a optimization
  problem on gcc-4.3.1. (https://bugs.freedesktop.org/show_bug.cgi?id=16477)

Show diffs side-by-side

added added

removed removed

Lines of Context:
sigscheme/test/test-eqv.scm
 
1
#! /usr/bin/env sscm -C UTF-8
 
2
;; -*- buffer-file-coding-system: utf-8 -*-
 
3
 
 
4
;;  Filename : test-eqv.scm
 
5
;;  About    : unit tests for eqv?
 
6
;;
 
7
;;  Copyright (C) 2006 YAMAMOTO Kengo <yamaken AT bp.iij4u.or.jp>
 
8
;;  Copyright (c) 2007-2008 SigScheme Project <uim-en AT googlegroups.com>
 
9
;;
 
10
;;  All rights reserved.
 
11
;;
 
12
;;  Redistribution and use in source and binary forms, with or without
 
13
;;  modification, are permitted provided that the following conditions
 
14
;;  are met:
 
15
;;
 
16
;;  1. Redistributions of source code must retain the above copyright
 
17
;;     notice, this list of conditions and the following disclaimer.
 
18
;;  2. Redistributions in binary form must reproduce the above copyright
 
19
;;     notice, this list of conditions and the following disclaimer in the
 
20
;;     documentation and/or other materials provided with the distribution.
 
21
;;  3. Neither the name of authors nor the names of its contributors
 
22
;;     may be used to endorse or promote products derived from this software
 
23
;;     without specific prior written permission.
 
24
;;
 
25
;;  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
 
26
;;  IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
 
27
;;  THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
 
28
;;  PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
 
29
;;  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
 
30
;;  EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
 
31
;;  PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
 
32
;;  PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
 
33
;;  LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
 
34
;;  NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
 
35
;;  SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
36
 
 
37
(require-extension (unittest))
 
38
 
 
39
(define tn test-name)
 
40
(define case-insensitive-symbol? #f)
 
41
 
 
42
(tn "eqv? invalid form")
 
43
(assert-error  (tn) (lambda () (eqv?)))
 
44
(assert-error  (tn) (lambda () (eqv? #f)))
 
45
(assert-error  (tn) (lambda () (eqv? #f #f #f)))
 
46
 
 
47
(tn "eqv? different types")
 
48
(assert-eq? (tn) #f (eqv? 1 #\1))
 
49
(assert-eq? (tn) #f (eqv? #\1 "1"))
 
50
(assert-eq? (tn) #f (eqv? #\1 '("1")))
 
51
(assert-eq? (tn) #f (eqv? '#("1") '("1")))
 
52
 
 
53
(tn "eqv? boolean")
 
54
(assert-eq? (tn) #t (eqv? #f #f))
 
55
(assert-eq? (tn) #f (eqv? #f #t))
 
56
(assert-eq? (tn) #f (eqv? #t #f))
 
57
(assert-eq? (tn) #t (eqv? #t #t))
 
58
 
 
59
(tn "eqv? null")
 
60
(assert-eq? (tn) #t (eqv? '() '()))
 
61
(if (and (provided? "sigscheme")
 
62
         (provided? "siod-bugs"))
 
63
    (begin
 
64
      (assert-eq? (tn) #t (eqv? #f '()))
 
65
      (assert-eq? (tn) #t (eqv? '() #f)))
 
66
    (begin
 
67
      (assert-eq? (tn) #f (eqv? #f '()))
 
68
      (assert-eq? (tn) #f (eqv? '() #f))))
 
69
(if (symbol-bound? 'vector?)
 
70
    (begin
 
71
      (assert-eq? (tn) #f (eqv? '() '#()))
 
72
      (assert-eq? (tn) #f (eqv? '#() '()))))
 
73
 
 
74
(tn "eqv? #<eof>")
 
75
(if (provided? "sigscheme")
 
76
    (begin
 
77
      (assert-eq? (tn) #t (eqv? (eof) (eof)))
 
78
      (assert-eq? (tn) #f (eqv? (eof) (undef)))
 
79
      (assert-eq? (tn) #f (eqv? (undef) (eof)))
 
80
      (assert-eq? (tn) #f (eqv? '() (eof)))
 
81
      (assert-eq? (tn) #f (eqv? (eof) '()))
 
82
      (assert-eq? (tn) #f (eqv? #f (eof)))
 
83
      (assert-eq? (tn) #f (eqv? (eof) #f))))
 
84
 
 
85
(tn "eqv? #<undef>")
 
86
(if (provided? "sigscheme")
 
87
    (begin
 
88
      (assert-eq? (tn) #t (eqv? (undef) (undef)))
 
89
      (assert-eq? (tn) #f (eqv? (eof) (undef)))
 
90
      (assert-eq? (tn) #f (eqv? (undef) (eof)))
 
91
      (assert-eq? (tn) #f (eqv? '() (undef)))
 
92
      (assert-eq? (tn) #f (eqv? (undef) '()))
 
93
      (assert-eq? (tn) #f (eqv? #f (undef)))
 
94
      (assert-eq? (tn) #f (eqv? (undef) #f))))
 
95
 
 
96
(tn "eqv? integer")
 
97
(assert-eq? (tn) #t (eqv? 0 0))
 
98
(assert-eq? (tn) #t (eqv? 1 1))
 
99
(assert-eq? (tn) #t (eqv? 3 3))
 
100
(assert-eq? (tn) #t (eqv? -1 -1))
 
101
(assert-eq? (tn) #t (eqv? -3 -3))
 
102
 
 
103
(assert-eq? (tn) #f (eqv? 0 1))
 
104
(assert-eq? (tn) #f (eqv? 1 0))
 
105
(assert-eq? (tn) #f (eqv? 1 3))
 
106
(assert-eq? (tn) #f (eqv? 3 1))
 
107
(assert-eq? (tn) #f (eqv? -1 1))
 
108
(assert-eq? (tn) #f (eqv? 1 -1))
 
109
(assert-eq? (tn) #f (eqv? -3 3))
 
110
(assert-eq? (tn) #f (eqv? 3 -3))
 
111
(assert-eq? (tn) #f (eqv? -1 -3))
 
112
(assert-eq? (tn) #f (eqv? -3 -1))
 
113
 
 
114
(tn "eqv? symbol")
 
115
(assert-eq? (tn) #t (eqv? 'symbol 'symbol))
 
116
(assert-eq? (tn) #f (eqv? 'symbol1 'symbol2))
 
117
(if (and (provided? "sigscheme")
 
118
         (provided? "strict-r5rs")
 
119
         case-insensitive-symbol?)
 
120
    (begin
 
121
      (assert-eq? (tn) #t (eqv? 'symbol 'SYMBOL))
 
122
      (assert-eq? (tn) #t (eqv? 'SYMBOL 'symbol))
 
123
      (assert-eq? (tn) #t (eqv? 'symbol 'Symbol))
 
124
      (assert-eq? (tn) #t (eqv? 'Symbol 'symbol))
 
125
      (assert-eq? (tn) #t (eqv? 'symbol 'syMBoL))
 
126
      (assert-eq? (tn) #t (eqv? 'syMBoL 'symbol)))
 
127
    (begin
 
128
      (assert-eq? (tn) #f (eqv? 'symbol 'SYMBOL))
 
129
      (assert-eq? (tn) #f (eqv? 'SYMBOL 'symbol))
 
130
      (assert-eq? (tn) #f (eqv? 'symbol 'Symbol))
 
131
      (assert-eq? (tn) #f (eqv? 'Symbol 'symbol))
 
132
      (assert-eq? (tn) #f (eqv? 'symbol 'syMBoL))
 
133
      (assert-eq? (tn) #f (eqv? 'syMBoL 'symbol))))
 
134
 
 
135
(tn "eqv? singlebyte char")
 
136
(assert-eq? (tn) #t (eqv? #\a #\a))
 
137
(assert-eq? (tn) #f (eqv? #\a #\b))
 
138
(assert-eq? (tn) #f (eqv? #\b #\a))
 
139
(assert-eq? (tn) #t (eqv? #\b #\b))
 
140
 
 
141
(let ((c1 #\a)
 
142
      (c2 #\b))
 
143
  (assert-eq? (tn) #t (eqv? c1 c1))
 
144
  (assert-eq? (tn) #t (eqv? c2 c2)))
 
145
 
 
146
(tn "eqv? multibyte char")
 
147
(assert-eq? (tn) #t (eqv? #\あ #\あ))
 
148
(assert-eq? (tn) #f (eqv? #\あ #\い))
 
149
(assert-eq? (tn) #f (eqv? #\い #\あ))
 
150
(assert-eq? (tn) #t (eqv? #\い #\い))
 
151
 
 
152
(let ((c1 #\あ)
 
153
      (c2 #\い))
 
154
  (assert-eq? (tn) #t (eqv? c1 c1))
 
155
  (assert-eq? (tn) #t (eqv? c2 c2)))
 
156
 
 
157
(tn "eqv? singlebyte string")
 
158
(if (provided? "sigscheme")
 
159
    (begin
 
160
      (assert-eq? (tn) #f (eqv? "" ""))
 
161
      (assert-eq? (tn) #f (eqv? "a" "a"))
 
162
      (assert-eq? (tn) #f (eqv? "b" "b"))
 
163
      (assert-eq? (tn) #f (eqv? "aBc12!" "aBc12!"))))
 
164
(let ((s1 "")
 
165
      (s2 "a")
 
166
      (s3 "b")
 
167
      (s4 "aBc12!"))
 
168
  (assert-eq? (tn) #t (eqv? s1 s1))
 
169
  (assert-eq? (tn) #t (eqv? s2 s2))
 
170
  (assert-eq? (tn) #t (eqv? s3 s3))
 
171
  (assert-eq? (tn) #t (eqv? s4 s4)))
 
172
(assert-eq? (tn) #f (eqv? "" "a"))
 
173
(assert-eq? (tn) #f (eqv? "a" ""))
 
174
(assert-eq? (tn) #f (eqv? "a" "b"))
 
175
(assert-eq? (tn) #f (eqv? "b" "a"))
 
176
(assert-eq? (tn) #f (eqv? "a" "A"))
 
177
(assert-eq? (tn) #f (eqv? "A" "a"))
 
178
(assert-eq? (tn) #f (eqv? "aBc123!" "aBc12!"))
 
179
(assert-eq? (tn) #f (eqv? "aBc12!" "aBc123!"))
 
180
 
 
181
(tn "eqv? multibyte string")
 
182
(if (provided? "sigscheme")
 
183
    (begin
 
184
      (assert-eq? (tn) #f (eqv? "あ" "あ"))
 
185
      (assert-eq? (tn) #f (eqv? "い" "い"))
 
186
      (assert-eq? (tn) #f (eqv? "あ0イう12!" "あ0イう12!"))))
 
187
(let ((s1 "あ")
 
188
      (s2 "い")
 
189
      (s3 "あ0イう12!"))
 
190
  (assert-eq? (tn) #t (eqv? s1 s1))
 
191
  (assert-eq? (tn) #t (eqv? s2 s2))
 
192
  (assert-eq? (tn) #t (eqv? s3 s3)))
 
193
(assert-eq? (tn) #f (eqv? "" "あ"))
 
194
(assert-eq? (tn) #f (eqv? "あ" ""))
 
195
(assert-eq? (tn) #f (eqv? "あ" "い"))
 
196
(assert-eq? (tn) #f (eqv? "い" "あ"))
 
197
(assert-eq? (tn) #f (eqv? "あ" "ア"))
 
198
(assert-eq? (tn) #f (eqv? "ア" "あ"))
 
199
(assert-eq? (tn) #f (eqv? "あ0イうぇ12!" "あ0イう12!"))
 
200
(assert-eq? (tn) #f (eqv? "あ0イう12!" "あ0イうぇ12!"))
 
201
 
 
202
(tn "eqv? procedure")
 
203
(assert-eq? (tn) #t (eqv? + +))
 
204
(assert-eq? (tn) #f (eqv? + -))
 
205
(assert-eq? (tn) #f (eqv? - +))
 
206
(assert-eq? (tn) #t (eqv? - -))
 
207
(let ((plus +))
 
208
  (assert-eq? (tn) #t (eqv? + plus))
 
209
  (assert-eq? (tn) #t (eqv? plus +))
 
210
  (assert-eq? (tn) #t (eqv? plus plus)))
 
211
 
 
212
(tn "eqv? syntax")
 
213
(assert-error (tn) (lambda () (eqv? if if)))
 
214
(assert-error (tn) (lambda () (eqv? if set!)))
 
215
(assert-error (tn) (lambda () (eqv? set! if)))
 
216
(assert-error (tn) (lambda () (eqv? set! set!)))
 
217
;; (define syntax if) is an invalid form
 
218
 
 
219
(tn "eqv? macro")
 
220
(if (symbol-bound? 'let-syntax)
 
221
    (let-syntax ((macro1 (syntax-rules ()
 
222
                           ((_) 'macro1-expanded)))
 
223
                 (macro2 (syntax-rules ()
 
224
                           ((_) 'macro2-expanded))))
 
225
      ;; syntactic keyword as value
 
226
      (assert-error (tn) (lambda () (eqv? macro1 macro1)))
 
227
      (assert-error (tn) (lambda () (eqv? macro2 macro1)))
 
228
      (assert-error (tn) (lambda () (eqv? macro1 macro2)))
 
229
      (assert-error (tn) (lambda () (eqv? macro2 macro2)))))
 
230
 
 
231
(tn "eqv? closure")
 
232
(let ((closure (lambda () #t)))
 
233
  (assert-eq? (tn) #t (eqv? closure closure))
 
234
  (if (provided? "sigscheme")
 
235
      (begin
 
236
        (assert-eq? (tn) #f (eqv? closure (lambda () #t)))
 
237
        (assert-eq? (tn) #f (eqv? (lambda () #t) closure))
 
238
        (assert-eq? (tn) #f (eqv? (lambda () #t) (lambda () #t))))))
 
239
 
 
240
(tn "eqv? stateful closure")
 
241
(let ((stateful (lambda ()
 
242
                  (let ((state 0))
 
243
                    (lambda ()
 
244
                      (set! state (+ state 1))
 
245
                      state)))))
 
246
  (assert-eq? (tn) #t (eqv? stateful stateful))
 
247
  (assert-eq? (tn) #f (eqv? (stateful) (stateful))))
 
248
 
 
249
(let ((may-be-optimized-out (lambda ()
 
250
                              (let ((state 0))
 
251
                                (lambda ()
 
252
                                  (set! state (+ state 1))
 
253
                                  0)))))
 
254
  (assert-eq? (tn) #t (eqv? may-be-optimized-out may-be-optimized-out))
 
255
  (if (provided? "sigscheme")
 
256
      (assert-eq? (tn) #f (eqv? (may-be-optimized-out) (may-be-optimized-out)))))
 
257
 
 
258
(letrec ((may-be-unified1 (lambda ()
 
259
                            (if (eqv? may-be-unified1
 
260
                                      may-be-unified2)
 
261
                                'optimized-out
 
262
                                'not-unified1)))
 
263
         (may-be-unified2 (lambda ()
 
264
                            (if (eqv? may-be-unified1
 
265
                                      may-be-unified2)
 
266
                                'optimized-out
 
267
                                'not-unified2))))
 
268
  (if (provided? "sigscheme")
 
269
      (begin
 
270
        (assert-eq? (tn) #f (eqv? may-be-unified1 may-be-unified2))
 
271
        (assert-eq? (tn) #f (eqv? (may-be-unified1) (may-be-unified2))))
 
272
      (begin
 
273
        ;; other implementations may pass this
 
274
        ;;(assert-eq? (tn) #t (eqv? may-be-unified1 may-be-unified2))
 
275
        ;;(assert-eq? (tn) #t (eqv? (may-be-unified1) (may-be-unified2)))
 
276
        )))
 
277
 
 
278
(tn "eqv? continuation")
 
279
(call-with-current-continuation
 
280
 (lambda (k1)
 
281
   (call-with-current-continuation
 
282
    (lambda (k2)
 
283
      (assert-eq? (tn) #t (eqv? k1 k1))
 
284
      (assert-eq? (tn) #f (eqv? k1 k2))
 
285
      (assert-eq? (tn) #f (eqv? k2 k1))
 
286
      (assert-eq? (tn) #t (eqv? k2 k2))
 
287
      (let ((cont k1))
 
288
        (assert-eq? (tn) #t (eqv? cont cont))
 
289
        (assert-eq? (tn) #t (eqv? cont k1))
 
290
        (assert-eq? (tn) #t (eqv? k1 cont))
 
291
        (assert-eq? (tn) #f (eqv? cont k2))
 
292
        (assert-eq? (tn) #f (eqv? k2 cont)))))))
 
293
 
 
294
(tn "eqv? port")
 
295
(assert-eq? (tn) #t (eqv? (current-output-port) (current-output-port)))
 
296
(assert-eq? (tn) #f (eqv? (current-input-port) (current-output-port)))
 
297
(assert-eq? (tn) #f (eqv? (current-output-port) (current-input-port)))
 
298
(assert-eq? (tn) #t (eqv? (current-input-port) (current-input-port)))
 
299
(let ((port (current-input-port)))
 
300
  (assert-eq? (tn) #t (eqv? port port))
 
301
  (assert-eq? (tn) #t (eqv? (current-input-port) port))
 
302
  (assert-eq? (tn) #t (eqv? port (current-input-port)))
 
303
  (assert-eq? (tn) #f (eqv? (current-output-port) port))
 
304
  (assert-eq? (tn) #f (eqv? port (current-output-port))))
 
305
 
 
306
(tn "eqv? pair")
 
307
(if (provided? "sigscheme")
 
308
    (begin
 
309
      (assert-eq? (tn) #f (eqv? '(#t . #t) '(#t . #t)))
 
310
      (assert-eq? (tn) #f (eqv? '(#f . #t) '(#f . #t)))
 
311
      (assert-eq? (tn) #f (eqv? '(#t . #f) '(#t . #f)))
 
312
      (assert-eq? (tn) #f (eqv? '(#f . #t) '(#t . #f)))
 
313
      (assert-eq? (tn) #f (eqv? '(#\a . #\a) '(#\a . #\a)))
 
314
      (assert-eq? (tn) #f (eqv? '(#\a . #\b) '(#\a . #\b)))
 
315
      (assert-eq? (tn) #f (eqv? '(#\b . #\a) '(#\b . #\a)))
 
316
      (assert-eq? (tn) #f (eqv? '(#\a . #\b) '(#\b . #\a)))
 
317
      (assert-eq? (tn) #f (eqv? '("a" . "a") '("a" . "a")))
 
318
      (assert-eq? (tn) #f (eqv? '("a" . "b") '("a" . "b")))
 
319
      (assert-eq? (tn) #f (eqv? '("b" . "a") '("b" . "a")))
 
320
      (assert-eq? (tn) #f (eqv? '("a" . "b") '("b" . "a")))))
 
321
 
 
322
(assert-eq? (tn) #f (eqv? (cons #t #t) (cons #t #t)))
 
323
(assert-eq? (tn) #f (eqv? (cons #f #t) (cons #f #t)))
 
324
(assert-eq? (tn) #f (eqv? (cons #t #f) (cons #t #f)))
 
325
(assert-eq? (tn) #f (eqv? (cons #f #t) (cons #t #f)))
 
326
(assert-eq? (tn) #f (eqv? (cons #\a #\a) (cons #\a #\a)))
 
327
(assert-eq? (tn) #f (eqv? (cons #\a #\b) (cons #\a #\b)))
 
328
(assert-eq? (tn) #f (eqv? (cons #\b #\a) (cons #\b #\a)))
 
329
(assert-eq? (tn) #f (eqv? (cons #\a #\b) (cons #\b #\a)))
 
330
(assert-eq? (tn) #f (eqv? (cons "a" "a") (cons "a" "a")))
 
331
(assert-eq? (tn) #f (eqv? (cons "a" "b") (cons "a" "b")))
 
332
(assert-eq? (tn) #f (eqv? (cons "b" "a") (cons "b" "a")))
 
333
(assert-eq? (tn) #f (eqv? (cons "a" "b") (cons "b" "a")))
 
334
 
 
335
(tn "eqv? list")
 
336
(if (provided? "sigscheme")
 
337
    (begin
 
338
      (assert-eq? (tn) #f (eqv? '(#f) '(#f)))
 
339
      (assert-eq? (tn) #f (eqv? '(#f) '(#t)))
 
340
      (assert-eq? (tn) #f (eqv? '(#t) '(#f)))
 
341
      (assert-eq? (tn) #f (eqv? '(#t) '(#t)))
 
342
      (assert-eq? (tn) #f (eqv? '((#f)) '((#f))))
 
343
      (assert-eq? (tn) #f (eqv? '((#f)) '((#t))))
 
344
      (assert-eq? (tn) #f (eqv? '((#t)) '((#f))))
 
345
      (assert-eq? (tn) #f (eqv? '((#t)) '((#t))))
 
346
      (assert-eq? (tn) #f (eqv? '(1) '(1)))
 
347
      (assert-eq? (tn) #f (eqv? '(1) '(0)))
 
348
      (assert-eq? (tn) #f (eqv? '(1 3 5 0 13)
 
349
                                '(1 3 5 0 13)))
 
350
      (assert-eq? (tn) #f (eqv? '(1 3 2 0 13)
 
351
                                '(1 3 5 0 13)))
 
352
      (assert-eq? (tn) #f (eqv? '(1 3 (5 0 13))
 
353
                                '(1 3 (5 0 13))))
 
354
      (assert-eq? (tn) #f (eqv? '(1 3 (2 0 13))
 
355
                                '(1 3 (5 0 13))))
 
356
      (assert-eq? (tn) #f (eqv? '((1)) '((1))))
 
357
      (assert-eq? (tn) #f (eqv? '((1)) '((0))))
 
358
      (assert-eq? (tn) #f (eqv? '((1) (3) (5) (0) (13))
 
359
                                '((1) (3) (5) (0) (13))))
 
360
      (assert-eq? (tn) #f (eqv? '((1) (3) (2) (0) (13))
 
361
                                '((1) (3) (5) (0) (13))))
 
362
      (assert-eq? (tn) #f (eqv? '(#\a) '(#\a)))
 
363
      (assert-eq? (tn) #f (eqv? '(#\a) '(#\b)))
 
364
      (assert-eq? (tn) #f (eqv? '(#\b) '(#\a)))
 
365
      (assert-eq? (tn) #f (eqv? '((#\a)) '((#\a))))
 
366
      (assert-eq? (tn) #f (eqv? '((#\a)) '((#\b))))
 
367
      (assert-eq? (tn) #f (eqv? '((#\b)) '((#\a))))))
 
368
 
 
369
(assert-eq? (tn) #f (eqv? (list #f) (list #f)))
 
370
(assert-eq? (tn) #f (eqv? (list #f) (list #t)))
 
371
(assert-eq? (tn) #f (eqv? (list #t) (list #f)))
 
372
(assert-eq? (tn) #f (eqv? (list #t) (list #t)))
 
373
(assert-eq? (tn) #f (eqv? (list (list #f)) (list (list #f))))
 
374
(assert-eq? (tn) #f (eqv? (list (list #f)) (list (list #t))))
 
375
(assert-eq? (tn) #f (eqv? (list (list #t)) (list (list #f))))
 
376
(assert-eq? (tn) #f (eqv? (list (list #t)) (list (list #t))))
 
377
(assert-eq? (tn) #f (eqv? (list 1) (list 1)))
 
378
(assert-eq? (tn) #f (eqv? (list 1) (list 0)))
 
379
(assert-eq? (tn) #f (eqv? (list 1 3 5 0 13)
 
380
                          (list 1 3 5 0 13)))
 
381
(assert-eq? (tn) #f (eqv? (list 1 3 2 0 13)
 
382
                          (list 1 3 5 0 13)))
 
383
(assert-eq? (tn) #f (eqv? (list 1 3 (list 5 0 13))
 
384
                          (list 1 3 (list 5 0 13))))
 
385
(assert-eq? (tn) #f (eqv? (list 1 3 (list 2 0 13))
 
386
                          (list 1 3 (list 5 0 13))))
 
387
(assert-eq? (tn) #f (eqv? (list (list 1)) (list (list 1))))
 
388
(assert-eq? (tn) #f (eqv? (list (list 1)) (list (list 0))))
 
389
(assert-eq? (tn) #f (eqv? (list (list 1) (list 3) (list 5) (list 0) (list 13))
 
390
                          (list (list 1) (list 3) (list 5) (list 0) (list 13))))
 
391
(assert-eq? (tn) #f (eqv? (list (list 1) (list 3) (list 2) (list 0) (list 13))
 
392
                          (list (list 1) (list 3) (list 5) (list 0) (list 13))))
 
393
(assert-eq? (tn) #f (eqv? (list #\a) (list #\a)))
 
394
(assert-eq? (tn) #f (eqv? (list #\a) (list #\b)))
 
395
(assert-eq? (tn) #f (eqv? (list #\b) (list #\a)))
 
396
(assert-eq? (tn) #f (eqv? (list (list #\a)) (list (list #\a))))
 
397
(assert-eq? (tn) #f (eqv? (list (list #\a)) (list (list #\b))))
 
398
(assert-eq? (tn) #f (eqv? (list (list #\b)) (list (list #\a))))
 
399
 
 
400
(if (provided? "sigscheme")
 
401
    (begin
 
402
      (assert-eq? (tn) #f (eqv? '("") '("")))
 
403
      (assert-eq? (tn) #f (eqv? '(("")) '((""))))
 
404
      (assert-eq? (tn) #f (eqv? '("aBc12!")
 
405
                                '("aBc12!")))
 
406
      (assert-eq? (tn) #f (eqv? '("あ0イう12!")
 
407
                                '("あ0イう12!")))
 
408
      (assert-eq? (tn) #f (eqv? '("a" "" "aB1" ("3c" "d") "a")
 
409
                                '("a" "" "aB1" ("3c" "d") "a")))
 
410
      (assert-eq? (tn) #f (eqv? '(("aBc12!"))
 
411
                                '(("aBc12!"))))
 
412
      (assert-eq? (tn) #f (eqv? '(("あ0イう12!"))
 
413
                                '(("あ0イう12!"))))))
 
414
 
 
415
(assert-eq? (tn) #f (eqv? (list "") (list "")))
 
416
(assert-eq? (tn) #f (eqv? (list (list "")) (list (list ""))))
 
417
(assert-eq? (tn) #f (eqv? (list "aBc12!")
 
418
                          (list "aBc12!")))
 
419
(assert-eq? (tn) #f (eqv? (list "あ0イう12!")
 
420
                          (list "あ0イう12!")))
 
421
(assert-eq? (tn) #f (eqv? (list "a" "" "aB1" (list "3c" "d") "a")
 
422
                          (list "a" "" "aB1" (list "3c" "d") "a")))
 
423
(assert-eq? (tn) #f (eqv? (list (list "aBc12!"))
 
424
                          (list (list "aBc12!"))))
 
425
(assert-eq? (tn) #f (eqv? (list (list "あ0イう12!"))
 
426
                          (list (list "あ0イう12!"))))
 
427
 
 
428
(if (provided? "sigscheme")
 
429
    (begin
 
430
      (assert-eq? (tn) #f (eqv? '("aBc123!")
 
431
                                '("aBc12!")))
 
432
      (assert-eq? (tn) #f (eqv? '("あ0イぅ12!")
 
433
                                '("あ0イう12!")))
 
434
      (assert-eq? (tn) #f (eqv? '("a" "" "aB1" ("3c" "e") "a")
 
435
                                '("a" "" "aB1" ("3c" "d") "a")))
 
436
      (assert-eq? (tn) #f (eqv? '(("aBc123!"))
 
437
                                '(("aBc12!"))))
 
438
      (assert-eq? (tn) #f (eqv? '(("あ0イぅ12!"))
 
439
                                '(("あ0イう12!"))))))
 
440
 
 
441
(assert-eq? (tn) #f (eqv? (list "aBc123!")
 
442
                          (list "aBc12!")))
 
443
(assert-eq? (tn) #f (eqv? (list "あ0イぅ12!")
 
444
                          (list "あ0イう12!")))
 
445
(assert-eq? (tn) #f (eqv? (list "a" "" "aB1" (list "3c" "e") "a")
 
446
                          (list "a" "" "aB1" (list "3c" "d") "a")))
 
447
(assert-eq? (tn) #f (eqv? (list (list "aBc123!"))
 
448
                          (list (list "aBc12!"))))
 
449
(assert-eq? (tn) #f (eqv? (list (list "あ0イぅ12!"))
 
450
                          (list (list "あ0イう12!"))))
 
451
 
 
452
(if (provided? "sigscheme")
 
453
    (begin
 
454
      (assert-eq? (tn) #f
 
455
                  (eqv? '(0 #\a "" #("vE" -1 (#\?)) 23 + "aBc" (-1 #\b ("Ls")) #t)
 
456
                        '(0 #\a "" #("vE" -1 (#\?)) 23 + "aBc" (-1 #\b ("Ls")) #t)))
 
457
      (assert-eq? (tn) #f
 
458
                  (eqv? '(0 #\a "" #("vE" -1 (#\?)) 23 + "aBc" (-1 #\b ("Ls")) #t)
 
459
                        '(0 #\a "" #("vE" -1 (#\?)) 23 + "aBc" (-1 #\b ("L")) #t)))
 
460
      (assert-eq? (tn) #f
 
461
                  (eqv? '(0 #\a "" #("vE" -1 (#\?)) 23 + "aBc" (-1 #\b ("Ls")) #t)
 
462
                        '(0 #\a "" ("vE" -1 (#\?)) 23 + "aBc" (-1 #\b ("Ls")) #t)))
 
463
      (assert-eq? (tn) #f
 
464
                  (eqv? '(0 #\a "" #("vE" -1 (#\?)) 23 + "aBc" (-1 #\b ("Ls")) #t)
 
465
                        '(0 #\a "" #("vE" -1 (#\?)) 23 + "aBc" #t)))
 
466
      (assert-eq? (tn) #f
 
467
                  (eqv? '(0 #\a "" #("vE" -1 (#\?)) 23 + "aBc" #t)
 
468
                        '(0 #\a "" #("vE" -1 (#\?)) 23 + "aBc" (-1 #\b ("Ls")) #t)))))
 
469
 
 
470
(assert-eq? (tn) #f
 
471
            (eqv? (list 0 #\a "" (vector "vE" -1 '(#\?)) 23 + "aBc" (list -1 #\b '("Ls")) #t)
 
472
                  (list 0 #\a "" (vector "vE" -1 '(#\?)) 23 + "aBc" (list -1 #\b '("Ls")) #t)))
 
473
(assert-eq? (tn) #f
 
474
            (eqv? (list 0 #\a "" (vector "vE" -1 '(#\?)) 23 + "aBc" (list -1 #\b '("Ls")) #t)
 
475
                  (list 0 #\a "" (vector "vE" -1 '(#\?)) 23 + "aBc" (list -1 #\b '("L")) #t)))
 
476
(assert-eq? (tn) #f
 
477
            (eqv? (list 0 #\a "" (vector "vE" -1 '(#\?)) 23 + "aBc" (list -1 #\b '("Ls")) #t)
 
478
                  (list 0 #\a "" (list "vE" -1 '(#\?))   23 + "aBc" (list -1 #\b '("Ls")) #t)))
 
479
(assert-eq? (tn) #f
 
480
            (eqv? (list 0 #\a "" (vector "vE" -1 '(#\?)) 23 + "aBc" (list -1 #\b '("Ls")) #t)
 
481
                  (list 0 #\a "" (vector "vE" -1 '(#\?)) 23 + "aBc" #t)))
 
482
(assert-eq? (tn) #f
 
483
            (eqv? (list 0 #\a "" (vector "vE" -1 '(#\?)) 23 + "aBc" #t)
 
484
                  (list 0 #\a "" (vector "vE" -1 '(#\?)) 23 + "aBc" (list -1 #\b '("Ls")) #t)))
 
485
 
 
486
(tn "eqv? empty vector")
 
487
(if (provided? "sigscheme")
 
488
    (assert-eq? (tn) #f (eqv? '#() '#())))
 
489
(assert-eq? (tn) #f (eqv? (vector) (vector)))
 
490
 
 
491
(let ((v1 '#())
 
492
      (v2 (vector)))
 
493
  (assert-eq? (tn) #t (eqv? v1 v1))
 
494
  (assert-eq? (tn) #t (eqv? v2 v2))
 
495
  (assert-eq? (tn) #f (eqv? v1 v2)))
 
496
 
 
497
(tn "eqv? vector")
 
498
(if (provided? "sigscheme")
 
499
    (begin
 
500
      (assert-eq? (tn) #f (eqv? '#(#f) '#(#f)))
 
501
      (assert-eq? (tn) #f (eqv? '#(#f) '#(#t)))
 
502
      (assert-eq? (tn) #f (eqv? '#(#t) '#(#f)))
 
503
      (assert-eq? (tn) #f (eqv? '#(#t) '#(#t)))
 
504
      (assert-eq? (tn) #f (eqv? '#(#(#f)) '#(#(#f))))
 
505
      (assert-eq? (tn) #f (eqv? '#(#(#f)) '#(#(#t))))
 
506
      (assert-eq? (tn) #f (eqv? '#(#(#t)) '#(#(#f))))
 
507
      (assert-eq? (tn) #f (eqv? '#(#(#t)) '#(#(#t))))
 
508
      (assert-eq? (tn) #f (eqv? '#(1) '#(1)))
 
509
      (assert-eq? (tn) #f (eqv? '#(1) '#(0)))
 
510
      (assert-eq? (tn) #f (eqv? '#(1 3 5 0 13)
 
511
                                '#(1 3 5 0 13)))
 
512
      (assert-eq? (tn) #f (eqv? '#(1 3 2 0 13)
 
513
                                '#(1 3 5 0 13)))
 
514
      (assert-eq? (tn) #f (eqv? '#(1 3 #(5 0 13))
 
515
                                '#(1 3 #(5 0 13))))
 
516
      (assert-eq? (tn) #f (eqv? '#(1 3 #(2 0 13))
 
517
                                '#(1 3 #(5 0 13))))
 
518
      (assert-eq? (tn) #f (eqv? '#(#(1)) '#(#(1))))
 
519
      (assert-eq? (tn) #f (eqv? '#(#(1)) '#(#(0))))
 
520
      (assert-eq? (tn) #f (eqv? '#(#(1) #(3) #(5) #(0) #(13))
 
521
                                '#(#(1) #(3) #(5) #(0) #(13))))
 
522
      (assert-eq? (tn) #f (eqv? '#(#(1) #(3) #(2) #(0) #(13))
 
523
                                '#(#(1) #(3) #(5) #(0) #(13))))
 
524
      (assert-eq? (tn) #f (eqv? '#(#\a) '#(#\a)))
 
525
      (assert-eq? (tn) #f (eqv? '#(#\a) '#(#\b)))
 
526
      (assert-eq? (tn) #f (eqv? '#(#\b) '#(#\a)))
 
527
      (assert-eq? (tn) #f (eqv? '#(#(#\a)) '#(#(#\a))))
 
528
      (assert-eq? (tn) #f (eqv? '#(#(#\a)) '#(#(#\b))))
 
529
      (assert-eq? (tn) #f (eqv? '#(#(#\b)) '#(#(#\a))))))
 
530
 
 
531
(assert-eq? (tn) #f (eqv? (vector #f) (vector #f)))
 
532
(assert-eq? (tn) #f (eqv? (vector #f) (vector #t)))
 
533
(assert-eq? (tn) #f (eqv? (vector #t) (vector #f)))
 
534
(assert-eq? (tn) #f (eqv? (vector #t) (vector #t)))
 
535
(assert-eq? (tn) #f (eqv? (vector (vector #f)) (vector (vector #f))))
 
536
(assert-eq? (tn) #f (eqv? (vector (vector #f)) (vector (vector #t))))
 
537
(assert-eq? (tn) #f (eqv? (vector (vector #t)) (vector (vector #f))))
 
538
(assert-eq? (tn) #f (eqv? (vector (vector #t)) (vector (vector #t))))
 
539
(assert-eq? (tn) #f (eqv? (vector 1) (vector 1)))
 
540
(assert-eq? (tn) #f (eqv? (vector 1) (vector 0)))
 
541
(assert-eq? (tn) #f (eqv? (vector 1 3 5 0 13)
 
542
                          (vector 1 3 5 0 13)))
 
543
(assert-eq? (tn) #f (eqv? (vector 1 3 2 0 13)
 
544
                          (vector 1 3 5 0 13)))
 
545
(assert-eq? (tn) #f (eqv? (vector 1 3 (vector 5 0 13))
 
546
                          (vector 1 3 (vector 5 0 13))))
 
547
(assert-eq? (tn) #f (eqv? (vector 1 3 (vector 2 0 13))
 
548
                          (vector 1 3 (vector 5 0 13))))
 
549
(assert-eq? (tn) #f (eqv? (vector (vector 1)) (vector (vector 1))))
 
550
(assert-eq? (tn) #f (eqv? (vector (vector 1)) (vector (vector 0))))
 
551
(assert-eq? (tn) #f (eqv? (vector (vector 1) (vector 3) (vector 5) (vector 0) (vector 13))
 
552
                          (vector (vector 1) (vector 3) (vector 5) (vector 0) (vector 13))))
 
553
(assert-eq? (tn) #f (eqv? (vector (vector 1) (vector 3) (vector 2) (vector 0) (vector 13))
 
554
                          (vector (vector 1) (vector 3) (vector 5) (vector 0) (vector 13))))
 
555
(assert-eq? (tn) #f (eqv? (vector #\a) (vector #\a)))
 
556
(assert-eq? (tn) #f (eqv? (vector #\a) (vector #\b)))
 
557
(assert-eq? (tn) #f (eqv? (vector #\b) (vector #\a)))
 
558
(assert-eq? (tn) #f (eqv? (vector (vector #\a)) (vector (vector #\a))))
 
559
(assert-eq? (tn) #f (eqv? (vector (vector #\a)) (vector (vector #\b))))
 
560
(assert-eq? (tn) #f (eqv? (vector (vector #\b)) (vector (vector #\a))))
 
561
 
 
562
(if (provided? "sigscheme")
 
563
    (begin
 
564
      (assert-eq? (tn) #f (eqv? '#("") '#("")))
 
565
      (assert-eq? (tn) #f (eqv? '#(#("")) '#(#(""))))
 
566
      (assert-eq? (tn) #f (eqv? '#("aBc12!")
 
567
                                '#("aBc12!")))
 
568
      (assert-eq? (tn) #f (eqv? '#("あ0イう12!")
 
569
                                '#("あ0イう12!")))
 
570
      (assert-eq? (tn) #f (eqv? '#("a" "" "aB1" #("3c" "d") "a")
 
571
                                '#("a" "" "aB1" #("3c" "d") "a")))
 
572
      (assert-eq? (tn) #f (eqv? '#(#("aBc12!"))
 
573
                                '#(#("aBc12!"))))
 
574
      (assert-eq? (tn) #f (eqv? '#(#("あ0イう12!"))
 
575
                                '#(#("あ0イう12!"))))))
 
576
 
 
577
(assert-eq? (tn) #f (eqv? (vector "") (vector "")))
 
578
(assert-eq? (tn) #f (eqv? (vector (vector "")) (vector (vector ""))))
 
579
(assert-eq? (tn) #f (eqv? (vector "aBc12!")
 
580
                          (vector "aBc12!")))
 
581
(assert-eq? (tn) #f (eqv? (vector "あ0イう12!")
 
582
                          (vector "あ0イう12!")))
 
583
(assert-eq? (tn) #f (eqv? (vector "a" "" "aB1" (vector "3c" "d") "a")
 
584
                          (vector "a" "" "aB1" (vector "3c" "d") "a")))
 
585
(assert-eq? (tn) #f (eqv? (vector (vector "aBc12!"))
 
586
                          (vector (vector "aBc12!"))))
 
587
(assert-eq? (tn) #f (eqv? (vector (vector "あ0イう12!"))
 
588
                          (vector (vector "あ0イう12!"))))
 
589
 
 
590
(if (provided? "sigscheme")
 
591
    (begin
 
592
      (assert-eq? (tn) #f (eqv? '#("aBc123!")
 
593
                                '#("aBc12!")))
 
594
      (assert-eq? (tn) #f (eqv? '#("あ0イぅ12!")
 
595
                                '#("あ0イう12!")))
 
596
      (assert-eq? (tn) #f (eqv? '#("a" "" "aB1" #("3c" "e") "a")
 
597
                                '#("a" "" "aB1" #("3c" "d") "a")))
 
598
      (assert-eq? (tn) #f (eqv? '#(#("aBc123!"))
 
599
                                '#(#("aBc12!"))))
 
600
      (assert-eq? (tn) #f (eqv? '#(#("あ0イぅ12!"))
 
601
                                '#(#("あ0イう12!"))))))
 
602
 
 
603
(assert-eq? (tn) #f (eqv? (vector "aBc123!")
 
604
                          (vector "aBc12!")))
 
605
(assert-eq? (tn) #f (eqv? (vector "あ0イぅ12!")
 
606
                          (vector "あ0イう12!")))
 
607
(assert-eq? (tn) #f (eqv? (vector "a" "" "aB1" (vector "3c" "e") "a")
 
608
                          (vector "a" "" "aB1" (vector "3c" "d") "a")))
 
609
(assert-eq? (tn) #f (eqv? (vector (vector "aBc123!"))
 
610
                          (vector (vector "aBc12!"))))
 
611
(assert-eq? (tn) #f (eqv? (vector (vector "あ0イぅ12!"))
 
612
                          (vector (vector "あ0イう12!"))))
 
613
 
 
614
(if (provided? "sigscheme")
 
615
    (begin
 
616
      (assert-eq? (tn) #f
 
617
                  (eqv? '#(0 #\a "" #("vE" -1 (#\?)) 23 + "aBc" (-1 #\b ("Ls")) #t)
 
618
                        '#(0 #\a "" #("vE" -1 (#\?)) 23 + "aBc" (-1 #\b ("Ls")) #t)))
 
619
      (assert-eq? (tn) #f
 
620
                  (eqv? '#(0 #\a "" #("vE" -1 (#\?)) 23 + "aBc" (-1 #\b ("Ls")) #t)
 
621
                        '#(0 #\a "" #("vE" -1 (#\?)) 23 + "aBc" (-1 #\b ("L")) #t)))
 
622
      (assert-eq? (tn) #f
 
623
                  (eqv? '#(0 #\a "" #("vE" -1 (#\?)) 23 + "aBc" (-1 #\b ("Ls")) #t)
 
624
                        '#(0 #\a "" ("vE" -1 (#\?)) 23 + "aBc" (-1 #\b ("Ls")) #t)))
 
625
      (assert-eq? (tn) #f
 
626
                  (eqv? '#(0 #\a "" #("vE" -1 (#\?)) 23 + "aBc" (-1 #\b ("Ls")) #t)
 
627
                        '#(0 #\a "" #("vE" -1 (#\?)) 23 + "aBc" #t)))
 
628
      (assert-eq? (tn) #f
 
629
                  (eqv? '#(0 #\a "" #("vE" -1 (#\?)) 23 + "aBc" #t)
 
630
                        '#(0 #\a "" #("vE" -1 (#\?)) 23 + "aBc" (-1 #\b ("Ls")) #t)))))
 
631
 
 
632
(assert-eq? (tn) #f
 
633
            (eqv? (vector 0 #\a "" (vector "vE" -1 '(#\?)) 23 + "aBc" (vector -1 #\b '("Ls")) #t)
 
634
                  (vector 0 #\a "" (vector "vE" -1 '(#\?)) 23 + "aBc" (vector -1 #\b '("Ls")) #t)))
 
635
(assert-eq? (tn) #f
 
636
            (eqv? (vector 0 #\a "" (vector "vE" -1 '(#\?)) 23 + "aBc" (vector -1 #\b '("Ls")) #t)
 
637
                  (vector 0 #\a "" (vector "vE" -1 '(#\?)) 23 + "aBc" (vector -1 #\b '("L")) #t)))
 
638
(assert-eq? (tn) #f
 
639
            (eqv? (vector 0 #\a "" (vector "vE" -1 '(#\?)) 23 + "aBc" (vector -1 #\b '("Ls")) #t)
 
640
                  (vector 0 #\a "" (list "vE" -1 '(#\?))   23 + "aBc" (vector -1 #\b '("Ls")) #t)))
 
641
(assert-eq? (tn) #f
 
642
            (eqv? (vector 0 #\a "" (vector "vE" -1 '(#\?)) 23 + "aBc" (vector -1 #\b '("Ls")) #t)
 
643
                  (vector 0 #\a "" (vector "vE" -1 '(#\?)) 23 + "aBc" #t)))
 
644
(assert-eq? (tn) #f
 
645
            (eqv? (vector 0 #\a "" (vector "vE" -1 '(#\?)) 23 + "aBc" #t)
 
646
                  (vector 0 #\a "" (vector "vE" -1 '(#\?)) 23 + "aBc" (vector -1 #\b '("Ls")) #t)))
 
647
 
 
648
 
 
649
(total-report)