Mercurial > hg > xemacs-beta

comparison tests/automated/lisp-tests.el @ 4794:8484c6c76837

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge.
author Aidan Kehoe <kehoea@parhasard.net>
date Thu, 31 Dec 2009 15:47:03 +0000
parents 95b04754ea8c
children 084056f46755
comparison
equal deleted inserted replaced
4793:8b50bee3c88c 4794:8484c6c76837
2083 (= (* 3.0 (- pi 3.0)) 2083 (= (* 3.0 (- pi 3.0))
2084 (letf (((values three one-four-one-five-nine) (floor pi))) 2084 (letf (((values three one-four-one-five-nine) (floor pi)))
2085 (* three one-four-one-five-nine))) 2085 (* three one-four-one-five-nine)))
2086 "checking letf handles #'values in a basic sense")) 2086 "checking letf handles #'values in a basic sense"))
2087 2087
2088 (Assert (equalp "hi there" "Hi There") 2088 ;; #'equalp tests.
2089 "checking equalp isn't case-sensitive") 2089 (let ((string-variable "aBcDeeFgH\u00Edj")
2090 (Assert (equalp 99 99.0) 2090 (eacute-character ?\u00E9)
2091 "checking equalp compares numerical values of different types") 2091 (Eacute-character ?\u00c9)
2092 (Assert (null (equalp 99 ?c)) 2092 (+base-chars+ (loop
2093 "checking equalp does not convert characters to numbers") 2093 with res = (make-string 96 ?\x20)
2094 ;; Fixed in Hg d0ea57eb3de4. 2094 for int-char from #x20 to #x7f
2095 (Assert (null (equalp "hi there" [hi there])) 2095 for char being each element in-ref res
2096 "checking equalp doesn't error with string and non-string") 2096 do (setf char (int-to-char int-char))
2097 finally return res)))
2098 (Assert (equalp "hi there" "Hi There")
2099 "checking equalp isn't case-sensitive")
2100 (Assert (equalp 99 99.0)
2101 "checking equalp compares numerical values of different types")
2102 (Assert (null (equalp 99 ?c))
2103 "checking equalp does not convert characters to numbers")
2104 ;; Fixed in Hg d0ea57eb3de4.
2105 (Assert (null (equalp "hi there" [hi there]))
2106 "checking equalp doesn't error with string and non-string")
2107 (Assert (eq t (equalp "ABCDEEFGH\u00CDJ" string-variable))
2108 "checking #'equalp is case-insensitive with an upcased constant")
2109 (Assert (eq t (equalp "abcdeefgh\xedj" string-variable))
2110 "checking #'equalp is case-insensitive with a downcased constant")
2111 (Assert (eq t (equalp string-variable string-variable))
2112 "checking #'equalp works when handed the same string twice")
2113 (Assert (eq t (equalp string-variable "aBcDeeFgH\u00Edj"))
2114 "check #'equalp is case-insensitive with a variable-cased constant")
2115 (Assert (eq t (equalp "" (bit-vector)))
2116 "check empty string and empty bit-vector are #'equalp.")
2117 (Assert (eq t (equalp (string) (bit-vector)))
2118 "check empty string and empty bit-vector are #'equalp, no constants")
2119 (Assert (eq t (equalp "hi there" (vector ?h ?i ?\ ?t ?h ?e ?r ?e)))
2120 "check string and vector with same contents #'equalp")
2121 (Assert (eq t (equalp (string ?h ?i ?\ ?t ?h ?e ?r ?e)
2122 (vector ?h ?i ?\ ?t ?h ?e ?r ?e)))
2123 "check string and vector with same contents #'equalp, no constants")
2124 (Assert (eq t (equalp [?h ?i ?\ ?t ?h ?e ?r ?e]
2125 (string ?h ?i ?\ ?t ?h ?e ?r ?e)))
2126 "check string and vector with same contents #'equalp, vector constant")
2127 (Assert (eq t (equalp [0 1.0 0.0 0 1]
2128 (bit-vector 0 1 0 0 1)))
2129 "check vector and bit-vector with same contents #'equalp,\
2130 vector constant")
2131 (Assert (eq t (equalp #*01001
2132 (vector 0 1.0 0.0 0 1)))
2133 "check vector and bit-vector with same contents #'equalp,\
2134 bit-vector constant")
2135 (Assert (eq t (equalp ?\u00E9 Eacute-character))
2136 "checking characters are case-insensitive, one constant")
2137 (Assert (eq nil (equalp ?\u00E9 (aref (format "%c" ?a) 0)))
2138 "checking distinct characters are not equalp, one constant")
2139 (Assert (eq t (equalp t (and)))
2140 "checking symbols are correctly #'equalp")
2141 (Assert (eq nil (equalp t (or nil '#:t)))
2142 "checking distinct symbols with the same name are not #'equalp")
2143 (Assert (eq t (equalp #s(char-table type generic data (?\u0080 "hi-there"))
2144 (let ((aragh (make-char-table 'generic)))
2145 (put-char-table ?\u0080 "hi-there" aragh)
2146 aragh)))
2147 "checking #'equalp succeeds correctly, char-tables")
2148 (Assert (eq nil (equalp #s(char-table type generic data (?\u0080 "hi-there"))
2149 (let ((aragh (make-char-table 'generic)))
2150 (put-char-table ?\u0080 "HI-THERE" aragh)
2151 aragh)))
2152 "checking #'equalp fails correctly, char-tables"))
2153
2154 ;; There are more tests available for equalp here:
2155 ;;
2156 ;; http://www.parhasard.net/xemacs/equalp-tests.el
2157 ;;
2158 ;; They are taken from Paul Dietz' GCL ANSI test suite, licensed under the
2159 ;; LGPL and part of GNU Common Lisp; the GCL people didn't respond to
2160 ;; several requests for information on who owned the copyright for the
2161 ;; files, so I haven't included the tests with XEmacs. Anyone doing XEmacs
2162 ;; development on equalp should still run them, though. Aidan Kehoe, Thu Dec
2163 ;; 31 14:53:52 GMT 2009.
2097 2164
2098 ;;; end of lisp-tests.el 2165 ;;; end of lisp-tests.el