1#! /usr/bin/env sscm -C UTF-8 2;; -*- buffer-file-coding-system: utf-8 -*- 3 4;; Filename : test-list.scm 5;; About : unit test for list operations 6;; 7;; Copyright (C) 2005-2006 Kazuki Ohta <mover AT hct.zaq.ne.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 41(define elm0 (list #t)) 42(define elm1 (list #t)) 43(define elm2 (list #t)) 44(define elm3 (list #t)) 45(define nil '()) 46(define cdr3 (cons elm3 nil)) 47(define cdr2 (cons elm2 cdr3)) 48(define cdr1 (cons elm1 cdr2)) 49(define cdr0 (cons elm0 cdr1)) 50(define lst cdr0) 51;; circular lists 52(define clst1 (list 1)) 53(set-cdr! clst1 clst1) 54(define clst2 (list 1 2)) 55(set-cdr! (list-tail clst2 1) clst2) 56(define clst3 (list 1 2 3)) 57(set-cdr! (list-tail clst3 2) clst3) 58(define clst4 (list 1 2 3 4)) 59(set-cdr! (list-tail clst4 3) clst4) 60 61 62(tn "null?") 63(if (and (provided? "sigscheme") 64 (provided? "siod-bugs")) 65 (assert-eq? (tn) #t (null? #f)) 66 (assert-eq? (tn) #f (null? #f))) 67(assert-eq? (tn) #f (null? #t)) 68(assert-eq? (tn) #t (null? '())) 69(if (provided? "sigscheme") 70 (begin 71 (assert-eq? (tn) #f (null? (eof))) 72 (assert-eq? (tn) #f (null? (undef))))) 73(assert-eq? (tn) #f (null? 0)) 74(assert-eq? (tn) #f (null? 1)) 75(assert-eq? (tn) #f (null? 3)) 76(assert-eq? (tn) #f (null? -1)) 77(assert-eq? (tn) #f (null? -3)) 78(assert-eq? (tn) #f (null? 'symbol)) 79(assert-eq? (tn) #f (null? 'SYMBOL)) 80(assert-eq? (tn) #f (null? #\a)) 81(assert-eq? (tn) #f (null? #\あ)) 82(assert-eq? (tn) #f (null? "")) 83(assert-eq? (tn) #f (null? " ")) 84(assert-eq? (tn) #f (null? "a")) 85(assert-eq? (tn) #f (null? "A")) 86(assert-eq? (tn) #f (null? "aBc12!")) 87(assert-eq? (tn) #f (null? "あ")) 88(assert-eq? (tn) #f (null? "あ0イう12!")) 89(assert-eq? (tn) #f (null? +)) 90(assert-eq? (tn) #f (null? (lambda () #t))) 91 92;; syntactic keywords should not be appeared as operand 93(if sigscheme? 94 (begin 95 ;; pure syntactic keyword 96 (assert-error (tn) (lambda () (null? else))) 97 ;; expression keyword 98 (assert-error (tn) (lambda () (null? do))))) 99 100(call-with-current-continuation 101 (lambda (k) 102 (assert-eq? (tn) #f (null? k)))) 103(assert-eq? (tn) #f (null? (current-output-port))) 104(assert-eq? (tn) #f (null? '(#t . #t))) 105(assert-eq? (tn) #f (null? (cons #t #t))) 106(assert-eq? (tn) #f (null? '(0 1 2))) 107(assert-eq? (tn) #f (null? (list 0 1 2))) 108;; improper lists 109(assert-eq? (tn) #f (null? '(0 . 1))) 110(assert-eq? (tn) #f (null? '(0 1 . 2))) 111(assert-eq? (tn) #f (null? '(0 1 2 . 3))) 112;; circular lists 113(assert-eq? (tn) #f (null? clst1)) 114(assert-eq? (tn) #f (null? clst2)) 115(assert-eq? (tn) #f (null? clst3)) 116(assert-eq? (tn) #f (null? clst4)) 117(assert-eq? (tn) #f (null? '#())) 118(assert-eq? (tn) #f (null? (vector))) 119(assert-eq? (tn) #f (null? '#(0 1 2))) 120(assert-eq? (tn) #f (null? (vector 0 1 2))) 121 122(tn "list?") 123(if (and (provided? "sigscheme") 124 (provided? "siod-bugs")) 125 (assert-eq? (tn) #t (list? #f)) 126 (assert-eq? (tn) #f (list? #f))) 127(assert-eq? (tn) #f (list? #t)) 128(assert-eq? (tn) #t (list? '())) 129(if (provided? "sigscheme") 130 (begin 131 (assert-eq? (tn) #f (list? (eof))) 132 (assert-eq? (tn) #f (list? (undef))))) 133(assert-eq? (tn) #f (list? 0)) 134(assert-eq? (tn) #f (list? 1)) 135(assert-eq? (tn) #f (list? 3)) 136(assert-eq? (tn) #f (list? -1)) 137(assert-eq? (tn) #f (list? -3)) 138(assert-eq? (tn) #f (list? 'symbol)) 139(assert-eq? (tn) #f (list? 'SYMBOL)) 140(assert-eq? (tn) #f (list? #\a)) 141(assert-eq? (tn) #f (list? #\あ)) 142(assert-eq? (tn) #f (list? "")) 143(assert-eq? (tn) #f (list? " ")) 144(assert-eq? (tn) #f (list? "a")) 145(assert-eq? (tn) #f (list? "A")) 146(assert-eq? (tn) #f (list? "aBc12!")) 147(assert-eq? (tn) #f (list? "あ")) 148(assert-eq? (tn) #f (list? "あ0イう12!")) 149(assert-eq? (tn) #f (list? +)) 150(assert-eq? (tn) #f (list? (lambda () #t))) 151 152;; syntactic keywords should not be appeared as operand 153(if sigscheme? 154 (begin 155 ;; pure syntactic keyword 156 (assert-error (tn) (lambda () (list? else))) 157 ;; expression keyword 158 (assert-error (tn) (lambda () (list? do))))) 159 160(call-with-current-continuation 161 (lambda (k) 162 (assert-eq? (tn) #f (list? k)))) 163(assert-eq? (tn) #f (list? (current-output-port))) 164(assert-eq? (tn) #f (list? '(#t . #t))) 165(assert-eq? (tn) #f (list? (cons #t #t))) 166(assert-eq? (tn) #t (list? '(0 1 2))) 167(assert-eq? (tn) #t (list? (list 0 1 2))) 168;; improper lists 169(assert-eq? (tn) #f (list? '(0 . 1))) 170(assert-eq? (tn) #f (list? '(0 1 . 2))) 171(assert-eq? (tn) #f (list? '(0 1 2 . 3))) 172;; circular lists 173(assert-eq? (tn) #f (list? clst1)) 174(assert-eq? (tn) #f (list? clst2)) 175(assert-eq? (tn) #f (list? clst3)) 176(assert-eq? (tn) #f (list? clst4)) 177(assert-eq? (tn) #f (list? '#())) 178(assert-eq? (tn) #f (list? (vector))) 179(assert-eq? (tn) #f (list? '#(0 1 2))) 180(assert-eq? (tn) #f (list? (vector 0 1 2))) 181 182(tn "list? from R5RS examples") 183(assert-eq? (tn) #t (list? '(a b c))) 184(assert-eq? (tn) #t (list? '())) 185(assert-eq? (tn) #f (list? '(a . b))) 186(assert-eq? (tn) #f (list? '(a b . c))) 187(assert-eq? (tn) #f (let ((x (list 'a))) 188 (set-cdr! x x) 189 (list? x))) 190 191(tn "list") 192(assert-equal? (tn) '() (list)) 193(assert-equal? (tn) '(a) (list 'a)) 194(assert-equal? (tn) '(7) (list (+ 3 4))) 195(assert-equal? (tn) '(7 a c) (list (+ 3 4) 'a 'c)) 196(assert-equal? (tn) '(a 7 c) (list 'a (+ 3 4) 'c)) 197(assert-equal? (tn) '(a c 7) (list 'a 'c (+ 3 4))) 198(assert-error (tn) (lambda () (list . 0))) 199(assert-error (tn) (lambda () (list 0 . 1))) 200 201(tn "length proper lists") 202(assert-equal? (tn) 0 (length '())) 203(assert-equal? (tn) 1 (length '(1))) 204(assert-equal? (tn) 2 (length '(1 2))) 205(assert-equal? (tn) 3 (length '(1 2 3))) 206(assert-equal? (tn) 4 (length '(1 2 3 4))) 207(tn "length improper lists") 208(assert-error (tn) (lambda () (length #t))) 209(assert-error (tn) (lambda () (length '(#t . #t)))) 210(assert-error (tn) (lambda () (length '(#t #t . #t)))) 211(assert-error (tn) (lambda () (length '(#t #t #t . #t)))) 212(assert-error (tn) (lambda () (length '(#t #t #t #t . #t)))) 213(assert-error (tn) (lambda () (length 0))) 214(assert-error (tn) (lambda () (length '(1 . 2)))) 215(assert-error (tn) (lambda () (length '(1 2 . 3)))) 216(assert-error (tn) (lambda () (length '(1 2 3 . 4)))) 217(assert-error (tn) (lambda () (length '(1 2 3 4 . 5)))) 218(tn "length circular lists") 219(assert-error (tn) (lambda () (length clst1))) 220(assert-error (tn) (lambda () (length clst2))) 221(assert-error (tn) (lambda () (length clst3))) 222(assert-error (tn) (lambda () (length clst4))) 223(tn "length from R5RS examples") 224(assert-equal? (tn) 3 (length '(a b c))) 225(assert-equal? (tn) 3 (length '(a (b) (c d e)))) 226(assert-equal? (tn) 0 (length '())) 227 228(tn "append") 229(assert-equal? (tn) '() (append)) 230(assert-equal? (tn) '() (append '())) 231(assert-equal? (tn) '() (append '() '())) 232(assert-equal? (tn) '() (append '() '() '())) 233(assert-equal? (tn) '(a) (append '(a) '() '())) 234(assert-equal? (tn) '(a) (append '() '(a) '())) 235(assert-equal? (tn) '(a) (append '() '() '(a))) 236(assert-equal? (tn) 'a (append 'a)) 237(assert-error (tn) (lambda () (append 'a 'b))) 238(assert-error (tn) (lambda () (append 'a '(b)))) 239(assert-error (tn) (lambda () (append 'a '()))) 240(assert-equal? (tn) '(a . b) (append '(a . b))) 241(assert-error (tn) (lambda () (append '(a . b) '()))) 242(assert-error (tn) (lambda () (append '() '(a . b) '()))) 243(assert-equal? (tn) '(a . b) (append '() '() '(a . b))) 244(assert-equal? (tn) '(1 2 3 a . b) (append '(1) '(2 3) '(a . b))) 245(assert-equal? (tn) 7 (append (+ 3 4))) 246(assert-equal? (tn) '(+ 3 4) (append '(+ 3 4))) 247 248(assert-equal? (tn) '(x y) (append '(x) '(y))) 249(assert-equal? (tn) '(a b c d) (append '(a) '(b c d))) 250(assert-equal? (tn) '(a (b) (c)) (append '(a (b)) '((c)))) 251(define w '(n o)) 252(define x '(d o)) 253(define y '(car)) 254(define z '(why)) 255(assert-equal? (tn) '(n o d o car why . ta) (append w x y () z 'ta)) 256(assert-equal? (tn) '(n o) w) ; test non-destructiveness 257(assert-eq? (tn) x (cdr (append '((Calpis hosi-)) x))) ; share last 258 259(tn "append from R5RS examples") 260(assert-equal? (tn) '(x y) (append '(x) '(y))) 261(assert-equal? (tn) '(a b c d) (append '(a) '(b c d))) 262(assert-equal? (tn) '(a (b) (c)) (append '(a (b)) '((c)))) 263(assert-equal? (tn) '(a b c . d) (append '(a b) '(c . d))) 264(assert-equal? (tn) 'a (append '() 'a)) 265 266(tn "reverse") 267(assert-equal? (tn) '() (reverse '())) 268(assert-error (tn) (lambda () (reverse))) 269(assert-error (tn) (lambda () (reverse '(a . b)))) 270(assert-error (tn) (lambda () (reverse 'a))) 271(assert-error (tn) (lambda () (reverse '() '()))) 272(assert-error (tn) (lambda () (reverse '(a) '()))) 273(assert-error (tn) (lambda () (reverse '() '(a)))) 274 275(tn "reverse from R5RS examples") 276(assert-equal? (tn) '(c b a) (reverse '(a b c))) 277(assert-equal? (tn) '((e (f)) d (b c) a) (reverse '(a (b c) d (e (f))))) 278 279(tn "list-tail") 280(assert-equal? (tn) '(a b c) (list-tail '(a b c) 0)) 281(assert-equal? (tn) '(b c) (list-tail '(a b c) 1)) 282(assert-equal? (tn) '(c) (list-tail '(a b c) 2)) 283(assert-equal? (tn) '() (list-tail '(a b c) 3)) 284(assert-error (tn) (lambda () (list-tail '(a b c) 4))) 285(assert-error (tn) (lambda () (list-tail '(a b c) -1))) 286(assert-equal? (tn) '() (list-tail '() 0)) 287(assert-error (tn) (lambda () (list-tail '() 1))) 288(assert-error (tn) (lambda () (list-tail '() -1))) 289(assert-eq? (tn) cdr0 (list-tail lst 0)) 290(assert-eq? (tn) cdr1 (list-tail lst 1)) 291(assert-eq? (tn) cdr2 (list-tail lst 2)) 292(assert-eq? (tn) cdr3 (list-tail lst 3)) 293(assert-eq? (tn) nil (list-tail lst 4)) 294(assert-error (tn) (lambda () (list-tail lst 5))) 295(assert-error (tn) (lambda () (list-tail lst -1))) 296 297(tn "list-tail improper list") 298(assert-equal? (tn) '(a b c . d) (list-tail '(a b c . d) 0)) 299(assert-equal? (tn) '(b c . d) (list-tail '(a b c . d) 1)) 300(assert-equal? (tn) '(c . d) (list-tail '(a b c . d) 2)) 301(assert-equal? (tn) 'd (list-tail '(a b c . d) 3)) 302(assert-error (tn) (lambda () (list-tail '(a b c . d) 4))) 303(assert-error (tn) (lambda () (list-tail '(a b c . d) -1))) 304(assert-equal? (tn) 'a (list-tail 'a 0)) 305(assert-error (tn) (lambda () (list-tail 'a 1))) 306(assert-error (tn) (lambda () (list-tail 'a -1))) 307 308(tn "list-ref") 309(assert-equal? (tn) 'a (list-ref '(a b c d) 0)) 310(assert-equal? (tn) 'b (list-ref '(a b c d) 1)) 311(assert-equal? (tn) 'c (list-ref '(a b c d) 2)) 312(assert-equal? (tn) 'd (list-ref '(a b c d) 3)) 313(assert-error (tn) (lambda () (list-ref '(a b c d) 4))) 314(assert-error (tn) (lambda () (list-ref '(a b c d) -1))) 315(assert-error (tn) (lambda () (list-ref '() 0))) 316(assert-error (tn) (lambda () (list-ref '() 1))) 317(assert-error (tn) (lambda () (list-ref '() -1))) 318(assert-eq? (tn) elm0 (list-ref lst 0)) 319(assert-eq? (tn) elm1 (list-ref lst 1)) 320(assert-eq? (tn) elm2 (list-ref lst 2)) 321(assert-eq? (tn) elm3 (list-ref lst 3)) 322(assert-error (tn) (lambda () (list-ref lst 4))) 323(assert-error (tn) (lambda () (list-ref lst -1))) 324 325(tn "list-ref improper list") 326(assert-equal? (tn) 'a (list-ref '(a b c . d) 0)) 327(assert-equal? (tn) 'b (list-ref '(a b c . d) 1)) 328(assert-equal? (tn) 'c (list-ref '(a b c . d) 2)) 329(assert-error (tn) (lambda () (list-ref '(a b c . d) 3))) 330(assert-error (tn) (lambda () (list-ref '(a b c . d) 4))) 331(assert-error (tn) (lambda () (list-ref '(a b c . d) -1))) 332(assert-error (tn) (lambda () (list-ref 'a 0))) 333(assert-error (tn) (lambda () (list-ref 'a 1))) 334(assert-error (tn) (lambda () (list-ref 'a -1))) 335 336(if sigscheme? 337 (begin 338 (require-extension (sscm-ext)) 339 (tn "length* proper list") 340 (assert-equal? (tn) 0 (length* '())) 341 (assert-equal? (tn) 1 (length* '(1))) 342 (assert-equal? (tn) 2 (length* '(1 2))) 343 (assert-equal? (tn) 3 (length* '(1 2 3))) 344 (assert-equal? (tn) 4 (length* '(1 2 3 4))) 345 (tn "length* dotted list") 346 (assert-equal? (tn) -1 (length* 1)) 347 (assert-equal? (tn) -2 (length* '(1 . 2))) 348 (assert-equal? (tn) -3 (length* '(1 2 . 3))) 349 (assert-equal? (tn) -4 (length* '(1 2 3 . 4))) 350 (assert-equal? (tn) -5 (length* '(1 2 3 4 . 5))) 351 (tn "length* circular list") 352 (assert-eq? (tn) #f (length* clst1)) 353 (assert-eq? (tn) #f (length* clst2)) 354 (assert-eq? (tn) #f (length* clst3)) 355 (assert-eq? (tn) #f (length* clst4)))) 356 357(total-report) 358