Projects : gscm : gscm_genesis
1 | (load "common.scm") |
2 | |
3 | (assert (equal? 1. 1.) 'equal-floats) |
4 | (assert (equal? (cons (cons 1 2) 3) '((1 . 2) . 3)) 'equal-pairs) |
5 | (assert (equal? (string #\a #\b #\c) "abc") 'equal-strings) |
6 | (assert (equal? (vector) '#()) 'equal-empty-vectors) |
7 | (assert (equal? (vector 1 2 (cons 3 4)) '#(1 2 (3 . 4))) 'equal-vectors) |
8 | (assert (not (equal? (cons 1 2) '())) 'unequal-types-1) |
9 | (assert (not (equal? "a" #\a)) 'unequal-types-2) |
10 | (assert (not (equal? "a" "A")) 'unequal-case) |
11 | (assert (not (equal? '#() '#(1))) 'unequal-vectors-1) |
12 | (assert (not (equal? '#(1) '#())) 'unequal-vectors-2) |
13 | (assert (not (equal? '#(1) '#(2))) 'unequal-vectors-3) |
14 | |
15 | (assert-equal (list? '(1 2 . 3)) #f 'improper-list) |
16 | |
17 | (let ((l (list 1 2 3))) |
18 | (set-cdr! (cddr l) l) |
19 | (assert-equal (list? l) #f 'cyclic-list)) |
20 | |
21 | (let* ((x (list 1)) |
22 | (y (list 2)) |
23 | (z (append x y))) |
24 | (assert-equal z '(1 2) 'append) |
25 | (set-car! x 0) |
26 | (assert-equal z '(1 2) 'append-copied-first) |
27 | (set-car! x 1) |
28 | (set-car! y 0) |
29 | (assert-equal z '(1 0) 'append-shared-last) |
30 | (assert-equal (append x 2) '(1 . 2) 'append-improper-last)) |
31 | |
32 | (let* ((x (list 1)) |
33 | (y (apply (lambda args args) 0 x))) |
34 | (assert-equal y '(0 1) 'apply) |
35 | (set-car! x 2) |
36 | (assert-equal y '(0 1) 'arg-list-copied)) |
37 | |
38 | (assert-equal (map - '(1 2 3)) '(-1 -2 -3) 'map) |
39 | (assert-equal (map + '(1 2 3) '(4 5 6)) '(5 7 9) 'multi-map) |
40 | |
41 | ;; MOAR TESTS! |