Mercurial > hg > xemacs-beta

comparison tests/automated/lisp-tests.el @ 5188:000287f8053b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Be more careful about parentheses and number features, #'equalp tests 2010-04-03 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el: Correct the parentheses in the equalp tests, so they get run more often. Within them, only attempt to read a bignum if the bignum feature is present; actually evaluate (/ 3/2 0.2), (/ 3/2 0.7) if the ratio feature is present. Construct the (Assert ...) calls at macroexpansion time, so the output in the *Test-Log* buffer is more informative.
author Aidan Kehoe <kehoea@parhasard.net>
date Sat, 03 Apr 2010 16:27:07 +0100
parents 0f66906b6e37
children 71ee43b8a74d
comparison
equal deleted inserted replaced
5187:b51c2079ec8e 5188:000287f8053b
2136 with res = (make-string 96 ?\x20) 2136 with res = (make-string 96 ?\x20)
2137 for int-char from #x20 to #x7f 2137 for int-char from #x20 to #x7f
2138 for char being each element in-ref res 2138 for char being each element in-ref res
2139 do (setf char (int-to-char int-char)) 2139 do (setf char (int-to-char int-char))
2140 finally return res))) 2140 finally return res)))
2141 (let ((equal-lists 2141
2142 '((111111111111111111111111111111111111111111111111111 2142 (macrolet
2143 111111111111111111111111111111111111111111111111111.0) 2143 ((equalp-equal-list-tests (equal-list)
2144 (0 0.0 0.000 -0 -0.0 -0.000 #b0 0/5 -0/5) 2144 (let (res)
2145 (21845 #b101010101010101 #x5555) 2145 (setq equal-lists (eval equal-list))
2146 (1.5 1.500000000000000000000000000000000000000000000000000000000 2146 (loop for li in equal-lists do
2147 3/2) 2147 (loop for (x . tail) on li do
2148 (-55 -110/2) 2148 (loop for y in tail do
2149 ;; Can't use this, these values aren't `='. 2149 (push `(Assert (equalp ,(quote-maybe x)
2150 ;;(-12345678901234567890123457890123457890123457890123457890123457890 2150 ,(quote-maybe y))) res)
2151 ;; -12345678901234567890123457890123457890123457890123457890123457890.0) 2151 (push `(Assert (equalp ,(quote-maybe y)
2152 ))) 2152 ,(quote-maybe x))) res))))
2153 (loop for li in equal-lists do 2153 (cons 'progn (nreverse res))))
2154 (loop for (x . tail) on li do 2154 (equalp-diff-list-tests (diff-list)
2155 (loop for y in tail do 2155 (let (res)
2156 (Assert (equalp x y)) 2156 (setq diff-list (eval diff-list))
2157 (Assert (equalp y x)))))) 2157 (loop for (x . tail) on diff-list do
2158 2158 (loop for y in tail do
2159 (let ((diff-list 2159 (push `(Assert (not (equalp ,(quote-maybe x)
2160 `(0 1 2 3 1000 5000000000 5555555555555555555555555555555555555 2160 ,(quote-maybe y)))) res)
2161 -1 -2 -3 -1000 -5000000000 -5555555555555555555555555555555555555 2161 (push `(Assert (not (equalp ,(quote-maybe y)
2162 1/2 1/3 2/3 8/2 355/113 (/ 3/2 0.2) (/ 3/2 0.7) 2162 ,(quote-maybe x)))) res)))
2163 55555555555555555555555555555555555555555/2718281828459045 2163 (cons 'progn (nreverse res)))))
2164 0.111111111111111111111111111111111111111111111111111111111111111 2164 (equalp-equal-list-tests
2165 1e+300 1e+301 -1e+300 -1e+301))) 2165 `(,@(when (featurep 'bignum)
2166 (loop for (x . tail) on diff-list do 2166 (read "((111111111111111111111111111111111111111111111111111
2167 (loop for y in tail do 2167 111111111111111111111111111111111111111111111111111.0))"))
2168 (Assert (not (equalp x y))) 2168 (0 0.0 0.000 -0 -0.0 -0.000 #b0 ,@(when (featurep 'ratio) '(0/5 -0/5)))
2169 (Assert (not (equalp y x)))))) 2169 (21845 #b101010101010101 #x5555)
2170 (1.5 1.500000000000000000000000000000000000000000000000000000000
2171 ,@(when (featurep 'ratio) '(3/2)))
2172 ;; Can't use this, these values aren't `='.
2173 ;;(-12345678901234567890123457890123457890123457890123457890123457890
2174 ;; -12345678901234567890123457890123457890123457890123457890123457890.0)
2175 (-55 -55.000 ,@(when (featurep 'ratio) '(-110/2)))))
2176 (equalp-diff-list-tests
2177 `(0 1 2 3 1000 5000000000
2178 ,@(when (featurep 'bignum)
2179 (read "(5555555555555555555555555555555555555
2180 -5555555555555555555555555555555555555)"))
2181 -1 -2 -3 -1000 -5000000000
2182 1/2 1/3 2/3 8/2 355/113
2183 ,@(when (featurep 'ratio) (mapcar* #'/ '(3/2 3/2) '(0.2 0.7)))
2184 55555555555555555555555555555555555555555/2718281828459045
2185 0.111111111111111111111111111111111111111111111111111111111111111
2186 1e+300 1e+301 -1e+300 -1e+301)))
2170 2187
2171 (Assert (equalp "hi there" "Hi There") 2188 (Assert (equalp "hi there" "Hi There")
2172 "checking equalp isn't case-sensitive") 2189 "checking equalp isn't case-sensitive")
2173 (Assert (equalp 99 99.0) 2190 (Assert (equalp 99 99.0)
2174 "checking equalp compares numerical values of different types") 2191 "checking equalp compares numerical values of different types")
2229 "checking #'equalp succeeds correctly, char-tables") 2246 "checking #'equalp succeeds correctly, char-tables")
2230 (Assert (not (equalp #s(char-table type generic data (?\u0080 "hi-there")) 2247 (Assert (not (equalp #s(char-table type generic data (?\u0080 "hi-there"))
2231 (let ((aragh (make-char-table 'generic))) 2248 (let ((aragh (make-char-table 'generic)))
2232 (put-char-table ?\u0080 "hi there" aragh) 2249 (put-char-table ?\u0080 "hi there" aragh)
2233 aragh))) 2250 aragh)))
2234 "checking #'equalp fails correctly, char-tables") 2251 "checking #'equalp fails correctly, char-tables"))
2235 2252
2236 ;; There are more tests available for equalp here: 2253 ;; There are more tests available for equalp here:
2237 ;; 2254 ;;
2238 ;; http://www.parhasard.net/xemacs/equalp-tests.el 2255 ;; http://www.parhasard.net/xemacs/equalp-tests.el
2239 ;; 2256 ;;