;; feed l
(mapc-internal #'(lambda (e) (ase-add-heap h e)) l)
(Assert (= (ase-heap-size h) 8))
- (Assert (equal (ase-heap-to-list h) l))
+ (Assert-Equal (ase-heap-to-list h) l)
(Assert (= (ase-heap-size h) 8))
- (Assert (equal (ase-heap-to-list* h) l))
+ (Assert-Equal (ase-heap-to-list* h) l)
(Assert (= (ase-heap-size h) 0))
;; feed k
(mapc-internal #'(lambda (e) (ase-add-heap h e)) k)
(Assert (= (ase-heap-size h) 8))
- (Assert (equal (ase-heap-to-list h) l))
+ (Assert-Equal (ase-heap-to-list h) l)
(Assert (= (ase-heap-size h) 8))
- (Assert (equal (ase-heap-to-list* h) l))
+ (Assert-Equal (ase-heap-to-list* h) l)
(Assert (= (ase-heap-size h) 0)))
(let* ((l '(8 7 6 5 4 3 2 1))
;; feed l
(mapc-internal #'(lambda (e) (ase-add-heap h e)) l)
(Assert (= (ase-heap-size h) 8))
- (Assert (equal (ase-heap-to-vector h) v))
+ (Assert-Equal (ase-heap-to-vector h) v)
(Assert (= (ase-heap-size h) 8))
- (Assert (equal (ase-heap-to-vector* h) v))
+ (Assert-Equal (ase-heap-to-vector* h) v)
(Assert (= (ase-heap-size h) 0))
;; feed k
(mapc-internal #'(lambda (e) (ase-add-heap h e)) k)
(Assert (= (ase-heap-size h) 8))
- (Assert (equal (ase-heap-to-vector h) v))
+ (Assert-Equal (ase-heap-to-vector h) v)
(Assert (= (ase-heap-size h) 8))
- (Assert (equal (ase-heap-to-vector* h) v))
+ (Assert-Equal (ase-heap-to-vector* h) v)
(Assert (= (ase-heap-size h) 0)))
(let* ((l '(8 7 6 5 4 3 2 1))
;; feed l
(mapc-internal #'(lambda (e) (ase-add-heap h e)) l)
(Assert (= (ase-heap-size h) 8))
- (Assert (equal (ase-heap-to-dllist h) d))
+ (Assert-Equal (ase-heap-to-dllist h) d)
(Assert (= (ase-heap-size h) 8))
- (Assert (equal (ase-heap-to-dllist* h) d))
+ (Assert-Equal (ase-heap-to-dllist* h) d)
(Assert (= (ase-heap-size h) 0))
;; feed k
(mapc-internal #'(lambda (e) (ase-add-heap h e)) k)
(Assert (= (ase-heap-size h) 8))
- (Assert (equal (ase-heap-to-dllist h) d))
+ (Assert-Equal (ase-heap-to-dllist h) d)
(Assert (= (ase-heap-size h) 8))
- (Assert (equal (ase-heap-to-dllist* h) d))
+ (Assert-Equal (ase-heap-to-dllist* h) d)
(Assert (= (ase-heap-size h) 0))))
;;; testing coloured heaps
(insert string)
(setq length (base64-encode-region (point-min) (point-max) no-line-break))
(Assert (eq length (- (point-max) (point-min))))
- (Assert (equal (buffer-string) string-result))
+ (Assert-Equal (buffer-string) string-result)
;; partial
(erase-buffer)
(insert "random junk........\0\0';'eqwrkw[erpqf")
(insert "...more random junk.q,f3/.qrm314.r,m2typ' 2436T@W$^@$#^T@")
(setq length (base64-encode-region p1 p2 no-line-break))
(Assert (eq length (- p2 p1)))
- (Assert (equal (buffer-substring p1 p2) string-result))))
+ (Assert-Equal (buffer-substring p1 p2) string-result)))
string-result))
(defun bt-base64-decode-string (string)
(setq length (base64-decode-region (point-min) (point-max)))
(cond (string-result
(Assert (eq length (- (point-max) (point-min))))
- (Assert (equal (buffer-string) string-result)))
+ (Assert-Equal (buffer-string) string-result))
(t
(Assert (null length))
;; The buffer should not have been modified.
- (Assert (equal (buffer-string) string))))
+ (Assert-Equal (buffer-string) string)))
;; partial
(erase-buffer)
(insert "random junk........\0\0';'eqwrkw[erpqf")
(setq length (base64-decode-region p1 p2))
(cond (string-result
(Assert (eq length (- p2 p1)))
- (Assert (equal (buffer-substring p1 p2) string-result)))
+ (Assert-Equal (buffer-substring p1 p2) string-result))
(t
(Assert (null length))
;; The buffer should not have been modified.
- (Assert (equal (buffer-substring p1 p2) string))))))
+ (Assert-Equal (buffer-substring p1 p2) string)))))
string-result))
(defun bt-remove-newlines (str)
;;-----------------------------------------------------
(loop for (raw encoded) in bt-test-strings do
- (Assert (equal (bt-base64-encode-string raw) encoded))
+ (Assert-Equal (bt-base64-encode-string raw) encoded)
;; test the NO-LINE-BREAK flag
- (Assert (equal (bt-base64-encode-string raw t) (bt-remove-newlines encoded))))
+ (Assert-Equal (bt-base64-encode-string raw t) (bt-remove-newlines encoded)))
;; When Mule is around, Lisp programmers should make sure that the
;; buffer contains only characters whose `char-int' is in the [0, 256)
;;-----------------------------------------------------
(loop for (raw encoded) in bt-test-strings do
- (Assert (equal (bt-base64-decode-string encoded) raw))
- (Assert (equal (bt-base64-decode-string (bt-remove-newlines encoded)) raw)))
+ (Assert-Equal (bt-base64-decode-string encoded) raw)
+ (Assert-Equal (bt-base64-decode-string (bt-remove-newlines encoded)) raw))
;; Test errors
(dolist (str `("foo" "AAC" "foo\0bar" "====" "Zm=9v" ,bt-allchars))
;; Whitespace at the beginning, end, and middle.
(let ((mangled (concat bt-nonbase64-chars left bt-nonbase64-chars right
bt-nonbase64-chars)))
- (Assert (equal (bt-base64-decode-string mangled) raw)))
+ (Assert-Equal (bt-base64-decode-string mangled) raw))
;; Whitespace between every char.
(let ((mangled (concat bt-nonbase64-chars
(mapconcat #'char-to-string encoded
(apply #'string bt-nonbase64-chars))
bt-nonbase64-chars)))
- (Assert (equal (bt-base64-decode-string mangled) raw))))))
+ (Assert-Equal (bt-base64-decode-string mangled) raw)))))
;;-----------------------------------------------------
;; Mixed...
;; practically all aspects of the encoding and decoding process.
(loop for (raw ignored) in bt-test-strings do
- (Assert (equal (bt-base64-decode-string
+ (Assert-Equal (bt-base64-decode-string
(bt-base64-encode-string raw))
- raw))
- (Assert (equal (bt-base64-decode-string
+ raw)
+ (Assert-Equal (bt-base64-decode-string
(bt-base64-decode-string
(bt-base64-encode-string
(bt-base64-encode-string raw))))
- raw))
- (Assert (equal (bt-base64-decode-string
+ raw)
+ (Assert-Equal (bt-base64-decode-string
(bt-base64-decode-string
(bt-base64-decode-string
(bt-base64-encode-string
(bt-base64-encode-string
(bt-base64-encode-string raw))))))
- raw))
- (Assert (equal (bt-base64-decode-string
+ raw)
+ (Assert-Equal (bt-base64-decode-string
(bt-base64-decode-string
(bt-base64-decode-string
(bt-base64-decode-string
(bt-base64-encode-string
(bt-base64-encode-string
(bt-base64-encode-string raw))))))))
- raw))
- (Assert (equal (bt-base64-decode-string
+ raw)
+ (Assert-Equal (bt-base64-decode-string
(bt-base64-decode-string
(bt-base64-decode-string
(bt-base64-decode-string
(bt-base64-encode-string
(bt-base64-encode-string
(bt-base64-encode-string raw))))))))))
- raw)))
+ raw))
(eval '(let* ((x 1 2)) 3)))
(defmacro before-and-after-compile-equal (&rest form)
- `(Assert (equal (funcall (quote (lambda () ,@form)))
- (funcall (byte-compile (quote (lambda () ,@form)))))))
+ `(Assert-Equal (funcall (quote (lambda () ,@form)))
+ (funcall (byte-compile (quote (lambda () ,@form))))))
(defvar simplyamarker (point-min-marker))
((r0 = -1))))
;; 1-level normal 1 mapping
- (Assert (equal
+ (Assert-Equal
(mapcar
(lambda (val)
(ccl-test-map-multiple
'(0 99 100 101 102 103 104 105 106 107))
'((0 . -1) (99 . -1)
(1 . 0) (2 . 0) (3 . 0) (4 . 0) (5 . 0)
- (105 . -1) (106 . -1) (107 . -1))))
+ (105 . -1) (106 . -1) (107 . -1)))
- (Assert (equal
+ (Assert-Equal
(mapcar
(lambda (val)
(ccl-test-iterate-multiple-map
'(0 99 100 101 102 103 104 105 106 107))
'((0 . -1) (99 . -1)
(1 . 0) (2 . 0) (3 . 0) (4 . 0) (5 . 0)
- (105 . -1) (106 . -1) (107 . -1))))
+ (105 . -1) (106 . -1) (107 . -1)))
;; 1-level normal 2 mappings
- (Assert (equal
+ (Assert-Equal
(mapcar
(lambda (val)
(ccl-test-map-multiple
'(0 99 100 101 102 103 104 105 106 107))
'((0 . -1) (99 . -1) (1 . 0) (2 . 0)
(13 . 1) (4 . 0) (5 . 0) (16 . 1) (17 . 1)
- (107 . -1))))
+ (107 . -1)))
- (Assert (equal
+ (Assert-Equal
(mapcar
(lambda (val)
(ccl-test-iterate-multiple-map
[101 12 13 14 15 16 17])))
'(0 99 100 101 102 103 104 105 106 107))
'((0 . -1) (99 . -1) (1 . 0) (2 . 0) (3 . 0)
- (4 . 0) (5 . 0) (16 . 1) (17 . 1) (107 . -1))))
+ (4 . 0) (5 . 0) (16 . 1) (17 . 1) (107 . -1)))
;; 1-level normal 7 mappings
- (Assert (equal
+ (Assert-Equal
(mapcar
(lambda (val)
(ccl-test-map-multiple
(105 . 2) (106 . 2) (1007 . 3) (108 . 2) (9999 . -1)
(10000 . -1) (10001 . -1) (10002 . -1) (10003 . -1)
(10004 . -1) (19999 . -1) (20000 . 5) (20001 . 5)
- (20002 . 5) (30000 . 6) (20004 . 5) (20005 . 5) (20006 . 5))))
+ (20002 . 5) (30000 . 6) (20004 . 5) (20005 . 5) (20006 . 5)))
- (Assert (equal
+ (Assert-Equal
(mapcar
(lambda (val)
(ccl-test-iterate-multiple-map
(105 . 2) (106 . 2) (1007 . 3) (108 . 2) (9999 . -1)
(10000 . -1) (10001 . -1) (10002 . -1) (10003 . -1)
(10004 . -1) (19999 . -1) (20000 . 5) (20001 . 5)
- (20002 . 5)(30000 . 6)(20004 . 5)(20005 . 5)(20006 . 5))))
+ (20002 . 5)(30000 . 6)(20004 . 5)(20005 . 5)(20006 . 5)))
;; 1-level 7 mappings including CCL call
- (Assert (equal
+ (Assert-Equal
(mapcar
(lambda (val)
(ccl-test-map-multiple
(1009 . 3) (1009 . 3) (9999 . -1) (10000 . -1)
(10001 . -1) (10002 . -1) (10003 . -1) (10004 . -1)
(19999 . -1) (20000 . 5) (20001 . 5) (20002 . 5)
- (30000 . 6)(20004 . 5)(20005 . 5)(20006 . 5))))
+ (30000 . 6)(20004 . 5)(20005 . 5)(20006 . 5)))
- (Assert (equal
+ (Assert-Equal
(mapcar
(lambda (val)
(ccl-test-iterate-multiple-map
(1009 . 3) (-3 . 0) (9999 . -1) (10000 . -1)
(10001 . -1) (10002 . -1) (10003 . -1) (10004 . -1)
(19999 . -1) (20000 . 5) (20001 . 5) (20002 . 5)
- (30000 . 6) (20004 . 5) (20005 . 5) (20006 . 5))))
+ (30000 . 6) (20004 . 5) (20005 . 5) (20006 . 5)))
;; 3-level mappings
- (Assert (equal
+ (Assert-Equal
(mapcar
(lambda (val)
(ccl-test-map-multiple
(30040 . 10) (30050 . 10) (10008 . 11) (10009 . 11)
(10010 . 11) (19999 . 11) (20000 . 11) (20001 . 11)
(20002 . 11) (20003 . 11) (20004 . 11) (20005 . 11)
- (20006 . 11))))
+ (20006 . 11)))
;; 3-level mappings including CCL call
- (Assert (equal
+ (Assert-Equal
(mapcar
(lambda (val)
(ccl-test-map-multiple
(10005 . 14) (30040 . 12) (1020008 . 12) (10008 . 14)
(10009 . 14) (10010 . 14) (19999 . 14) (20000 . 14)
(20001 . 14) (20002 . 14) (20003 . 14) (20004 . 14)
- (20005 . 14) (20006 . 14))))
+ (20005 . 14) (20006 . 14)))
;; All map-instruction tests ends here.
)
(test-database (db)
(Assert (databasep db))
(put-database "key1" "val1" db)
- (Assert (equal "val1" (get-database "key1" db)))
+ (Assert-Equal "val1" (get-database "key1" db))
(remove-database "key1" db)
- (Assert (equal nil (get-database "key1" db)))
+ (Assert-Equal nil (get-database "key1" db))
(close-database db)
(Assert (not (database-live-p db)))
(Assert (databasep db))))
(default-real-precision 128))
;; testing bigg selector
- (Assert (not (equal (real-part (read "2+3i")) 2)))
- (Assert (not (equal (imaginary-part (read "2+3i")) 3)))
- (Assert (not (equal (real-part 2+3i) 2)))
- (Assert (not (equal (imaginary-part 2+3i) 3)))
- (Assert (equal (real-part (read "2+3i")) (bigz 2)))
- (Assert (equal (imaginary-part (read "2+3i")) (bigz 3)))
- (Assert (equal (real-part 2+3i) (bigz 2)))
- (Assert (equal (imaginary-part 2+3i) (bigz 3)))
+ (Assert-Not-Equal (real-part (read "2+3i")) 2)
+ (Assert-Not-Equal (imaginary-part (read "2+3i")) 3)
+ (Assert-Not-Equal (real-part 2+3i) 2)
+ (Assert-Not-Equal (imaginary-part 2+3i) 3)
+ (Assert-Equal (real-part (read "2+3i")) (bigz 2))
+ (Assert-Equal (imaginary-part (read "2+3i")) (bigz 3))
+ (Assert-Equal (real-part 2+3i) (bigz 2))
+ (Assert-Equal (imaginary-part 2+3i) (bigz 3))
;; use numerical equality
(Assert (= (real-part (read "2+3i")) 2))
(Assert (= (imaginary-part (read "2+3i")) 3))
(Assert (= (imaginary-part 2+3i) (bigz 3)))
;; testing bigg constructor
- (Assert (not (equal (real-part (make-bigg 1 2)) 1)))
- (Assert (not (equal (imaginary-part (make-bigg 1 2)) 2)))
- (Assert (equal (real-part (make-bigg 1 2)) (bigz 1)))
- (Assert (equal (imaginary-part (make-bigg 1 2)) (bigz 2)))
+ (Assert-Not-Equal (real-part (make-bigg 1 2)) 1)
+ (Assert-Not-Equal (imaginary-part (make-bigg 1 2)) 2)
+ (Assert-Equal (real-part (make-bigg 1 2)) (bigz 1))
+ (Assert-Equal (imaginary-part (make-bigg 1 2)) (bigz 2))
(Assert (= (real-part (make-bigg 1 2)) 1))
(Assert (= (imaginary-part (make-bigg 1 2)) 2))
;; compare reader and constructor
- (Assert (equal (make-bigg 1.0 2.0) (read "1+2i")))
- (Assert (equal (make-bigg 1 2) (read "1+2i")))
+ (Assert-Equal (make-bigg 1.0 2.0) (read "1+2i"))
+ (Assert-Equal (make-bigg 1 2) (read "1+2i"))
(Assert (and (= (real-part (make-bigg 1.0 2.0))
(real-part (read "1+2i")))
(= (imaginary-part (make-bigg 1.0 2.0))
(default-real-precision 128))
;; testing bigc selector
- (Assert (equal (real-part (read "2.3+3.2i"))
- (read "2.3")))
- (Assert (equal (imaginary-part (read "2.3+3.2i"))
- (read "3.2")))
+ (Assert-Equal (real-part (read "2.3+3.2i"))
+ (read "2.3"))
+ (Assert-Equal (imaginary-part (read "2.3+3.2i"))
+ (read "3.2"))
;; use numerical equality
(Assert (= (real-part (read "2.3+3.2i"))
(read "2.3")))
(read "3.2")))
;; testing bigc constructor
- (Assert (not (equal (real-part (make-bigc 1 2)) 1)))
- (Assert (not (equal (imaginary-part (make-bigc 1 2)) 2)))
- (Assert (equal (real-part (make-bigc 1 2)) (bigfr 1)))
- (Assert (equal (imaginary-part (make-bigc 1 2)) (bigfr 2)))
+ (Assert-Not-Equal (real-part (make-bigc 1 2)) 1)
+ (Assert-Not-Equal (imaginary-part (make-bigc 1 2)) 2)
+ (Assert-Equal (real-part (make-bigc 1 2)) (bigfr 1))
+ (Assert-Equal (imaginary-part (make-bigc 1 2)) (bigfr 2))
(Assert (= (real-part (make-bigc 1 2)) 1))
(Assert (= (imaginary-part (make-bigc 1 2)) 2))
;; now compare reader and constructor
- (Assert (equal (make-bigc 1.0 2.0) (read "1.0+2.0i")))
- (Assert (equal (make-bigc 1 2) (read "1.0+2.0i")))
+ (Assert-Equal (make-bigc 1.0 2.0) (read "1.0+2.0i"))
+ (Assert-Equal (make-bigc 1 2) (read "1.0+2.0i"))
(Assert (and (= (real-part (make-bigc 1.0 2.0))
(real-part (read "1.0+2.0i")))
(= (imaginary-part (make-bigc 1.0 2.0))
;; Testing formatting output
;;-----------------------------------------------------
-(Assert (equal (format "%d" 2) "2"))
-(Assert (equal (format "%d" -2) "-2"))
-(Assert (equal (format "%2.2E" -2) "-2.00E+00"))
+(Assert-Equal (format "%d" 2) "2")
+(Assert-Equal (format "%d" -2) "-2")
+(Assert-Equal (format "%2.2E" -2) "-2.00E+00")
-(Assert (equal (format "%x" 100) "64"))
-(Assert (equal (format "%#x" 100) "0x64"))
-(Assert (equal (format "%X" 122) "7A"))
-(Assert (equal (format "%.4X" 122) "007A"))
-(Assert (equal (format "%4o" 100) " 144"))
-(Assert (equal (format "%x" 10.58) "a"))
-(Assert (equal (format "%o" 10.58) "12"))
-(Assert (equal (format "%#o" 10.58) "0o12"))
+(Assert-Equal (format "%x" 100) "64")
+(Assert-Equal (format "%#x" 100) "0x64")
+(Assert-Equal (format "%X" 122) "7A")
+(Assert-Equal (format "%.4X" 122) "007A")
+(Assert-Equal (format "%4o" 100) " 144")
+(Assert-Equal (format "%x" 10.58) "a")
+(Assert-Equal (format "%o" 10.58) "12")
+(Assert-Equal (format "%#o" 10.58) "0o12")
;; floats
(let ((forms
;;; testing arithmetics with infinity symbols
(let* ((ASSERT-EQUAL
#'(lambda (form result)
- (eval `(Assert (equal ,form ,result)))))
+ (eval `(Assert-Equal ,form ,result))))
(ASSERT-=
#'(lambda (form result)
(eval `(Assert (= ,form ,result)))))
(eval `(Assert (onep (coerce-number 1.0 ',type))))
;; lifts are idempotent
- (eval `(Assert (equal
+ (eval `(Assert-Equal
(coerce-number 0 ',type)
- (coerce-number (coerce-number 0 ',type) ',type))))
- (eval `(Assert (equal
+ (coerce-number (coerce-number 0 ',type) ',type)))
+ (eval `(Assert-Equal
(coerce-number 1 ',type)
- (coerce-number (coerce-number 1 ',type) ',type))))
+ (coerce-number (coerce-number 1 ',type) ',type)))
(eval `(Assert (= (coerce-number 0 ',type)
(coerce-number (coerce-number 0 ',type) ',type))))
(eval `(Assert (= (coerce-number 1 ',type)
(mapc #'(lambda (fun)
(when (fboundp fun)
(mapc #'(lambda (val)
- (eval `(Assert (equal (,fun ,val) not-a-number))))
+ (eval `(Assert-Equal (,fun ,val) not-a-number)))
vals)))
nan-funs)
(mapc #'(lambda (fun)
(eval `(Assert (= (+ (zero ,num) ,num) ,num)))
(eval `(Assert (= (* (zero ,num) ,num) (zero ,num)))))
(unless (comparablep num)
- (eval `(Assert (equal (+ (zero ,num) ,num) ,num)))
+ (eval `(Assert-Equal (+ (zero ,num) ,num) ,num))
(eval `(Assert
(equal (* (zero ,num) ,num) (zero ,num)))))
;; ones
(eval `(Assert (= (* (one ,num) ,num) ,num)))
(eval `(Assert (= (zero ,num) (1- (one ,num))))))
(unless (comparablep num)
- (eval `(Assert (equal (* (one ,num) ,num) ,num)))
- (eval `(Assert (equal (zero ,num) (1- (one ,num)))))))
+ (eval `(Assert-Equal (* (one ,num) ,num) ,num))
+ (eval `(Assert-Equal (zero ,num) (1- (one ,num))))))
(symbol-value cat)))
'(ints bigzs bigqs floats bigfs bigfrs biggs bigcs)))
(let ((e (make-extent 4 7)))
;; current state: "###[eee)###"
;; 123 456 789
- (Assert (equal (et-range e) '(4 7)))
+ (Assert-Equal (et-range e) '(4 7))
(et-insert-at "xxx" 4)
;; current state: "###[xxxeee)###"
;; 123 456789 012
- (Assert (equal (et-range e) '(4 10)))
+ (Assert-Equal (et-range e) '(4 10))
(et-insert-at "yyy" 7)
;; current state: "###[xxxyyyeee)###"
;; 123 456789012 345
- (Assert (equal (et-range e) '(4 13)))
+ (Assert-Equal (et-range e) '(4 13))
(et-insert-at "zzz" 13)
;; current state: "###[xxxyyyeee)zzz###"
;; 123 456789012 345678
- (Assert (equal (et-range e) '(4 13)))
+ (Assert-Equal (et-range e) '(4 13))
))
;; closed-closed
;; current state: "###[eee]###"
;; 123 456 789
- (Assert (equal (et-range e) '(4 7)))
+ (Assert-Equal (et-range e) '(4 7))
(et-insert-at "xxx" 4)
;; current state: "###[xxxeee]###"
;; 123 456789 012
- (Assert (equal (et-range e) '(4 10)))
+ (Assert-Equal (et-range e) '(4 10))
(et-insert-at "yyy" 7)
;; current state: "###[xxxyyyeee]###"
;; 123 456789012 345
- (Assert (equal (et-range e) '(4 13)))
+ (Assert-Equal (et-range e) '(4 13))
(et-insert-at "zzz" 13)
;; current state: "###[xxxyyyeeezzz]###"
;; 123 456789012345 678
- (Assert (equal (et-range e) '(4 16)))
+ (Assert-Equal (et-range e) '(4 16))
))
;; open-closed
;; current state: "###(eee]###"
;; 123 456 789
- (Assert (equal (et-range e) '(4 7)))
+ (Assert-Equal (et-range e) '(4 7))
(et-insert-at "xxx" 4)
;; current state: "###xxx(eee]###"
;; 123456 789 012
- (Assert (equal (et-range e) '(7 10)))
+ (Assert-Equal (et-range e) '(7 10))
(et-insert-at "yyy" 8)
;; current state: "###xxx(eyyyee]###"
;; 123456 789012 345
- (Assert (equal (et-range e) '(7 13)))
+ (Assert-Equal (et-range e) '(7 13))
(et-insert-at "zzz" 13)
;; current state: "###xxx(eyyyeezzz]###"
;; 123456 789012345 678
- (Assert (equal (et-range e) '(7 16)))
+ (Assert-Equal (et-range e) '(7 16))
))
;; open-open
;; current state: "###(eee)###"
;; 123 456 789
- (Assert (equal (et-range e) '(4 7)))
+ (Assert-Equal (et-range e) '(4 7))
(et-insert-at "xxx" 4)
;; current state: "###xxx(eee)###"
;; 123456 789 012
- (Assert (equal (et-range e) '(7 10)))
+ (Assert-Equal (et-range e) '(7 10))
(et-insert-at "yyy" 8)
;; current state: "###xxx(eyyyee)###"
;; 123456 789012 345
- (Assert (equal (et-range e) '(7 13)))
+ (Assert-Equal (et-range e) '(7 13))
(et-insert-at "zzz" 13)
;; current state: "###xxx(eyyyee)zzz###"
;; 123456 789012 345678
- (Assert (equal (et-range e) '(7 13)))
+ (Assert-Equal (et-range e) '(7 13))
))
;; current state: xx[xxxxxx]xx
;; 12 345678 90
- (Assert (equal (et-range e) '(3 9)))
+ (Assert-Equal (et-range e) '(3 9))
(delete-region 1 2)
;; current state: x[xxxxxx]xx
;; 1 234567 89
- (Assert (equal (et-range e) '(2 8)))
+ (Assert-Equal (et-range e) '(2 8))
(delete-region 2 4)
;; current state: x[xxxx]xx
;; 1 2345 67
- (Assert (equal (et-range e) '(2 6)))
+ (Assert-Equal (et-range e) '(2 6))
(delete-region 1 3)
;; current state: [xxx]xx
;; 123 45
- (Assert (equal (et-range e) '(1 4)))
+ (Assert-Equal (et-range e) '(1 4))
(delete-region 3 5)
;; current state: [xx]x
;; 12 3
- (Assert (equal (et-range e) '(1 3)))
+ (Assert-Equal (et-range e) '(1 3))
)))
(delete-region 4 6)
;; ###[]###
(Assert (not (extent-detached-p e)))
- (Assert (equal (et-range e) '(4 4)))
+ (Assert-Equal (et-range e) '(4 4))
))
)
(insert "######")
(let ((e (make-extent 4 4)))
(et-insert-at "foo" 4)
- (Assert (equal (et-range e) '(4 4)))))
+ (Assert-Equal (et-range e) '(4 4))))
;; open-closed (should move)
(with-temp-buffer
(put e 'start-open t)
(put e 'end-closed t)
(et-insert-at "foo" 4)
- (Assert (equal (et-range e) '(7 7)))))
+ (Assert-Equal (et-range e) '(7 7))))
;; closed-closed (should extend)
(with-temp-buffer
(let ((e (make-extent 4 4)))
(put e 'end-closed t)
(et-insert-at "foo" 4)
- (Assert (equal (et-range e) '(4 7)))))
+ (Assert-Equal (et-range e) '(4 7))))
;; open-open (illegal; forced to behave like closed-open)
(with-temp-buffer
(let ((e (make-extent 4 4)))
(put e 'start-open t)
(et-insert-at "foo" 4)
- (Assert (equal (et-range e) '(4 4)))))
+ (Assert-Equal (et-range e) '(4 4))))
;; Testing numbers
;;-----------------------------------------------------
-(Assert (equal (format "%d" 2) "2"))
-(Assert (equal (format "%d" -2) "-2"))
-(Assert (equal (format "%2.2E" -2) "-2.00E+00"))
-
-(Assert (equal (format "%\0s" 'a) "a"))
-
-(Assert (equal (format "%x" 100) "64"))
-(Assert (equal (format "%#x" 100) "0x64"))
-(Assert (equal (format "%X" 122) "7A"))
-(Assert (equal (format "%.4X" 122) "007A"))
-(Assert (equal (format "%4o" 100) " 144"))
-(Assert (equal (format "%x" 10.58) "a"))
-(Assert (equal (format "%o" 10.58) "12"))
-(Assert (equal (format "%#o" 10.58) "0o12"))
-
-(Assert (equal (format "%#8x" 1) " 0x1"))
-(Assert (equal (format "%#+8x" 1) " +0x1"))
-(Assert (equal (format "%#08x" 1) "0x000001"))
-(Assert (equal (format "%#+08x" 1) "+0x00001"))
-(Assert (equal (format "%# 08x" 1) " 0x00001"))
-(Assert (equal (format "%#.8x" 1) "0x00000001"))
-(Assert (equal (format "%#+.8x" 1) "+0x00000001"))
-(Assert (equal (format "%#+ .8x" 1) "+0x00000001")) ;; plus has precedence
-(Assert (equal (format "%# .8x" 1) " 0x00000001"))
+(Assert-Equal (format "%d" 2) "2")
+(Assert-Equal (format "%d" -2) "-2")
+(Assert-Equal (format "%2.2E" -2) "-2.00E+00")
+
+(Assert-Equal (format "%\0s" 'a) "a")
+
+(Assert-Equal (format "%x" 100) "64")
+(Assert-Equal (format "%#x" 100) "0x64")
+(Assert-Equal (format "%X" 122) "7A")
+(Assert-Equal (format "%.4X" 122) "007A")
+(Assert-Equal (format "%4o" 100) " 144")
+(Assert-Equal (format "%x" 10.58) "a")
+(Assert-Equal (format "%o" 10.58) "12")
+(Assert-Equal (format "%#o" 10.58) "0o12")
+
+(Assert-Equal (format "%#8x" 1) " 0x1")
+(Assert-Equal (format "%#+8x" 1) " +0x1")
+(Assert-Equal (format "%#08x" 1) "0x000001")
+(Assert-Equal (format "%#+08x" 1) "+0x00001")
+(Assert-Equal (format "%# 08x" 1) " 0x00001")
+(Assert-Equal (format "%#.8x" 1) "0x00000001")
+(Assert-Equal (format "%#+.8x" 1) "+0x00000001")
+(Assert-Equal (format "%#+ .8x" 1) "+0x00000001") ;; plus has precedence
+(Assert-Equal (format "%# .8x" 1) " 0x00000001")
;; floats
(let ((forms
forms))
;; exterior precision
-(Assert (equal (format "%*d" 10 4) " 4"))
-(Assert (equal (format "%#!_*x" 10 4) "_______0x4"))
+(Assert-Equal (format "%*d" 10 4) " 4")
+(Assert-Equal (format "%#!_*x" 10 4) "_______0x4")
;; lisp reader syntax
-(Assert (equal (format "%#~x" 19) "0x13"))
-(Assert (equal (format "%#~x" -19) "0x-13"))
-(Assert (equal (format "%&x" 19) "#x13"))
-(Assert (equal (format "%&~x" 19) "#x13"))
-(Assert (equal (format "%&x" -19) "#x-13"))
-(Assert (equal (format "%&~x" -19) "#x-13"))
+(Assert-Equal (format "%#~x" 19) "0x13")
+(Assert-Equal (format "%#~x" -19) "0x-13")
+(Assert-Equal (format "%&x" 19) "#x13")
+(Assert-Equal (format "%&~x" 19) "#x13")
+(Assert-Equal (format "%&x" -19) "#x-13")
+(Assert-Equal (format "%&~x" -19) "#x-13")
;; check spacing
-(Assert (equal (format "%&+x" 19) "#x+13"))
-(Assert (equal (format "%&~+x" 19) "#x+13"))
-(Assert (equal (format "%&+x" -19) "#x-13"))
-(Assert (equal (format "%&~+x" -19) "#x-13"))
-(Assert (equal (format "%& x" 19) "#x13"))
-(Assert (equal (format "%&~ x" 19) "#x13"))
-(Assert (equal (format "%& x" -19) "#x-13"))
-(Assert (equal (format "%&~ x" -19) "#x-13"))
-
-(Assert (equal (format "%&0*x" 10 4) "#x00000004"))
-(Assert (equal (format "%&0.*x" 10 4) "#x0000000004"))
+(Assert-Equal (format "%&+x" 19) "#x+13")
+(Assert-Equal (format "%&~+x" 19) "#x+13")
+(Assert-Equal (format "%&+x" -19) "#x-13")
+(Assert-Equal (format "%&~+x" -19) "#x-13")
+(Assert-Equal (format "%& x" 19) "#x13")
+(Assert-Equal (format "%&~ x" 19) "#x13")
+(Assert-Equal (format "%& x" -19) "#x-13")
+(Assert-Equal (format "%&~ x" -19) "#x-13")
+
+(Assert-Equal (format "%&0*x" 10 4) "#x00000004")
+(Assert-Equal (format "%&0.*x" 10 4) "#x0000000004")
;;; format-tests.el ends here
:rehash-size rehash-size
:rehash-threshold rehash-threshold
:weakness weakness)))
- (Assert (equal ht (car (let ((print-readably t))
- (read-from-string (prin1-to-string ht))))))
+ (Assert-Equal ht (car (let ((print-readably t))
+ (read-from-string (prin1-to-string ht)))))
(Assert (eq test (hash-table-test ht)))
(Assert (<= size (hash-table-size ht)))
(Assert (eql rehash-size (hash-table-rehash-size ht)))
(weak key-and-value)
(key-weak key)
(value-weak value))
- do (Assert (equal (make-hash-table :type type)
- (make-hash-table :weakness weakness))))
+ do (Assert-Equal (make-hash-table :type type)
+ (make-hash-table :weakness weakness)))
-(Assert (not (equal (make-hash-table :weakness nil)
- (make-hash-table :weakness t))))
+(Assert-Not-Equal (make-hash-table :weakness nil)
+ (make-hash-table :weakness t))
(let ((ht (make-hash-table :size 20 :rehash-threshold .75 :test 'eq))
(size 80))
(clrhash ht)
(Assert (= 0 (hash-table-count ht)))
- (Assert (equal ht (copy-hash-table ht)))
+ (Assert-Equal ht (copy-hash-table ht))
(dotimes (j size)
(setf (gethash (int-to-string j) ht) (- j))
(flet ((check-copy
(ht)
(let ((copy-of-ht (copy-hash-table ht)))
- (Assert (equal ht copy-of-ht))
+ (Assert-Equal ht copy-of-ht)
(Assert (not (eq ht copy-of-ht)))
(Assert (eq (hash-table-count ht) (hash-table-count copy-of-ht)))
(Assert (eq (hash-table-type ht) (hash-table-type copy-of-ht)))
(let ((h1 #s(hashtable weakness t rehash-size 3.0 rehash-threshold .2 test eq data (1 2 3 4)))
(h2 #s(hash-table weakness t rehash-size 3.0 rehash-threshold .2 test eq data (1 2 3 4)))
(h3 (make-hash-table :weakness t :rehash-size 3.0 :rehash-threshold .2 :test 'eq)))
- (Assert (equal h1 h2))
- (Assert (not (equal h1 h3)))
+ (Assert-Equal h1 h2)
+ (Assert-Not-Equal h1 h3)
(puthash 1 2 h3)
(puthash 3 4 h3)
- (Assert (equal h1 h3)))
+ (Assert-Equal h1 h3))
;;; Testing equality of hash tables
-(Assert (equal (make-hash-table :test 'eql :size 300 :rehash-threshold .9 :rehash-size 3.0)
- (make-hash-table :test 'eql)))
-(Assert (not (equal (make-hash-table :test 'eq)
- (make-hash-table :test 'equal))))
+(Assert-Equal (make-hash-table :test 'eql :size 300 :rehash-threshold .9 :rehash-size 3.0)
+ (make-hash-table :test 'eql))
+(Assert-Not-Equal (make-hash-table :test 'eq)
+ (make-hash-table :test 'equal))
(let ((h1 (make-hash-table))
(h2 (make-hash-table)))
- (Assert (equal h1 h2))
+ (Assert-Equal h1 h2)
(Assert (not (eq h1 h2)))
(puthash 1 2 h1)
- (Assert (not (equal h1 h2)))
+ (Assert-Not-Equal h1 h2)
(puthash 1 2 h2)
- (Assert (equal h1 h2))
+ (Assert-Equal h1 h2)
(puthash 1 3 h2)
- (Assert (not (equal h1 h2)))
+ (Assert-Not-Equal h1 h2)
(clrhash h1)
- (Assert (not (equal h1 h2)))
+ (Assert-Not-Equal h1 h2)
(clrhash h2)
- (Assert (equal h1 h2))
+ (Assert-Equal h1 h2)
)
;;; Test sxhash
(mapc-inplace #'evenp ivector)
(Assert (vectorp ivector))
- (Assert (equal ivector [nil t nil t]))
+ (Assert-Equal ivector [nil t nil t])
;; we can't test strings at the moment
(let ((x (make-list-012))) (Assert (eq (nconc x) x)))
(let ((x (make-list-012))) (Assert (eq (nconc x (make-circular-list 3)) x)))
-(Assert (equal (nconc '(1 . 2) '(3 . 4) '(5 . 6)) '(1 3 5 . 6)))
+(Assert-Equal (nconc '(1 . 2) '(3 . 4) '(5 . 6)) '(1 3 5 . 6))
(let ((y (nconc (make-list-012) nil (list 3 4 5) nil)))
(Assert (eq (length y) 6))
(z (nbutlast x)))
(Assert (eq z x))
(Assert (not (eq y x)))
- (Assert (equal y '(0 1 2)))
- (Assert (equal z y)))
+ (Assert-Equal y '(0 1 2))
+ (Assert-Equal z y))
(let* ((x (list 0 1 2 3 4))
(y (butlast x 2))
(z (nbutlast x 2)))
(Assert (eq z x))
(Assert (not (eq y x)))
- (Assert (equal y '(0 1 2)))
- (Assert (equal z y)))
+ (Assert-Equal y '(0 1 2))
+ (Assert-Equal z y))
(let* ((x (list 0 1 2 3))
(y (butlast x 0))
(z (nbutlast x 0)))
(Assert (eq z x))
(Assert (not (eq y x)))
- (Assert (equal y '(0 1 2 3)))
- (Assert (equal z y)))
+ (Assert-Equal y '(0 1 2 3))
+ (Assert-Equal z y))
(Assert (eq (butlast '(x)) nil))
(Assert (eq (nbutlast '(x)) nil))
;; Test mapping functions
;;-----------------------------------------------------
(Check-Error wrong-type-argument (mapcar #'identity (current-buffer)))
-(Assert (equal (mapcar #'identity load-path) load-path))
-(Assert (equal (mapcar #'identity '(1 2 3)) '(1 2 3)))
-(Assert (equal (mapcar #'identity "123") '(?1 ?2 ?3)))
-(Assert (equal (mapcar #'identity [1 2 3]) '(1 2 3)))
-(Assert (equal (mapcar #'identity #*010) '(0 1 0)))
+(Assert-Equal (mapcar #'identity load-path) load-path)
+(Assert-Equal (mapcar #'identity '(1 2 3)) '(1 2 3))
+(Assert-Equal (mapcar #'identity "123") '(?1 ?2 ?3))
+(Assert-Equal (mapcar #'identity [1 2 3]) '(1 2 3))
+(Assert-Equal (mapcar #'identity #*010) '(0 1 0))
(let ((z 0) (list (make-list 1000 1)))
(mapc (lambda (x) (incf z x)) list)
(Assert (eq 1000 z)))
(Check-Error wrong-type-argument (mapvector #'identity (current-buffer)))
-(Assert (equal (mapvector #'identity '(1 2 3)) [1 2 3]))
-(Assert (equal (mapvector #'identity "123") [?1 ?2 ?3]))
-(Assert (equal (mapvector #'identity [1 2 3]) [1 2 3]))
-(Assert (equal (mapvector #'identity #*010) [0 1 0]))
+(Assert-Equal (mapvector #'identity '(1 2 3)) [1 2 3])
+(Assert-Equal (mapvector #'identity "123") [?1 ?2 ?3])
+(Assert-Equal (mapvector #'identity [1 2 3]) [1 2 3])
+(Assert-Equal (mapvector #'identity #*010) [0 1 0])
(Check-Error wrong-type-argument (mapconcat #'identity (current-buffer) "foo"))
-(Assert (equal (mapconcat #'identity '("1" "2" "3") "|") "1|2|3"))
-(Assert (equal (mapconcat #'identity ["1" "2" "3"] "|") "1|2|3"))
+(Assert-Equal (mapconcat #'identity '("1" "2" "3") "|") "1|2|3")
+(Assert-Equal (mapconcat #'identity ["1" "2" "3"] "|") "1|2|3")
;; The following 2 functions used to crash XEmacs via mapcar1().
;; We don't test the actual values of the mapcar, since they're undefined.
;;-----------------------------------------------------
;; Test vector functions
;;-----------------------------------------------------
-(Assert (equal [1 2 3] [1 2 3]))
-(Assert (equal [] []))
-(Assert (not (equal [1 2 3] [])))
-(Assert (not (equal [1 2 3] [1 2 4])))
-(Assert (not (equal [0 2 3] [1 2 3])))
-(Assert (not (equal [1 2 3] [1 2 3 4])))
-(Assert (not (equal [1 2 3 4] [1 2 3])))
-(Assert (equal (vector 1 2 3) [1 2 3]))
-(Assert (equal (make-vector 3 1) [1 1 1]))
+(Assert-Equal [1 2 3] [1 2 3])
+(Assert-Equal [] [])
+(Assert-Not-Equal [1 2 3] [])
+(Assert-Not-Equal [1 2 3] [1 2 4])
+(Assert-Not-Equal [0 2 3] [1 2 3])
+(Assert-Not-Equal [1 2 3] [1 2 3 4])
+(Assert-Not-Equal [1 2 3 4] [1 2 3])
+(Assert-Equal (vector 1 2 3) [1 2 3])
+(Assert-Equal (make-vector 3 1) [1 1 1])
;;-----------------------------------------------------
;; Test bit-vector functions
;;-----------------------------------------------------
-(Assert (equal #*010 #*010))
-(Assert (equal #* #*))
-(Assert (not (equal #*010 #*011)))
-(Assert (not (equal #*010 #*)))
-(Assert (not (equal #*110 #*010)))
-(Assert (not (equal #*010 #*0100)))
-(Assert (not (equal #*0101 #*010)))
-(Assert (equal (bit-vector 0 1 0) #*010))
-(Assert (equal (make-bit-vector 3 1) #*111))
-(Assert (equal (make-bit-vector 3 0) #*000))
+(Assert-Equal #*010 #*010)
+(Assert-Equal #* #*)
+(Assert-Not-Equal #*010 #*011)
+(Assert-Not-Equal #*010 #*)
+(Assert-Not-Equal #*110 #*010)
+(Assert-Not-Equal #*010 #*0100)
+(Assert-Not-Equal #*0101 #*010)
+(Assert-Equal (bit-vector 0 1 0) #*010)
+(Assert-Equal (make-bit-vector 3 1) #*111)
+(Assert-Equal (make-bit-vector 3 0) #*000)
;;-----------------------------------------------------
;; Test buffer-local variables used as (ugh!) function parameters
;; Test split-string
;;-----------------------------------------------------
;; Hrvoje didn't like these tests so I'm disabling them for now. -sb
-;(Assert (equal (split-string "foo" "") '("" "f" "o" "o" "")))
-;(Assert (equal (split-string "foo" "^") '("" "foo")))
-;(Assert (equal (split-string "foo" "$") '("foo" "")))
-(Assert (equal (split-string "foo,bar" ",") '("foo" "bar")))
-(Assert (equal (split-string ",foo,bar," ",") '("" "foo" "bar" "")))
-(Assert (equal (split-string ",foo,bar," "^,") '("" "foo,bar,")))
-(Assert (equal (split-string ",foo,bar," ",$") '(",foo,bar" "")))
-(Assert (equal (split-string ",foo,,bar," ",") '("" "foo" "" "bar" "")))
-(Assert (equal (split-string "foo,,,bar" ",") '("foo" "" "" "bar")))
-(Assert (equal (split-string "foo,,bar,," ",") '("foo" "" "bar" "" "")))
-(Assert (equal (split-string "foo,,bar" ",+") '("foo" "bar")))
-(Assert (equal (split-string ",foo,,bar," ",+") '("" "foo" "bar" "")))
+;(Assert-Equal (split-string "foo" "") '("" "f" "o" "o" ""))
+;(Assert-Equal (split-string "foo" "^") '("" "foo"))
+;(Assert-Equal (split-string "foo" "$") '("foo" ""))
+(Assert-Equal (split-string "foo,bar" ",") '("foo" "bar"))
+(Assert-Equal (split-string ",foo,bar," ",") '("" "foo" "bar" ""))
+(Assert-Equal (split-string ",foo,bar," "^,") '("" "foo,bar,"))
+(Assert-Equal (split-string ",foo,bar," ",$") '(",foo,bar" ""))
+(Assert-Equal (split-string ",foo,,bar," ",") '("" "foo" "" "bar" ""))
+(Assert-Equal (split-string "foo,,,bar" ",") '("foo" "" "" "bar"))
+(Assert-Equal (split-string "foo,,bar,," ",") '("foo" "" "bar" "" ""))
+(Assert-Equal (split-string "foo,,bar" ",+") '("foo" "bar"))
+(Assert-Equal (split-string ",foo,,bar," ",+") '("" "foo" "bar" ""))
(Assert (not (string-match "\\(\\.\\=\\)" ".")))
(Assert (string= "" (let ((str "test string"))
(Assert (eq 4 (put obj ?3 4)))
(Assert (eq 4 (get obj ?3)))
(when (or (stringp obj) (symbolp obj))
- (Assert (equal '(?3 4) (object-plist obj))))
+ (Assert-Equal '(?3 4) (object-plist obj)))
(Assert (eq t (remprop obj ?3)))
(when (or (stringp obj) (symbolp obj))
(Assert (eq '() (object-plist obj))))
;;-----------------------------------------------------
;; Test subseq
;;-----------------------------------------------------
-(Assert (equal (subseq nil 0) nil))
-(Assert (equal (subseq [1 2 3] 0) [1 2 3]))
-(Assert (equal (subseq [1 2 3] 1 -1) [2]))
-(Assert (equal (subseq "123" 0) "123"))
-(Assert (equal (subseq "1234" -3 -1) "23"))
-(Assert (equal (subseq #*0011 0) #*0011))
-(Assert (equal (subseq #*0011 -3 3) #*01))
-(Assert (equal (subseq '(1 2 3) 0) '(1 2 3)))
-(Assert (equal (subseq '(1 2 3 4) -3 nil) '(2 3 4)))
+(Assert-Equal (subseq nil 0) nil)
+(Assert-Equal (subseq [1 2 3] 0) [1 2 3])
+(Assert-Equal (subseq [1 2 3] 1 -1) [2])
+(Assert-Equal (subseq "123" 0) "123")
+(Assert-Equal (subseq "1234" -3 -1) "23")
+(Assert-Equal (subseq #*0011 0) #*0011)
+(Assert-Equal (subseq #*0011 -3 3) #*01)
+(Assert-Equal (subseq '(1 2 3) 0) '(1 2 3))
+(Assert-Equal (subseq '(1 2 3 4) -3 nil) '(2 3 4))
(Check-Error wrong-type-argument (subseq 3 2))
(Check-Error args-out-of-range (subseq [1 2 3] -42))
(let* ((m1 (if (arrayp s1) 'across 'in))
(m2 (if (arrayp s2) 'across 'in)))
`(progn
- (Assert (equal (type-of ,s1) (type-of ,s2)))
+ (Assert-Equal (type-of ,s1) (type-of ,s2))
(Assert (= (length ,s1) (length ,s2)))
(Assert
(loop
(let* ((m1 (if (arrayp s1) 'across 'in))
(m2 (if (arrayp s2) 'across 'in)))
`(progn
- (Assert (equal (type-of ,s1) (type-of ,s2)))
+ (Assert-Equal (type-of ,s1) (type-of ,s2))
(Assert
(loop
for i ,m1 ,s1
(Assert (= (length 6c) 729))
;; all elements must look the same
(dotimes (i 729)
- (Assert (equal (car 6c) '(1.4142 1.4142 1.4142 1.4142 1.4142 1.4142)))
+ (Assert-Equal (car 6c) '(1.4142 1.4142 1.4142 1.4142 1.4142 1.4142))
(setq 6c (cdr 6c))))
;; test invariance of input sequence type
(Assert
;; (null (mapfam #'wreck-3 foo :arity 3)))
;; ;; foo should still have these two elements
;; (Assert (= (dllist-size foo) 2))
-;; (Assert (equal foo (dllist 1 2)))
+;; (Assert-Equal foo (dllist 1 2))
;; dicts
(setq test-ht (make-hash-table)
;;-----------------------------------------------------
(mapcar (lambda (x)
- (Assert (equal (md5 (car x)) (cdr x))))
+ (Assert-Equal (md5 (car x)) (cdr x)))
md5-tests)
;;-----------------------------------------------------
(let ((large-string (mapconcat #'car md5-tests "")))
(let ((count 0))
(mapcar (lambda (x)
- (Assert (equal (md5 large-string count (+ count (length (car x))))
- (cdr x)))
+ (Assert-Equal (md5 large-string count (+ count (length (car x))))
+ (cdr x))
(incf count (length (car x))))
md5-tests)))
(mapcar (lambda (x)
(erase-buffer)
(insert (car x))
- (Assert (equal (md5 (current-buffer)) (cdr x))))
+ (Assert-Equal (md5 (current-buffer)) (cdr x)))
md5-tests))
;;-----------------------------------------------------
(insert (mapconcat #'car md5-tests ""))
(let ((point 1))
(mapcar (lambda (x)
- (Assert (equal (md5 (current-buffer) point (+ point (length (car x))))
- (cdr x)))
+ (Assert-Equal (md5 (current-buffer) point (+ point (length (car x))))
+ (cdr x))
(incf point (length (car x))))
md5-tests)))
;; buffer.
(with-temp-buffer
(insert string)
- (Assert (equal (buffer-string) string)))
+ (Assert-Equal (buffer-string) string))
;; For use without test harness: use a normal buffer, so that
;; you can also test whether redisplay works.
(switch-to-buffer (get-buffer-create "test"))
(loop for j from 0 below (length string) do
(aset string j (aref greek-string (mod j 96))))
(loop for k in '(0 1 58 59) do
- (Assert (equal (substring string (* 96 k) (* 96 (1+ k))) greek-string))))
+ (Assert-Equal (substring string (* 96 k) (* 96 (1+ k))) greek-string)))
(let ((greek-string (charset-char-string 'greek-iso8859-7))
(string (make-string (* 96 60) ??)))
(loop for j from (1- (length string)) downto 0 do
(aset string j (aref greek-string (mod j 96))))
(loop for k in '(0 1 58 59) do
- (Assert (equal (substring string (* 96 k) (* 96 (1+ k))) greek-string))))
+ (Assert-Equal (substring string (* 96 k) (* 96 (1+ k))) greek-string)))
(let ((ascii-string (charset-char-string 'ascii))
(string (make-string (* 94 60) (make-char 'greek-iso8859-7 57))))
(loop for j from 0 below (length string) do
(aset string j (aref ascii-string (mod j 94))))
(loop for k in '(0 1 58 59) do
- (Assert (equal (substring string (* 94 k) (+ 94 (* 94 k))) ascii-string))))
+ (Assert-Equal (substring string (* 94 k) (+ 94 (* 94 k))) ascii-string)))
(let ((ascii-string (charset-char-string 'ascii))
(string (make-string (* 94 60) (make-char 'greek-iso8859-7 57))))
(loop for j from (1- (length string)) downto 0 do
(aset string j (aref ascii-string (mod j 94))))
(loop for k in '(0 1 58 59) do
- (Assert (equal (substring string (* 94 k) (* 94 (1+ k))) ascii-string))))
+ (Assert-Equal (substring string (* 94 k) (* 94 (1+ k))) ascii-string)))
;;---------------------------------------------------------------
;; Test file-system character conversion (and, en passant, file ops)
(name2 (make-temp-name prefix))
(file-name-coding-system 'iso-8859-2))
(Silence-Message
- (Assert (not (equal name1 name2)))
+ (Assert-Not-Equal name1 name2)
;; Kludge to handle Mac OS X which groks only UTF-8.
(cond ((eq system-type 'darwin)
(Check-Error-Message 'file-error "Opening output file"
(when (fboundp 'make-symbolic-link)
(make-symbolic-link name1 name2)
(Assert (file-exists-p name2))
- (Assert (equal (file-truename name2) name1))
- (Assert (equal (file-truename name1) name1)))
+ (Assert-Equal (file-truename name2) (file-truename name1))
+ (Assert-Equal (file-truename name2) name1)
+ (Assert-Equal (file-truename name1) name1))
(ignore-file-errors (delete-file name1) (delete-file name2))))
(map-skiplist
#'(lambda (key val)
(Assert (skiplist-owns-p sl3 key))
- (Assert (equal (get-skiplist sl3 key) val)))
+ (Assert-Equal (get-skiplist sl3 key) val))
sl1)
(loop for i to 20000 do (put-skiplist sl1 i i))
(uninterned (make-symbol name)))
(Assert (symbolp interned))
(Assert (symbolp uninterned))
- (Assert (equal (symbol-name interned) name))
- (Assert (equal (symbol-name uninterned) name))
+ (Assert-Equal (symbol-name interned) name)
+ (Assert-Equal (symbol-name uninterned) name)
(Assert (not (eq interned uninterned)))
- (Assert (not (equal interned uninterned)))))
+ (Assert-Not-Equal interned uninterned)))
(flet ((check-weak-list-unique (weak-list &optional reversep)
"Check that elements of WEAK-LIST are referenced only there."
(bar3 (nth 5 list)))
(Assert (symbolp foo))
(Assert (not (intern-soft foo)))
- (Assert (equal (symbol-name foo) "foo"))
+ (Assert-Equal (symbol-name foo) "foo")
(Assert (symbolp bar))
(Assert (not (intern-soft bar)))
- (Assert (equal (symbol-name bar) "bar"))
+ (Assert-Equal (symbol-name bar) "bar")
(Assert (eq foo foo2))
(Assert (eq foo2 foo3))
(list (list foo foo bar bar foo bar)))
(let* ((print-gensym nil)
(printed-list (prin1-to-string list)))
- (Assert (equal printed-list "(foo foo bar bar foo bar)")))
+ (Assert-Equal printed-list "(foo foo bar bar foo bar)"))
(let* ((print-gensym t)
(printed-list (prin1-to-string list)))
- (Assert (equal printed-list "(#1=#:foo #1# #2=#:bar #2# #1# #2#)"))))
+ (Assert-Equal printed-list "(#1=#:foo #1# #2=#:bar #2# #1# #2#)")))
;;-----------------------------------------------------
;; Read-only symbols
;;; Printing keywords
(let ((print-gensym t))
- (Assert (equal (prin1-to-string :foo) ":foo"))
- (Assert (equal (prin1-to-string (intern ":foo")) ":foo"))
- (Assert (equal (prin1-to-string (intern ":foo" [0])) "#::foo")))
+ (Assert-Equal (prin1-to-string :foo) ":foo")
+ (Assert-Equal (prin1-to-string (intern ":foo")) ":foo")
+ (Assert-Equal (prin1-to-string (intern ":foo" [0])) "#::foo"))
(let ((print-gensym nil))
- (Assert (equal (prin1-to-string :foo) ":foo"))
- (Assert (equal (prin1-to-string (intern ":foo")) ":foo"))
- (Assert (equal (prin1-to-string (intern ":foo" [0])) ":foo")))
+ (Assert-Equal (prin1-to-string :foo) ":foo")
+ (Assert-Equal (prin1-to-string (intern ":foo")) ":foo")
+ (Assert-Equal (prin1-to-string (intern ":foo" [0])) ":foo"))
;; #### Add many more tests for printing and reading symbols, as well
;; as print-gensym and print-gensym-alist!
(lambda (&rest args)
(throw 'test-tag args)))
(Assert (not (boundp mysym)))
- (Assert (equal (catch 'test-tag
+ (Assert-Equal (catch 'test-tag
(set mysym 'foo))
- `(,mysym (foo) set nil nil)))
+ `(,mysym (foo) set nil nil))
(Assert (not (boundp mysym)))
(dontusethis-set-symbol-value-handler
mysym
'set-value
(lambda (&rest args) (setq save (nth 1 args))))
(set mysym 'foo)
- (Assert (equal save '(foo)))
+ (Assert-Equal save '(foo))
(Assert (eq (symbol-value mysym) 'foo))
)
'make-unbound
(lambda (&rest args)
(throw 'test-tag args)))
- (Assert (equal (catch 'test-tag
+ (Assert-Equal (catch 'test-tag
(makunbound mysym))
- `(,mysym nil makunbound nil nil)))
+ `(,mysym nil makunbound nil nil))
(dontusethis-set-symbol-value-handler
mysym
'make-unbound
; 'make-local
; (lambda (&rest args)
; (throw 'test-tag args)))
-; (Assert (equal (catch 'test-tag
+; (Assert-Equal (catch 'test-tag
; (set mysym 'foo))
-; `(,mysym (foo) make-local nil nil))))
+; `(,mysym (foo) make-local nil nil)))
(incf other-failures)
)))
+ (defmacro Assert-Equal (object1 object2)
+ `(condition-case error-info
+ (progn
+ (assert (equal ,object1 ,object2))
+ (Print-Pass "(equal %S %S)" (quote ,object1) (quote ,object2))
+ (incf passes))
+ (cl-assertion-failed
+ (Print-Failure "Assertion failed: (equal %S %S) => (equal %S %S)"
+ (quote ,object1) (quote ,object2) ,object1 ,object2)
+ (incf assertion-failures))
+ (t (Print-Failure "(equal %S %S) ==> error: %S"
+ (quote ,object1) (quote ,object2) error-info)
+ (incf other-failures)
+ )))
+
+ (defmacro Assert-Not-Equal (object1 object2)
+ `(condition-case error-info
+ (progn
+ (assert (not (equal ,object1 ,object2)))
+ (Print-Pass "(not (equal %S %S))" (quote ,object1) (quote ,object2))
+ (incf passes))
+ (cl-assertion-failed
+ (Print-Failure "Assertion failed: (not (equal %S %S)) => (not (equal %S %S))"
+ (quote ,object1) (quote ,object2) ,object1 ,object2)
+ (incf assertion-failures))
+ (t (Print-Failure "(not (equal %S %S)) ==> error: %S"
+ (quote ,object1) (quote ,object2) error-info)
+ (incf other-failures)
+ )))
+
(defmacro Check-Error (expected-error &rest body)
(let ((quoted-body (if (= 1 (length body))
`(quote ,(car body)) `(quote (progn ,@body)))))
(Assert (eq (weak-list-list weaklist1) testlist))
(unless (featurep 'bdwgc)
- (Assert (equal (weak-list-list weaklist2) testlist))
- (Assert (equal (weak-list-list weaklist3) testlist))
- (Assert (equal (weak-list-list weaklist4) testlist))))
+ (Assert-Equal (weak-list-list weaklist2) testlist)
+ (Assert-Equal (weak-list-list weaklist3) testlist)
+ (Assert-Equal (weak-list-list weaklist4) testlist)))
(garbage-collect)
(Assert (eq (weak-list-list weaklist1) testlist))
(unless (featurep 'bdwgc)
- (Assert (equal (weak-list-list weaklist2) testlist))
- (Assert (equal (weak-list-list weaklist3) testlist))
- (Assert (equal (weak-list-list weaklist4) testlist))))
+ (Assert-Equal (weak-list-list weaklist2) testlist)
+ (Assert-Equal (weak-list-list weaklist3) testlist)
+ (Assert-Equal (weak-list-list weaklist4) testlist)))
(garbage-collect)
(Assert (eq (weak-list-list weaklist1) testlist))
(unless (featurep 'bdwgc)
- (Assert (equal (weak-list-list weaklist2) testlist))
- (Assert (equal (weak-list-list weaklist3) (list b (cons a (cons 1 2)) b)))
- (Assert (equal (weak-list-list weaklist4) testlist)))
+ (Assert-Equal (weak-list-list weaklist2) testlist)
+ (Assert-Equal (weak-list-list weaklist3) (list b (cons a (cons 1 2)) b))
+ (Assert-Equal (weak-list-list weaklist4) testlist))
(garbage-collect)
(Assert (eq (weak-list-list weaklist1) testlist))
(unless (featurep 'bdwgc)
- (Assert (equal (weak-list-list weaklist2) (list b (cons (cons 1 2) a) b)))
- (Assert (equal (weak-list-list weaklist3) testlist))
- (Assert (equal (weak-list-list weaklist4) testlist))))
+ (Assert-Equal (weak-list-list weaklist2) (list b (cons (cons 1 2) a) b))
+ (Assert-Equal (weak-list-list weaklist3) testlist)
+ (Assert-Equal (weak-list-list weaklist4) testlist)))
(garbage-collect)
(Assert (eq (weak-list-list weaklist1) testlist))
(unless (featurep 'bdwgc)
- (Assert (equal (weak-list-list weaklist2) (list b (cons (cons 1 2) a) b)))
- (Assert (equal (weak-list-list weaklist3) (list b (cons a (cons 1 2)) b)))
- (Assert (equal (weak-list-list weaklist4) testlist))))
+ (Assert-Equal (weak-list-list weaklist2) (list b (cons (cons 1 2) a) b))
+ (Assert-Equal (weak-list-list weaklist3) (list b (cons a (cons 1 2)) b))
+ (Assert-Equal (weak-list-list weaklist4) testlist)))
(garbage-collect)
projects / sxemacs / commitdiff