git.chise.org Git - chise/xemacs-chise.git.1/blob - tests/basic-lisp.el

   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 ()