HCoop / bpt / guile.git / blame
| Commit | Line | Data |
|---|---|---|
| 04bb321a | 1 | ;;;; elisp.test --- tests guile's elisp support -*- scheme -*- |
| 6e7d5622 | 2 | ;;;; Copyright (C) 2002, 2003, 2006 Free Software Foundation, Inc. |
| 04bb321a | 3 | ;;;; |
| 73be1d9e MV |
4 | ;;;; This library is free software; you can redistribute it and/or |
| 5 | ;;;; modify it under the terms of the GNU Lesser General Public | |
| 6 | ;;;; License as published by the Free Software Foundation; either | |
| 7 | ;;;; version 2.1 of the License, or (at your option) any later version. | |
| 8 | ;;;; | |
| 9 | ;;;; This library is distributed in the hope that it will be useful, | |
| 04bb321a | 10 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 73be1d9e MV |
11 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
| 12 | ;;;; Lesser General Public License for more details. | |
| 13 | ;;;; | |
| 14 | ;;;; You should have received a copy of the GNU Lesser General Public | |
| 15 | ;;;; License along with this library; if not, write to the Free Software | |
| 92205699 | 16 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA |
| 04bb321a | 17 | |
| e68ef9c8 DH |
18 | (define-module (test-suite test-elisp) |
| 19 | :use-module (test-suite lib) | |
| 20 | :use-module (ice-9 weak-vector)) | |
| 21 | ||
| 04bb321a NJ |
22 | ;;; |
| 23 | ;;; elisp | |
| 24 | ;;; | |
| 25 | ||
| 26 | (if (defined? '%nil) | |
| 27 | ||
| 28 | (with-test-prefix "scheme" | |
| 29 | ||
| 30 | (with-test-prefix "nil value is a boolean" | |
| 31 | ||
| 32 | (pass-if "boolean?" | |
| 33 | (boolean? %nil)) | |
| 34 | ||
| 35 | ) | |
| 36 | ||
| 37 | (with-test-prefix "nil value is false" | |
| 38 | ||
| 39 | (pass-if "not" | |
| 40 | (eq? (not %nil) #t)) | |
| 41 | ||
| 42 | (pass-if "if" | |
| 43 | (if %nil #f #t)) | |
| 44 | ||
| 45 | (pass-if "and" | |
| 46 | (eq? (and %nil #t) #f)) | |
| 47 | ||
| 48 | (pass-if "or" | |
| 49 | (eq? (or %nil #f) #f)) | |
| 50 | ||
| 51 | (pass-if "cond" | |
| 52 | (cond (%nil #f) (else #t))) | |
| 53 | ||
| 54 | (pass-if "do" | |
| 55 | (call-with-current-continuation | |
| 56 | (lambda (exit) | |
| 57 | (do ((i 0 (+ i 1))) | |
| 58 | (%nil (exit #f)) | |
| 59 | (if (> i 10) | |
| 60 | (exit #t)))))) | |
| 61 | ||
| 62 | ) | |
| 63 | ||
| 64 | (with-test-prefix "nil value as an empty list" | |
| 65 | ||
| 66 | (pass-if "list?" | |
| 67 | (list? %nil)) | |
| 68 | ||
| 69 | (pass-if "null?" | |
| 70 | (null? %nil)) | |
| 71 | ||
| 72 | (pass-if "sort" | |
| 73 | (eq? (sort %nil <) %nil)) | |
| 74 | ||
| 75 | ) | |
| 76 | ||
| 77 | (with-test-prefix "lists formed using nil value" | |
| 78 | ||
| 79 | (pass-if "list?" | |
| 80 | (list? (cons 'a %nil))) | |
| 81 | ||
| 962b1f0b NJ |
82 | (pass-if "length of %nil" |
| 83 | (= (length %nil) 0)) | |
| 84 | ||
| 04bb321a NJ |
85 | (pass-if "length" |
| 86 | (= (length (cons 'a (cons 'b (cons 'c %nil)))) 3)) | |
| 87 | ||
| 88 | (pass-if "length (with backquoted list)" | |
| 89 | (= (length `(a b c . ,%nil)) 3)) | |
| 90 | ||
| bbd26b5a NJ |
91 | (pass-if "write (%nil)" |
| 92 | (string=? (with-output-to-string | |
| 93 | (lambda () (write %nil))) | |
| 94 | "#nil")) ; Hmmm... should be "()" ? | |
| 95 | ||
| 96 | (pass-if "display (%nil)" | |
| 97 | (string=? (with-output-to-string | |
| 98 | (lambda () (display %nil))) | |
| 99 | "#nil")) ; Ditto. | |
| 100 | ||
| 101 | (pass-if "write (list)" | |
| 04bb321a NJ |
102 | (string=? (with-output-to-string |
| 103 | (lambda () (write (cons 'a %nil)))) | |
| 104 | "(a)")) | |
| 105 | ||
| bbd26b5a | 106 | (pass-if "display (list)" |
| 04bb321a NJ |
107 | (string=? (with-output-to-string |
| 108 | (lambda () (display (cons 'a %nil)))) | |
| 109 | "(a)")) | |
| 110 | ||
| 962b1f0b NJ |
111 | (pass-if "assq" |
| 112 | (and (equal? (assq 1 `((1 one) (2 two) . ,%nil)) | |
| 113 | '(1 one)) | |
| 114 | (equal? (assq 3 `((1 one) (2 two) . ,%nil)) | |
| 115 | #f))) | |
| 116 | ||
| 117 | (pass-if "assv" | |
| 118 | (and (equal? (assv 1 `((1 one) (2 two) . ,%nil)) | |
| 119 | '(1 one)) | |
| 120 | (equal? (assv 3 `((1 one) (2 two) . ,%nil)) | |
| 121 | #f))) | |
| 122 | ||
| 123 | (pass-if "assoc" | |
| 124 | (and (equal? (assoc 1 `((1 one) (2 two) . ,%nil)) | |
| 125 | '(1 one)) | |
| 126 | (equal? (assoc 3 `((1 one) (2 two) . ,%nil)) | |
| 127 | #f))) | |
| 128 | ||
| 129 | (pass-if "with-fluids*" | |
| 130 | (let ((f (make-fluid)) | |
| 131 | (g (make-fluid))) | |
| 132 | (with-fluids* (cons f (cons g %nil)) | |
| 133 | '(3 4) | |
| 134 | (lambda () | |
| 135 | (and (eq? (fluid-ref f) 3) | |
| 136 | (eq? (fluid-ref g) 4)))))) | |
| 137 | ||
| 138 | (pass-if "append!" | |
| 139 | (let ((a (copy-tree '(1 2 3))) | |
| 140 | (b (copy-tree `(4 5 6 . ,%nil))) | |
| 141 | (c (copy-tree '(7 8 9))) | |
| 142 | (d (copy-tree `(a b c . ,%nil)))) | |
| 143 | (equal? (append! a b c d) | |
| 144 | `(1 2 3 4 5 6 7 8 9 a b c . ,%nil)))) | |
| 145 | ||
| 146 | (pass-if "last-pair" | |
| 147 | (equal? (last-pair `(1 2 3 4 5 . ,%nil)) | |
| 148 | (cons 5 %nil))) | |
| 149 | ||
| 150 | (pass-if "reverse" | |
| 151 | (equal? (reverse `(1 2 3 4 5 . ,%nil)) | |
| 152 | '(5 4 3 2 1))) ; Hmmm... is this OK, or | |
| 153 | ; should it be | |
| 154 | ; `(5 4 3 2 1 . ,%nil) ? | |
| 155 | ||
| 156 | (pass-if "reverse!" | |
| 157 | (equal? (reverse! (copy-tree `(1 2 3 4 5 . ,%nil))) | |
| 158 | '(5 4 3 2 1))) ; Ditto. | |
| 159 | ||
| 160 | (pass-if "list-ref" | |
| 161 | (eq? (list-ref `(0 1 2 3 4 . ,%nil) 4) 4)) | |
| 162 | ||
| 163 | (pass-if-exception "list-ref" | |
| 164 | exception:out-of-range | |
| 165 | (eq? (list-ref `(0 1 2 3 4 . ,%nil) 6) 6)) | |
| 166 | ||
| 167 | (pass-if "list-set!" | |
| 168 | (let ((l (copy-tree `(0 1 2 3 4 . ,%nil)))) | |
| 169 | (list-set! l 4 44) | |
| 170 | (= (list-ref l 4) 44))) | |
| 171 | ||
| 172 | (pass-if-exception "list-set!" | |
| 173 | exception:out-of-range | |
| 174 | (let ((l (copy-tree `(0 1 2 3 4 . ,%nil)))) | |
| 175 | (list-set! l 6 44) | |
| 176 | (= (list-ref l 6) 44))) | |
| 177 | ||
| bbd26b5a NJ |
178 | (pass-if "list-cdr-set!" |
| 179 | (let ((l (copy-tree `(0 1 2 3 4 . ,%nil)))) | |
| 180 | (and (begin | |
| 181 | (list-cdr-set! l 4 44) | |
| 182 | (equal? l '(0 1 2 3 4 . 44))) | |
| 183 | (begin | |
| 184 | (list-cdr-set! l 3 `(new . ,%nil)) | |
| 185 | (equal? l `(0 1 2 3 new . ,%nil)))))) | |
| 186 | ||
| 187 | (pass-if-exception "list-cdr-set!" | |
| 188 | exception:out-of-range | |
| 189 | (let ((l (copy-tree `(0 1 2 3 4 . ,%nil)))) | |
| 190 | (list-cdr-set! l 6 44))) | |
| 191 | ||
| 192 | (pass-if "memq" | |
| 193 | (equal? (memq 'c `(a b c d . ,%nil)) `(c d . ,%nil))) | |
| 194 | ||
| 195 | (pass-if "memv" | |
| 196 | (equal? (memv 'c `(a b c d . ,%nil)) `(c d . ,%nil))) | |
| 197 | ||
| 198 | (pass-if "member" | |
| 199 | (equal? (member "c" `("a" "b" "c" "d" . ,%nil)) `("c" "d" . ,%nil))) | |
| 200 | ||
| 201 | (pass-if "list->vector" | |
| 42ad901d | 202 | (equal? '#(1 2 3) (list->vector `(1 2 3 . ,%nil)))) |
| bbd26b5a NJ |
203 | |
| 204 | (pass-if "list->vector" | |
| 42ad901d | 205 | (equal? '#(1 2 3) (list->vector `(1 2 3 . ,%nil)))) |
| bbd26b5a NJ |
206 | |
| 207 | (pass-if "list->weak-vector" | |
| 208 | (equal? (weak-vector 1 2 3) (list->weak-vector `(1 2 3 . ,%nil)))) | |
| 209 | ||
| 210 | (pass-if "sorted?" | |
| 211 | (and (sorted? `(1 2 3 . ,%nil) <) | |
| 212 | (not (sorted? `(1 6 3 . ,%nil) <)))) | |
| 213 | ||
| 214 | (pass-if "merge" | |
| 215 | (equal? (merge '(1 4 7 10) | |
| 216 | (merge `(2 5 8 11 . ,%nil) | |
| 217 | `(3 6 9 12 . ,%nil) | |
| 218 | <) | |
| 219 | <) | |
| 220 | `(1 2 3 4 5 6 7 8 9 10 11 12 . ,%nil))) | |
| 221 | ||
| 222 | (pass-if "merge!" | |
| 223 | (equal? (merge! (copy-tree '(1 4 7 10)) | |
| 224 | (merge! (copy-tree `(2 5 8 11 . ,%nil)) | |
| 225 | (copy-tree `(3 6 9 12 . ,%nil)) | |
| 226 | <) | |
| 227 | <) | |
| 228 | `(1 2 3 4 5 6 7 8 9 10 11 12 . ,%nil))) | |
| 229 | ||
| 230 | (pass-if "sort" | |
| 231 | (equal? (sort `(1 5 3 8 4 . ,%nil) <) '(1 3 4 5 8))) | |
| 232 | ||
| 233 | (pass-if "stable-sort" | |
| 234 | (equal? (stable-sort `(1 5 3 8 4 . ,%nil) <) '(1 3 4 5 8))) | |
| 235 | ||
| 236 | (pass-if "sort!" | |
| 237 | (equal? (sort! (copy-tree `(1 5 3 8 4 . ,%nil)) <) | |
| 238 | '(1 3 4 5 8))) | |
| 239 | ||
| 240 | (pass-if "stable-sort!" | |
| 241 | (equal? (stable-sort! (copy-tree `(1 5 3 8 4 . ,%nil)) <) | |
| 242 | '(1 3 4 5 8))) | |
| 243 | ||
| 04bb321a NJ |
244 | ) |
| 245 | ||
| 246 | (with-test-prefix "value preservation" | |
| 247 | ||
| 248 | (pass-if "car" | |
| 249 | (eq? (car (cons %nil 'a)) %nil)) | |
| 250 | ||
| 251 | (pass-if "cdr" | |
| 252 | (eq? (cdr (cons 'a %nil)) %nil)) | |
| 253 | ||
| 254 | (pass-if "vector-ref" | |
| 255 | (eq? (vector-ref (vector %nil) 0) %nil)) | |
| 256 | ||
| 257 | ) | |
| 258 | ||
| 259 | )) | |
| 260 | ||
| a64e6669 NJ |
261 | (if (defined? '%nil) |
| 262 | (use-modules (lang elisp interface))) | |
| 263 | ||
| 264 | (if (defined? '%nil) | |
| 265 | ||
| 266 | (with-test-prefix "elisp" | |
| 267 | ||
| 268 | (define (elisp-pass-if expr expected) | |
| 269 | (pass-if (with-output-to-string | |
| 270 | (lambda () | |
| 271 | (write expr))) | |
| 272 | (let ((calc (with-output-to-string | |
| 273 | (lambda () | |
| 274 | (write (eval-elisp expr)))))) | |
| 275 | (string=? calc expected)))) | |
| 276 | ||
| 277 | (elisp-pass-if '(and #f) "#f") | |
| 278 | (elisp-pass-if '(and #t) "#t") | |
| 279 | (elisp-pass-if '(and nil) "#nil") | |
| 280 | (elisp-pass-if '(and t) "#t") | |
| 281 | (elisp-pass-if '(and) "#t") | |
| 282 | (elisp-pass-if '(cond (nil t) (t 3)) "3") | |
| 283 | (elisp-pass-if '(cond (nil t) (t)) "#t") | |
| 284 | (elisp-pass-if '(cond (nil)) "#nil") | |
| 285 | (elisp-pass-if '(cond) "#nil") | |
| 286 | (elisp-pass-if '(if #f 'a 'b) "b") | |
| 287 | (elisp-pass-if '(if #t 'a 'b) "a") | |
| 288 | (elisp-pass-if '(if '() 'a 'b) "b") | |
| 289 | (elisp-pass-if '(if nil 'a 'b) "b") | |
| 290 | (elisp-pass-if '(if nil 1 2 3 4) "4") | |
| 291 | (elisp-pass-if '(if nil 1 2) "2") | |
| 292 | (elisp-pass-if '(if nil 1) "#nil") | |
| 293 | (elisp-pass-if '(if t 1 2) "1") | |
| 294 | (elisp-pass-if '(if t 1) "1") | |
| 295 | (elisp-pass-if '(let (a) a) "#nil") | |
| 296 | (elisp-pass-if '(let* (a) a) "#nil") | |
| 297 | (elisp-pass-if '(let* ((a 1) (b (* a 2))) b) "2") | |
| 298 | (elisp-pass-if '(memq '() '(())) "(())") | |
| 299 | (elisp-pass-if '(memq '() '(nil)) "(#nil)") | |
| 300 | (elisp-pass-if '(memq '() '(t)) "#nil") | |
| 301 | (elisp-pass-if '(memq nil '(())) "(())") | |
| 302 | (elisp-pass-if '(memq nil '(nil)) "(#nil)") | |
| 303 | (elisp-pass-if '(memq nil (list nil)) "(#nil)") | |
| 304 | (elisp-pass-if '(null '#f) "#t") | |
| 305 | (elisp-pass-if '(null '()) "#t") | |
| 306 | (elisp-pass-if '(null 'nil) "#t") | |
| 307 | (elisp-pass-if '(null nil) "#t") | |
| 308 | (elisp-pass-if '(or 1 2 3) "1") | |
| 309 | (elisp-pass-if '(or nil t nil) "#t") | |
| 310 | (elisp-pass-if '(or nil) "#nil") | |
| 311 | (elisp-pass-if '(or t nil t) "#t") | |
| 312 | (elisp-pass-if '(or t) "#t") | |
| 313 | (elisp-pass-if '(or) "#nil") | |
| 314 | (elisp-pass-if '(prog1 1 2 3) "1") | |
| 315 | (elisp-pass-if '(prog2 1 2 3) "2") | |
| 316 | (elisp-pass-if '(progn 1 2 3) "3") | |
| 317 | (elisp-pass-if '(while nil 1) "#nil") | |
| 318 | ||
| 319 | (elisp-pass-if '(defun testf (x y &optional o &rest r) (list x y o r)) "testf") | |
| 320 | (elisp-pass-if '(testf 1 2) "(1 2 #nil #nil)") | |
| 321 | (elisp-pass-if '(testf 1 2 3 4 5 56) "(1 2 3 (4 5 56))") | |
| 322 | ;; NB `lambda' in Emacs is self-quoting, but that's only after | |
| 323 | ;; loading the macro definition of lambda in subr.el. | |
| 324 | (elisp-pass-if '(function (lambda (x y &optional o &rest r) (list x y o r))) "(lambda (x y &optional o &rest r) (list x y o r))") | |
| 325 | (elisp-pass-if '(funcall (lambda (x y &optional o &rest r) (list x y o r)) 1 2 3 4) "(1 2 3 (4))") | |
| 326 | (elisp-pass-if '(apply (lambda (x y &optional o &rest r) (list x y o r)) 1 2 3 nil) "(1 2 3 #nil)") | |
| 327 | ||
| 328 | (elisp-pass-if '(setq x 3) "3") | |
| 329 | (elisp-pass-if '(defvar x 4) "x") | |
| 330 | (elisp-pass-if 'x "3") | |
| 331 | ||
| 332 | )) | |
| 333 | ||
| 04bb321a | 334 | ;;; elisp.test ends here |