Mercurial > hg > xemacs-beta

comparison tests/automated/lisp-tests.el @ 412:697ef44129c6 r21-2-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-14
author cvs
date Mon, 13 Aug 2007 11:20:41 +0200
parents 74fd4e045ea6
children da8ed4261e83
comparison
equal deleted inserted replaced
411:12e008d41344 412:697ef44129c6
227 (Assert (= (+ 1.0 3.0 0.0) 4.0)) 227 (Assert (= (+ 1.0 3.0 0.0) 4.0))
228 (Assert (= (+ 1 1.0) 2.0)) 228 (Assert (= (+ 1 1.0) 2.0))
229 (Assert (= (+ 1.0 1) 2.0)) 229 (Assert (= (+ 1.0 1) 2.0))
230 (Assert (= (+ 1.0 1 1) 3.0)) 230 (Assert (= (+ 1.0 1 1) 3.0))
231 (Assert (= (+ 1 1 1.0) 3.0)) 231 (Assert (= (+ 1 1 1.0) 3.0))
232 (Assert (eq (1+ most-positive-fixnum) most-negative-fixnum))
233 (Assert (eq (+ most-positive-fixnum 1) most-negative-fixnum))
234 232
235 ;; Test `-' 233 ;; Test `-'
236 (Check-Error wrong-number-of-arguments (-)) 234 (Check-Error wrong-number-of-arguments (-))
237 (Assert (eq (- 0) 0)) 235 (Assert (eq (- 0) 0))
238 (Assert (eq (- 1) -1)) 236 (Assert (eq (- 1) -1))
252 (Assert (= (- zero zero) 0)) 250 (Assert (= (- zero zero) 0))
253 (Assert (= (- zero one one) -2)))) 251 (Assert (= (- zero one one) -2))))
254 252
255 (Assert (= (- 1.5 1) .5)) 253 (Assert (= (- 1.5 1) .5))
256 (Assert (= (- 1 1.5) (- .5))) 254 (Assert (= (- 1 1.5) (- .5)))
257
258 (Assert (eq (1- most-negative-fixnum) most-positive-fixnum))
259 (Assert (eq (- most-negative-fixnum 1) most-positive-fixnum))
260 255
261 ;; Test `/' 256 ;; Test `/'
262 257
263 ;; Test division by zero errors 258 ;; Test division by zero errors
264 (dolist (zero '(0 0.0 ?\0)) 259 (dolist (zero '(0 0.0 ?\0))
753 748
754 (Check-Error wrong-type-argument (mapconcat #'identity (current-buffer) "foo")) 749 (Check-Error wrong-type-argument (mapconcat #'identity (current-buffer) "foo"))
755 (Assert (equal (mapconcat #'identity '("1" "2" "3") "|") "1|2|3")) 750 (Assert (equal (mapconcat #'identity '("1" "2" "3") "|") "1|2|3"))
756 (Assert (equal (mapconcat #'identity ["1" "2" "3"] "|") "1|2|3")) 751 (Assert (equal (mapconcat #'identity ["1" "2" "3"] "|") "1|2|3"))
757 752
758 ;; The following 2 functions used to crash XEmacs via mapcar1().
759 ;; We don't test the actual values of the mapcar, since they're undefined.
760 (Assert
761 (let ((x (list (cons 1 1) (cons 2 2) (cons 3 3))))
762 (mapcar
763 (lambda (y)
764 "Devious evil mapping function"
765 (when (eq (car y) 2) ; go out onto a limb
766 (setcdr x nil) ; cut it off behind us
767 (garbage-collect)) ; are we riding a magic broomstick?
768 (car y)) ; sorry, hard landing
769 x)))
770
771 (Assert
772 (let ((x (list (cons 1 1) (cons 2 2) (cons 3 3))))
773 (mapcar
774 (lambda (y)
775 "Devious evil mapping function"
776 (when (eq (car y) 1)
777 (setcdr (cdr x) 42)) ; drop a brick wall onto the freeway
778 (car y))
779 x)))
780
781 ;;----------------------------------------------------- 753 ;;-----------------------------------------------------
782 ;; Test vector functions 754 ;; Test vector functions
783 ;;----------------------------------------------------- 755 ;;-----------------------------------------------------
784 (Assert (equal [1 2 3] [1 2 3])) 756 (Assert (equal [1 2 3] [1 2 3]))
785 (Assert (equal [] [])) 757 (Assert (equal [] []))
811 (make-local-variable 'test-emacs-buffer-local-variable) 783 (make-local-variable 'test-emacs-buffer-local-variable)
812 (byte-compile 784 (byte-compile
813 (defun test-emacs-buffer-local-parameter (test-emacs-buffer-local-variable) 785 (defun test-emacs-buffer-local-parameter (test-emacs-buffer-local-variable)
814 (setq test-emacs-buffer-local-variable nil))) 786 (setq test-emacs-buffer-local-variable nil)))
815 (test-emacs-buffer-local-parameter nil) 787 (test-emacs-buffer-local-parameter nil)
816
817 ;;-----------------------------------------------------
818 ;; Test split-string
819 ;;-----------------------------------------------------
820 ;; Hrvoje didn't like these tests so I'm disabling them for now. -sb
821 ;(Assert (equal (split-string "foo" "") '("" "f" "o" "o" "")))
822 ;(Assert (equal (split-string "foo" "^") '("" "foo")))
823 ;(Assert (equal (split-string "foo" "$") '("foo" "")))
824 (Assert (equal (split-string "foo,bar" ",") '("foo" "bar")))
825 (Assert (equal (split-string ",foo,bar," ",") '("" "foo" "bar" "")))
826 (Assert (equal (split-string ",foo,bar," "^,") '("" "foo,bar,")))
827 (Assert (equal (split-string ",foo,bar," ",$") '(",foo,bar" "")))
828 (Assert (equal (split-string ",foo,,bar," ",") '("" "foo" "" "bar" "")))
829 (Assert (equal (split-string "foo,,,bar" ",") '("foo" "" "" "bar")))
830 (Assert (equal (split-string "foo,,bar,," ",") '("foo" "" "bar" "" "")))
831 (Assert (equal (split-string "foo,,bar" ",+") '("foo" "bar")))
832 (Assert (equal (split-string ",foo,,bar," ",+") '("" "foo" "bar" "")))
833
834 ;;-----------------------------------------------------
835 ;; Test near-text buffer functions.
836 ;;-----------------------------------------------------
837 (with-temp-buffer
838 (erase-buffer)
839 (Assert (eq (char-before) nil))
840 (Assert (eq (char-before (point)) nil))
841 (Assert (eq (char-before (point-marker)) nil))
842 (Assert (eq (char-before (point) (current-buffer)) nil))
843 (Assert (eq (char-before (point-marker) (current-buffer)) nil))
844 (Assert (eq (char-after) nil))
845 (Assert (eq (char-after (point)) nil))
846 (Assert (eq (char-after (point-marker)) nil))
847 (Assert (eq (char-after (point) (current-buffer)) nil))
848 (Assert (eq (char-after (point-marker) (current-buffer)) nil))
849 (Assert (eq (preceding-char) 0))
850 (Assert (eq (preceding-char (current-buffer)) 0))
851 (Assert (eq (following-char) 0))
852 (Assert (eq (following-char (current-buffer)) 0))
853 (insert "foobar")
854 (Assert (eq (char-before) ?r))
855 (Assert (eq (char-after) nil))
856 (Assert (eq (preceding-char) ?r))
857 (Assert (eq (following-char) 0))
858 (goto-char (point-min))
859 (Assert (eq (char-before) nil))
860 (Assert (eq (char-after) ?f))
861 (Assert (eq (preceding-char) 0))
862 (Assert (eq (following-char) ?f))
863 )
864
865 ;;-----------------------------------------------------
866 ;; Test plist manipulation functions.
867 ;;-----------------------------------------------------
868 (let ((sym (make-symbol "test-symbol")))
869 (Assert (eq t (get* sym t t)))
870 (Assert (eq t (get sym t t)))
871 (Assert (eq t (getf nil t t)))
872 (Assert (eq t (plist-get nil t t)))
873 (put sym 'bar 'baz)
874 (Assert (eq 'baz (get sym 'bar)))
875 (Assert (eq 'baz (getf '(bar baz) 'bar)))
876 (Assert (eq 'baz (getf (symbol-plist sym) 'bar)))
877 (Assert (eq 2 (getf '(1 2) 1)))
878 (Assert (eq 4 (put sym 3 4)))
879 (Assert (eq 4 (get sym 3)))
880 (Assert (eq t (remprop sym 3)))
881 (Assert (eq nil (remprop sym 3)))
882 (Assert (eq 5 (get sym 3 5)))
883 )
884
885 (loop for obj in
886 (list (make-symbol "test-symbol")
887 "test-string"
888 (make-extent nil nil nil)
889 (make-face 'test-face))
890 do
891 (Assert (eq 2 (get obj ?1 2)))
892 (Assert (eq 4 (put obj ?3 4)))
893 (Assert (eq 4 (get obj ?3)))
894 (when (or (stringp obj) (symbolp obj))
895 (Assert (equal '(?3 4) (object-plist obj))))
896 (Assert (eq t (remprop obj ?3)))
897 (when (or (stringp obj) (symbolp obj))
898 (Assert (eq '() (object-plist obj))))
899 (Assert (eq nil (remprop obj ?3)))
900 (when (or (stringp obj) (symbolp obj))
901 (Assert (eq '() (object-plist obj))))
902 (Assert (eq 5 (get obj ?3 5)))
903 )
904
905 (Check-Error-Message
906 error "Object type has no properties"
907 (get 2 'property))
908
909 (Check-Error-Message
910 error "Object type has no settable properties"
911 (put (current-buffer) 'property 'value))
912
913 (Check-Error-Message
914 error "Object type has no removable properties"
915 (remprop ?3 'property))
916
917 (Check-Error-Message
918 error "Object type has no properties"
919 (object-plist (symbol-function 'car)))
920
921 (Check-Error-Message
922 error "Can't remove property from object"
923 (remprop (make-extent nil nil nil) 'detachable))
924
925 ;;-----------------------------------------------------
926 ;; Test subseq
927 ;;-----------------------------------------------------
928 (Assert (equal (subseq nil 0) nil))
929 (Assert (equal (subseq [1 2 3] 0) [1 2 3]))
930 (Assert (equal (subseq [1 2 3] 1 -1) [2]))
931 (Assert (equal (subseq "123" 0) "123"))
932 (Assert (equal (subseq "1234" -3 -1) "23"))
933 (Assert (equal (subseq #*0011 0) #*0011))
934 (Assert (equal (subseq #*0011 -3 3) #*01))
935 (Assert (equal (subseq '(1 2 3) 0) '(1 2 3)))
936 (Assert (equal (subseq '(1 2 3 4) -3 nil) '(2 3 4)))
937
938 (Check-Error 'wrong-type-argument (subseq 3 2))
939 (Check-Error 'args-out-of-range (subseq [1 2 3] -42))
940 (Check-Error 'args-out-of-range (subseq [1 2 3] 0 42))