Mercurial > hg > xemacs-beta

comparison tests/basic-lisp.el @ 272:c5d627a313b1 r21-0b34

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b34
author cvs
date Mon, 13 Aug 2007 10:28:48 +0200
parents
children
comparison
equal deleted inserted replaced
271:c7b7086b0a39 272:c5d627a313b1
1 ;;; Test basic Lisp functionality
2
3 ;;(when (not (boundp 'foo)) (setq foo 1))
4 ;;(incf foo)
5 ;;(print foo)
6
7 (let ((my-vector [1 2 3 4])
8 (my-bit-vector (bit-vector 1 0 1 0))
9 (my-string "1234")
10 (my-list '(1 2 3 4)))
11
12 ;;(Assert (fooooo)) ;; Generate Other failure
13 ;;(Assert (eq 1 2)) ;; Generate Assertion failure
14
15 (Assert (eq (elt my-vector 0) 1))
16 (Assert (eq (elt my-bit-vector 0) 1))
17 (Assert (eq (elt my-string 0) ?1))
18 (Assert (eq (elt my-list 0) 1))
19
20 (Assert (eq 4 (length my-vector)))
21 (Assert (eq 4 (length my-bit-vector)))
22 (Assert (eq 4 (length my-string)))
23
24 (fillarray my-vector 5)
25 (fillarray my-bit-vector 1)
26 (fillarray my-string ?5)
27
28 (Assert (eq 4 (length my-vector)))
29 (Assert (eq 4 (length my-bit-vector)))
30 (Assert (eq 4 (length my-string)))
31
32 (Assert (eq (elt my-vector 0) 5))
33 (Assert (eq (elt my-bit-vector 0) 1))
34 (Assert (eq (elt my-string 0) ?5))
35
36 (Assert (eq (elt my-vector 3) 5))
37 (Assert (eq (elt my-bit-vector 3) 1))
38 (Assert (eq (elt my-string 3) ?5))
39
40 (fillarray my-bit-vector 0)
41 (Assert (eq 4 (length my-bit-vector)))
42 (Assert (eq (elt my-bit-vector 2) 0))
43
44 ;; Test nconc
45 (let ((x (list 0 1 2)))
46 (Assert (eq (nconc) nil))
47 (Assert (eq (nconc nil) nil))
48 (Assert (eq (nconc nil x) x))
49 (Assert (eq (nconc x nil) x))
50 (let ((y (nconc x nil (list 3 4 5) nil)))
51 (Assert (eq (length y) 6))
52 (Assert (eq (nth 3 y) 3))
53 ))
54 )
55
56 ;;; Old cruft
57 ;;;(run-tests)
58
59 ;(defmacro Assert (assertion)
60 ; `(condition-case error
61 ; (progn
62 ; (assert ,assertion)
63 ; (princ (format "Assertion passed: %S" (quote ,assertion)))
64 ; (terpri)
65 ; (incf Assert-successes))
66 ; (cl-assertion-failed
67 ; (princ (format "Assertion failed: %S" (quote ,assertion)))
68 ; (terpri)
69 ; (incf Assert-failures))
70 ; (t (princ (format "Test harness error: %S" error))
71 ; (terpri)
72 ; (incf Harness-failures)
73 ; )))
74
75
76 ;(defun run-tests ()
77 ; (with-output-to-temp-buffer "*Test-Log*"
78 ; (let ((Assert-successes 0)
79 ; (Assert-failures 0)
80 ; (Harness-failures 0))
81 ; (basic-lisp-test)
82 ; (byte-compile 'basic-lisp-test)
83 ; (basic-lisp-test)
84 ; (print (format "%d successes, %d assertion failures, %d harness failures"
85 ; Assert-successes
86 ; Assert-failures
87 ; Harness-failures)))))
88
89 ;(defun the-test ()