1#| rep.test.data -- checks for rep.data module 2 3 $Id$ 4 5 Copyright (C) 2001 John Harper <jsh@users.sourceforge.net> 6 7 This file is part of librep. 8 9 librep is free software; you can redistribute it and/or modify it 10 under the terms of the GNU General Public License as published by 11 the Free Software Foundation; either version 2, or (at your option) 12 any later version. 13 14 librep is distributed in the hope that it will be useful, but 15 WITHOUT ANY WARRANTY; without even the implied warranty of 16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 GNU General Public License for more details. 18 19 You should have received a copy of the GNU General Public License 20 along with librep; see the file COPYING. If not, write to 21 the Free Software Foundation, 51 Franklin Street, Fifth Floor, 22 Boston, MA 02110-1301 USA 23|# 24 25(define-structure rep.data.self-tests () 26 27 (open rep 28 rep.data.records 29 rep.test.framework) 30 31;;; equality function tests 32 33 ;; adapted from guile's test.scm 34 (define (equality-self-test) 35 (define (gen-counter) 36 (let ((n 0)) 37 (lambda () (setq n (1+ n)) n))) 38 39 (test (eql 'a 'a)) 40 (test (not (eql 'a 'b))) 41 (test (eql 2 2)) 42 (test (eql '() '())) 43 (test (eql '10000 '10000)) 44 (test (not (eql (cons 1 2) (cons 1 2)))) 45 (test (not (eql (lambda () 1) (lambda () 2)))) 46 47 (let ((p (lambda (x) x))) 48 (test (eql p p))) 49 (let ((g (gen-counter))) 50 (test (eql g g))) 51 (test (not (eql (gen-counter) (gen-counter)))) 52 (letrec ((f (lambda () (if (eql f g) 'f 'both))) 53 (g (lambda () (if (eql f g) 'g 'both)))) 54 (test (not (eql f g)))) 55 56 (test (eq 'a 'a)) 57 (test (not (eq (list 'a) (list 'a)))) 58 (test (eq '() '())) 59 (test (eq car car)) 60 (let ((x '(a))) 61 (test (eq x x))) 62 (let ((x '())) 63 (test (eq x x))) 64 (let ((x (lambda (x) x))) 65 (test (eq x x))) 66 67 (test (equal 'a 'a)) 68 (test (equal '(a) '(a))) 69 (test (equal '(a (b) c) '(a (b) c))) 70 (test (equal "abc" "abc")) 71 (test (equal 2 2)) 72 (test (equal (make-vector 5 'a) (make-vector 5 'a)))) 73 74;;; cons and list tests 75 76 ;; adapted from guile's test.scm 77 (define (cons-self-test) 78 (test (consp '(a . b))) 79 (test (consp '(a . 1))) 80 (test (consp '(a b c))) 81 (test (not (consp '()))) 82 (test (not (consp '#(a b)))) 83 84 (test (equal '(a) (cons 'a '()))) 85 (test (equal '((a) b c d) (cons '(a) '(b c d)))) 86 (test (equal '("a" b c) (cons "a" '(b c)))) 87 (test (equal '(a . 3) (cons 'a 3))) 88 (test (equal '((a b) . c) (cons '(a b) 'c))) 89 90 (test (equal 'a (car '(a b c)))) 91 (test (equal '(a) (car '((a) b c d)))) 92 (test (equal 1 (car '(1 . 2)))) 93 94 (test (equal '(b c d) (cdr '((a) b c d)))) 95 (test (equal 2 (cdr '(1 . 2)))) 96 97 (test (equal '(a 7 c) (list 'a (+ 3 4) 'c))) 98 (test (equal '() (list))) 99 100 (test (= 3 (length '(a b c)))) 101 (test (= 3 (length '(a (b) (c d e))))) 102 (test (= 0 (length '()))) 103 104 (test (equal '(x y) (append '(x) '(y)))) 105 (test (equal '(a b c d) (append '(a) '(b c d)))) 106 (test (equal '(a (b) (c)) (append '(a (b)) '((c))))) 107 (test (equal '() (append))) 108 (test (equal '(a b c . d) (append '(a b) '(c . d)))) 109 (test (equal 'a (append '() 'a))) 110 111 (test (equal '(c b a) (reverse '(a b c)))) 112 (test (equal '((e (f)) d (b c) a) (reverse '(a (b c) d (e (f)))))) 113 114 (test (equal 'c (nth 2 '(a b c d)))) 115 116 (test (equal '(a b c) (memq 'a '(a b c)))) 117 (test (equal '(b c) (memq 'b '(a b c)))) 118 (test (null (memq 'a '(b c d)))) 119 (test (null (memq (list 'a) '(b (a) c)))) 120 (test (equal '((a) c) (member (list 'a) '(b (a) c)))) 121 (test (equal '(101 102) (memql 101 '(100 101 102)))) 122 123 (let ((e '((a 1) (b 2) (c 3)))) 124 (test (equal '(a 1) (assq 'a e))) 125 (test (equal '(b 2) (assq 'b e))) 126 (test (null (assq 'd e)))) 127 (test (null (assq (list 'a) '(((a)) ((b)) ((c)))))) 128 (test (equal '((a)) (assoc (list 'a) '(((a)) ((b)) ((c)))))) 129 (test (equal '(5 7) (assq 5 '((2 3) (5 7) (11 13)))))) 130 131;;; tests for rep.data.records 132 133 (define-record-type :pare 134 (kons x y) 135 pare? 136 (x kar set-kar!) 137 (y kdr)) 138 139 (define-record-discloser :pare 140 (lambda (x) (format nil "#<pare %s %s>" (kar x) (kdr x)))) 141 142 (define (record-self-test) 143 (define pare (kons 1 2)) 144 (test pare) 145 (test (pare? pare)) 146 (test (eql (kar pare) 1)) 147 (test (eql (kdr pare) 2)) 148 149 (set-kar! pare 3) 150 (test (eql (kar pare) 3))) 151 152;;; string-util tests 153 154 (define (string-util-self-test) 155 (test (string-upper-case-p "FOO")) 156 (test (not (string-upper-case-p "Foo"))) 157 (test (not (string-upper-case-p "foo"))) 158 (test (not (string-upper-case-p "123"))) 159 160 (test (string-lower-case-p "foo")) 161 (test (not (string-lower-case-p "Foo"))) 162 (test (not (string-lower-case-p "FOO"))) 163 (test (not (string-lower-case-p "123"))) 164 165 (test (string-capitalized-p "Foo")) 166 (test (string-capitalized-p "FOO")) 167 (test (not (string-capitalized-p "foo"))) 168 169 (test (string= (string-upcase "foo") "FOO")) 170 (test (string= (string-upcase "FOO") "FOO")) 171 (test (string= (string-upcase "Foo") "FOO")) 172 (test (string= (string-upcase "123") "123")) 173 174 (test (string= (string-downcase "FOO") "foo")) 175 (test (string= (string-downcase "foo") "foo")) 176 (test (string= (string-downcase "Foo") "foo")) 177 (test (string= (string-downcase "123") "123")) 178 179 (test (string= (capitalize-string "FOO") "FOO")) 180 (test (string= (capitalize-string "foo") "Foo")) 181 (test (string= (capitalize-string "Foo") "Foo")) 182 (test (string= (capitalize-string "123") "123")) 183 184 (test (string= (mapconcat identity '("foo" "bar" "baz") " ") 185 "foo bar baz")) 186 (test (string= (mapconcat identity '("foo" "bar" "baz") #\space) 187 "foo bar baz")) 188 (test (string= (mapconcat identity '() #\space) "")) 189 (test (string= (mapconcat string-upcase '("foo" "bar" "baz") " ") 190 "FOO BAR BAZ"))) 191 192 (define (self-test) 193 (equality-self-test) 194 (cons-self-test) 195 (record-self-test) 196 (string-util-self-test)) 197 198 ;;###autoload 199 (define-self-test 'rep.data self-test)) 200