comparison tests/automated/lisp-tests.el @ 4906:6ef8256a020a

implement equalp in C, fix case-folding, add equal() method for keymaps -------------------- ChangeLog entries follow: -------------------- lisp/ChangeLog addition: 2010-02-01 Ben Wing <ben@xemacs.org> * cl-extra.el: * cl-extra.el (cl-string-vector-equalp): Removed. * cl-extra.el (cl-bit-vector-vector-equalp): Removed. * cl-extra.el (cl-vector-array-equalp): Removed. * cl-extra.el (cl-hash-table-contents-equalp): Removed. * cl-extra.el (equalp): Removed. * cl-extra.el (cl-mapcar-many): Comment out the whole `equalp' implementation for the moment; remove once we're sure the C implementation works. * cl-macs.el: * cl-macs.el (equalp): Simplify the compiler-macro for `equalp' -- once it's in C, we don't need to try so hard to expand it. src/ChangeLog addition: 2010-02-01 Ben Wing <ben@xemacs.org> * abbrev.c (abbrev_match_mapper): * buffer.h (CANON_TABLE_OF): * buffer.h: * editfns.c (Fchar_equal): * minibuf.c (scmp_1): * text.c (qxestrcasecmp_i18n): * text.c (qxestrncasecmp_i18n): * text.c (qxetextcasecmp): * text.c (qxetextcasecmp_matching): Create new macro CANONCASE that converts to a canonical mapping and use it to do caseless comparisons instead of DOWNCASE. * alloc.c: * alloc.c (cons_equal): * alloc.c (vector_equal): * alloc.c (string_equal): * bytecode.c (compiled_function_equal): * chartab.c (char_table_entry_equal): * chartab.c (char_table_equal): * data.c (weak_list_equal): * data.c (weak_box_equal): * data.c (ephemeron_equal): * device-msw.c (equal_devmode): * elhash.c (hash_table_equal): * events.c (event_equal): * extents.c (properties_equal): * extents.c (extent_equal): * faces.c: * faces.c (face_equal): * faces.c (face_hash): * floatfns.c (float_equal): * fns.c: * fns.c (bit_vector_equal): * fns.c (plists_differ): * fns.c (Fplists_eq): * fns.c (Fplists_equal): * fns.c (Flax_plists_eq): * fns.c (Flax_plists_equal): * fns.c (internal_equal): * fns.c (internal_equalp): * fns.c (internal_equal_0): * fns.c (syms_of_fns): * glyphs.c (image_instance_equal): * glyphs.c (glyph_equal): * glyphs.c (glyph_hash): * gui.c (gui_item_equal): * lisp.h: * lrecord.h (struct lrecord_implementation): * marker.c (marker_equal): * number.c (bignum_equal): * number.c (ratio_equal): * number.c (bigfloat_equal): * objects.c (color_instance_equal): * objects.c (font_instance_equal): * opaque.c (equal_opaque): * opaque.c (equal_opaque_ptr): * rangetab.c (range_table_equal): * specifier.c (specifier_equal): Add a `foldcase' param to the equal() method and use it to implement `equalp' comparisons. Also add to plists_differ(), although we don't currently use it here. Rewrite internal_equalp(). Implement cross-type vector comparisons. Don't implement our own handling of numeric promotion -- just use the `=' primitive. Add internal_equal_0(), which takes a `foldcase' param and calls either internal_equal() or internal_equalp(). * buffer.h: When given a 0 for buffer (which is the norm when functions don't have a specific buffer available), use the current buffer's table, not `standard-case-table'; otherwise the current settings are ignored. * casetab.c: * casetab.c (set_case_table): When handling old-style vectors of 256 in `set-case-table' don't overwrite the existing table! Instead create a new table and populate. * device-msw.c (sync_printer_with_devmode): * lisp.h: * text.c (lisp_strcasecmp_ascii): Rename lisp_strcasecmp to lisp_strcasecmp_ascii and use lisp_strcasecmp_i18n for caseless comparisons in some places. * elhash.c: Delete unused lisp_string_hash and lisp_string_equal(). * events.h: * keymap-buttons.h: * keymap.h: * keymap.c (keymap_lookup_directly): * keymap.c (keymap_store): * keymap.c (FROB): * keymap.c (key_desc_list_to_event): * keymap.c (describe_map_mapper): * keymap.c (INCLUDE_BUTTON_ZERO): New file keymap-buttons.h; use to handle buttons 1-26 in place of duplicating code 26 times. * frame-gtk.c (allocate_gtk_frame_struct): * frame-msw.c (mswindows_init_frame_1): Fix some comments about internal_equal() in redisplay that don't apply any more. * keymap-slots.h: * keymap.c: New file keymap-slots.h. Use it to notate the slots in a keymap structure, similar to frameslots.h or coding-system-slots.h. * keymap.c (MARKED_SLOT): * keymap.c (keymap_equal): * keymap.c (keymap_hash): Implement. tests/ChangeLog addition: 2010-02-01 Ben Wing <ben@xemacs.org> * automated/case-tests.el: * automated/case-tests.el (uni-mappings): * automated/search-tests.el: Delete old pristine-case-table code. Rewrite the Unicode torture test to take into account whether overlapping mappings exist for more than one character, and not doing the upcase/downcase comparisons in such cases. * automated/lisp-tests.el (foo): * automated/lisp-tests.el (string-variable): * automated/lisp-tests.el (featurep): Replace Assert (equal ... with Assert-equal; same for other types of equality. Replace some awkward equivalents of Assert-equalp with Assert-equalp. Add lots of equalp tests. * automated/case-tests.el: * automated/regexp-tests.el: * automated/search-tests.el: Fix up the comments at the top of the files. Move rules about where to put tests into case-tests.el. * automated/test-harness.el: * automated/test-harness.el (test-harness-aborted-summary-template): New. * automated/test-harness.el (test-harness-from-buffer): * automated/test-harness.el (batch-test-emacs): Fix Assert-test-not. Create Assert-not-equal and variants. Delete the doc strings from all these convenience functions to avoid excessive repetition; instead use one copy in a comment.
author Ben Wing <ben@xemacs.org>
date Mon, 01 Feb 2010 01:02:40 -0600
parents 91a023144e72
children 1b96882bdf37
comparison
equal deleted inserted replaced
4903:70089046adef 4906:6ef8256a020a
1955 (Assert 1955 (Assert
1956 (= 1 (length (multiple-value-list 1956 (= 1 (length (multiple-value-list
1957 (foo-zero 400 (1+ most-positive-fixnum))))) 1957 (foo-zero 400 (1+ most-positive-fixnum)))))
1958 "Checking multiple values are discarded correctly when forced") 1958 "Checking multiple values are discarded correctly when forced")
1959 (Check-Error setting-constant (setq multiple-values-limit 20)) 1959 (Check-Error setting-constant (setq multiple-values-limit 20))
1960 (Assert 1960 (Assert-equal '(-1 1)
1961 (equal '(-1 1) 1961 (multiple-value-list (floor -3 4))
1962 (multiple-value-list (floor -3 4)))
1963 "Checking #'multiple-value-list gives a sane result") 1962 "Checking #'multiple-value-list gives a sane result")
1964 (let ((ey 40000) 1963 (let ((ey 40000)
1965 (bee "this is a string") 1964 (bee "this is a string")
1966 (cee #s(hash-table size 256 data (969 ?\xF9)))) 1965 (cee #s(hash-table size 256 data (969 ?\xF9))))
1967 (Assert 1966 (Assert-equal
1968 (equal 1967 (multiple-value-list (values ey bee cee))
1969 (multiple-value-list (values ey bee cee)) 1968 (multiple-value-list (values-list (list ey bee cee)))
1970 (multiple-value-list (values-list (list ey bee cee))))
1971 "Checking that #'values and #'values-list are correctly related") 1969 "Checking that #'values and #'values-list are correctly related")
1972 (Assert 1970 (Assert-equal
1973 (equal 1971 (multiple-value-list (values-list (list ey bee cee)))
1974 (multiple-value-list (values-list (list ey bee cee))) 1972 (multiple-value-list (apply #'values (list ey bee cee)))
1975 (multiple-value-list (apply #'values (list ey bee cee))))
1976 "Checking #'values-list and #'apply with #values are correctly related")) 1973 "Checking #'values-list and #'apply with #values are correctly related"))
1977 (Assert 1974 (Assert= (multiple-value-call #'+ (floor 5 3) (floor 19 4)) 10
1978 (= (multiple-value-call #'+ (floor 5 3) (floor 19 4)) 10)
1979 "Checking #'multiple-value-call gives reasonable results.") 1975 "Checking #'multiple-value-call gives reasonable results.")
1980 (Assert 1976 (Assert= (multiple-value-call (values '+ '*) (floor 5 3) (floor 19 4)) 10
1981 (= (multiple-value-call (values '+ '*) (floor 5 3) (floor 19 4)) 10)
1982 "Checking #'multiple-value-call correct when first arg multiple.") 1977 "Checking #'multiple-value-call correct when first arg multiple.")
1983 (Assert 1978 (Assert= 1 (length (multiple-value-list (prog1 (floor pi) "hi there")))
1984 (= 1 (length (multiple-value-list (prog1 (floor pi) "hi there"))))
1985 "Checking #'prog1 does not pass back multiple values") 1979 "Checking #'prog1 does not pass back multiple values")
1986 (Assert 1980 (Assert= 2 (length (multiple-value-list
1987 (= 2 (length (multiple-value-list 1981 (multiple-value-prog1 (floor pi) "hi there")))
1988 (multiple-value-prog1 (floor pi) "hi there"))))
1989 "Checking #'multiple-value-prog1 passes back multiple values") 1982 "Checking #'multiple-value-prog1 passes back multiple values")
1990 (multiple-value-bind (floored remainder this-is-nil) 1983 (multiple-value-bind (floored remainder this-is-nil)
1991 (floor pi 1.0) 1984 (floor pi 1.0)
1992 (Assert= floored 3 1985 (Assert= floored 3
1993 "Checking floored bound correctly") 1986 "Checking floored bound correctly")
2001 (multiple-value-setq (ey bee cee) 1994 (multiple-value-setq (ey bee cee)
2002 (ffloor e 1.0)) 1995 (ffloor e 1.0))
2003 (Assert-eql 2.0 ey "Checking ey set correctly") 1996 (Assert-eql 2.0 ey "Checking ey set correctly")
2004 (Assert-eql bee (- e 2.0) "Checking bee set correctly") 1997 (Assert-eql bee (- e 2.0) "Checking bee set correctly")
2005 (Assert (null cee) "Checking cee set to nil correctly")) 1998 (Assert (null cee) "Checking cee set to nil correctly"))
2006 (Assert 1999 (Assert= 3 (length (multiple-value-list (eval '(values nil t pi))))
2007 (= 3 (length (multiple-value-list (eval '(values nil t pi)))))
2008 "Checking #'eval passes back multiple values") 2000 "Checking #'eval passes back multiple values")
2009 (Assert 2001 (Assert= 2 (length (multiple-value-list (apply #'floor '(5 3))))
2010 (= 2 (length (multiple-value-list (apply #'floor '(5 3)))))
2011 "Checking #'apply passes back multiple values") 2002 "Checking #'apply passes back multiple values")
2012 (Assert 2003 (Assert= 2 (length (multiple-value-list (funcall #'floor 5 3)))
2013 (= 2 (length (multiple-value-list (funcall #'floor 5 3))))
2014 "Checking #'funcall passes back multiple values") 2004 "Checking #'funcall passes back multiple values")
2015 (Assert 2005 (Assert-equal '(1 2) (multiple-value-list
2016 (equal '(1 2) (multiple-value-list 2006 (multiple-value-call #'floor (values 5 3)))
2017 (multiple-value-call #'floor (values 5 3))))
2018 "Checking #'multiple-value-call passes back multiple values correctly") 2007 "Checking #'multiple-value-call passes back multiple values correctly")
2019 (Assert 2008 (Assert= 1 (length (multiple-value-list
2020 (= 1 (length (multiple-value-list 2009 (and (multiple-value-function-returning-nil) t)))
2021 (and (multiple-value-function-returning-nil) t))))
2022 "Checking multiple values from non-trailing forms discarded by #'and") 2010 "Checking multiple values from non-trailing forms discarded by #'and")
2023 (Assert 2011 (Assert= 5 (length (multiple-value-list
2024 (= 5 (length (multiple-value-list 2012 (and t (multiple-value-function-returning-nil))))
2025 (and t (multiple-value-function-returning-nil)))))
2026 "Checking multiple values from final forms not discarded by #'and") 2013 "Checking multiple values from final forms not discarded by #'and")
2027 (Assert 2014 (Assert= 1 (length (multiple-value-list
2028 (= 1 (length (multiple-value-list 2015 (or (multiple-value-function-returning-t) t)))
2029 (or (multiple-value-function-returning-t) t))))
2030 "Checking multiple values from non-trailing forms discarded by #'and") 2016 "Checking multiple values from non-trailing forms discarded by #'and")
2031 (Assert 2017 (Assert= 5 (length (multiple-value-list
2032 (= 5 (length (multiple-value-list 2018 (or nil (multiple-value-function-returning-t))))
2033 (or nil (multiple-value-function-returning-t)))))
2034 "Checking multiple values from final forms not discarded by #'and") 2019 "Checking multiple values from final forms not discarded by #'and")
2035 (Assert 2020 (Assert= 1 (length (multiple-value-list
2036 (= 1 (length (multiple-value-list 2021 (cond ((multiple-value-function-returning-t)))))
2037 (cond ((multiple-value-function-returning-t))))))
2038 "Checking cond doesn't pass back multiple values in tests.") 2022 "Checking cond doesn't pass back multiple values in tests.")
2039 (Assert 2023 (Assert-equal (list nil pi e radians-to-degrees degrees-to-radians)
2040 (equal (list nil pi e radians-to-degrees degrees-to-radians)
2041 (multiple-value-list 2024 (multiple-value-list
2042 (cond (t (multiple-value-function-returning-nil))))) 2025 (cond (t (multiple-value-function-returning-nil))))
2043 "Checking cond passes back multiple values in clauses.") 2026 "Checking cond passes back multiple values in clauses.")
2044 (Assert 2027 (Assert= 1 (length (multiple-value-list
2045 (= 1 (length (multiple-value-list 2028 (prog1 (multiple-value-function-returning-nil))))
2046 (prog1 (multiple-value-function-returning-nil)))))
2047 "Checking prog1 discards multiple values correctly.") 2029 "Checking prog1 discards multiple values correctly.")
2048 (Assert 2030 (Assert= 5 (length (multiple-value-list
2049 (= 5 (length (multiple-value-list
2050 (multiple-value-prog1 2031 (multiple-value-prog1
2051 (multiple-value-function-returning-nil))))) 2032 (multiple-value-function-returning-nil))))
2052 "Checking multiple-value-prog1 passes back multiple values correctly.") 2033 "Checking multiple-value-prog1 passes back multiple values correctly.")
2053 (Assert 2034 (Assert-equal (list t pi e degrees-to-radians radians-to-degrees)
2054 (equal (list t pi e degrees-to-radians radians-to-degrees)
2055 (multiple-value-list 2035 (multiple-value-list
2056 (catch 'VoN61Lo4Y (function-throwing-multiple-values))))) 2036 (catch 'VoN61Lo4Y (function-throwing-multiple-values))))
2057 (Assert 2037 (Assert-equal (list t pi e degrees-to-radians radians-to-degrees)
2058 (equal (list t pi e degrees-to-radians radians-to-degrees)
2059 (multiple-value-list 2038 (multiple-value-list
2060 (loop 2039 (loop
2061 for eye in `(a b c d ,e f g ,nil ,pi) 2040 for eye in `(a b c d ,e f g ,nil ,pi)
2062 do (when (null eye) 2041 do (when (null eye)
2063 (return (multiple-value-function-returning-t)))))) 2042 (return (multiple-value-function-returning-t)))))
2064 "Checking #'loop passes back multiple values correctly.") 2043 "Checking #'loop passes back multiple values correctly.")
2065 (Assert 2044 (Assert
2066 (null (or)) 2045 (null (or))
2067 "Checking #'or behaves correctly with zero arguments.") 2046 "Checking #'or behaves correctly with zero arguments.")
2068 (Assert 2047 (Assert-eq t (and)
2069 (eq t (and))
2070 "Checking #'and behaves correctly with zero arguments.") 2048 "Checking #'and behaves correctly with zero arguments.")
2071 (Assert 2049 (Assert= (* 3.0 (- pi 3.0))
2072 (= (* 3.0 (- pi 3.0))
2073 (letf (((values three one-four-one-five-nine) (floor pi))) 2050 (letf (((values three one-four-one-five-nine) (floor pi)))
2074 (* three one-four-one-five-nine))) 2051 (* three one-four-one-five-nine))
2075 "checking letf handles #'values in a basic sense")) 2052 "checking letf handles #'values in a basic sense"))
2076 2053
2077 ;; #'equalp tests. 2054 ;; #'equalp tests.
2078 (let ((string-variable "aBcDeeFgH\u00Edj") 2055 (let ((string-variable "aBcDeeFgH\u00Edj")
2079 (eacute-character ?\u00E9) 2056 (eacute-character ?\u00E9)
2080 (Eacute-character ?\u00c9) 2057 (Eacute-character ?\u00c9)
2081 (+base-chars+ (loop 2058 (+base-chars+ (loop
2082 with res = (make-string 96 ?\x20) 2059 with res = (make-string 96 ?\x20)
2083 for int-char from #x20 to #x7f 2060 for int-char from #x20 to #x7f
2084 for char being each element in-ref res 2061 for char being each element in-ref res
2085 do (setf char (int-to-char int-char)) 2062 do (setf char (int-to-char int-char))
2086 finally return res))) 2063 finally return res)))
2064 (let ((equal-lists
2065 '((111111111111111111111111111111111111111111111111111
2066 111111111111111111111111111111111111111111111111111.0)
2067 (0 0.0 0.000 -0 -0.0 -0.000 #b0 0/5 -0/5)
2068 (21845 #b101010101010101 #x5555)
2069 (1.5 1.500000000000000000000000000000000000000000000000000000000
2070 3/2)
2071 (-55 -110/2)
2072 ;; Can't use this, these values aren't `='.
2073 ;;(-12345678901234567890123457890123457890123457890123457890123457890
2074 ;; -12345678901234567890123457890123457890123457890123457890123457890.0)
2075 )))
2076 (loop for li in equal-lists do
2077 (loop for (x . tail) on li do
2078 (loop for y in tail do
2079 (Assert-equalp x y)
2080 (Assert-equalp y x)))))
2081
2082 (let ((diff-list
2083 `(0 1 2 3 1000 5000000000 5555555555555555555555555555555555555
2084 -1 -2 -3 -1000 -5000000000 -5555555555555555555555555555555555555
2085 1/2 1/3 2/3 8/2 355/113 (/ 3/2 0.2) (/ 3/2 0.7)
2086 55555555555555555555555555555555555555555/2718281828459045
2087 0.111111111111111111111111111111111111111111111111111111111111111
2088 1e+300 1e+301 -1e+300 -1e+301)))
2089 (loop for (x . tail) on diff-list do
2090 (loop for y in tail do
2091 (Assert-not-equalp x y)
2092 (Assert-not-equalp y x))))
2093
2087 (Assert-equalp "hi there" "Hi There" 2094 (Assert-equalp "hi there" "Hi There"
2088 "checking equalp isn't case-sensitive") 2095 "checking equalp isn't case-sensitive")
2089 (Assert-equalp 99 99.0 2096 (Assert-equalp 99 99.0
2090 "checking equalp compares numerical values of different types") 2097 "checking equalp compares numerical values of different types")
2091 (Assert (null (equalp 99 ?c)) 2098 (Assert (null (equalp 99 ?c))
2092 "checking equalp does not convert characters to numbers") 2099 "checking equalp does not convert characters to numbers")
2093 ;; Fixed in Hg d0ea57eb3de4. 2100 ;; Fixed in Hg d0ea57eb3de4.
2094 (Assert (null (equalp "hi there" [hi there])) 2101 (Assert (null (equalp "hi there" [hi there]))
2095 "checking equalp doesn't error with string and non-string") 2102 "checking equalp doesn't error with string and non-string")
2096 (Assert-eq t (equalp "ABCDEEFGH\u00CDJ" string-variable) 2103 (Assert-equalp "ABCDEEFGH\u00CDJ" string-variable
2097 "checking #'equalp is case-insensitive with an upcased constant") 2104 "checking #'equalp is case-insensitive with an upcased constant")
2098 (Assert-eq t (equalp "abcdeefgh\xedj" string-variable) 2105 (Assert-equalp "abcdeefgh\xedj" string-variable
2099 "checking #'equalp is case-insensitive with a downcased constant") 2106 "checking #'equalp is case-insensitive with a downcased constant")
2100 (Assert-eq t (equalp string-variable string-variable) 2107 (Assert-equalp string-variable string-variable
2101 "checking #'equalp works when handed the same string twice") 2108 "checking #'equalp works when handed the same string twice")
2102 (Assert-eq t (equalp string-variable "aBcDeeFgH\u00Edj") 2109 (Assert-equalp string-variable "aBcDeeFgH\u00Edj"
2103 "check #'equalp is case-insensitive with a variable-cased constant") 2110 "check #'equalp is case-insensitive with a variable-cased constant")
2104 (Assert-eq t (equalp "" (bit-vector)) 2111 (Assert-equalp "" (bit-vector)
2105 "check empty string and empty bit-vector are #'equalp.") 2112 "check empty string and empty bit-vector are #'equalp.")
2106 (Assert-eq t (equalp (string) (bit-vector)) 2113 (Assert-equalp (string) (bit-vector)
2107 "check empty string and empty bit-vector are #'equalp, no constants") 2114 "check empty string and empty bit-vector are #'equalp, no constants")
2108 (Assert-eq t (equalp "hi there" (vector ?h ?i ?\ ?t ?h ?e ?r ?e)) 2115 (Assert-equalp "hi there" (vector ?h ?i ?\ ?t ?h ?e ?r ?e)
2109 "check string and vector with same contents #'equalp") 2116 "check string and vector with same contents #'equalp")
2110 (Assert-eq t (equalp (string ?h ?i ?\ ?t ?h ?e ?r ?e) 2117 (Assert-equalp (string ?h ?i ?\ ?t ?h ?e ?r ?e)
2111 (vector ?h ?i ?\ ?t ?h ?e ?r ?e)) 2118 (vector ?h ?i ?\ ?t ?h ?e ?r ?e)
2112 "check string and vector with same contents #'equalp, no constants") 2119 "check string and vector with same contents #'equalp, no constants")
2113 (Assert-eq t (equalp [?h ?i ?\ ?t ?h ?e ?r ?e] 2120 (Assert-equalp [?h ?i ?\ ?t ?h ?e ?r ?e]
2114 (string ?h ?i ?\ ?t ?h ?e ?r ?e)) 2121 (string ?h ?i ?\ ?t ?h ?e ?r ?e)
2115 "check string and vector with same contents #'equalp, vector constant") 2122 "check string and vector with same contents #'equalp, vector constant")
2116 (Assert-eq t (equalp [0 1.0 0.0 0 1] 2123 (Assert-equalp [0 1.0 0.0 0 1]
2117 (bit-vector 0 1 0 0 1)) 2124 (bit-vector 0 1 0 0 1)
2118 "check vector and bit-vector with same contents #'equalp,\ 2125 "check vector and bit-vector with same contents #'equalp,\
2119 vector constant") 2126 vector constant")
2120 (Assert-eq t (equalp #*01001 2127 (Assert-not-equalp [0 2 0.0 0 1]
2121 (vector 0 1.0 0.0 0 1)) 2128 (bit-vector 0 1 0 0 1)
2122 "check vector and bit-vector with same contents #'equalp,\ 2129 "check vector and bit-vector with different contents not #'equalp,\
2130 vector constant")
2131 (Assert-equalp #*01001
2132 (vector 0 1.0 0.0 0 1)
2133 "check vector and bit-vector with same contents #'equalp,\
2123 bit-vector constant") 2134 bit-vector constant")
2124 (Assert-eq t (equalp ?\u00E9 Eacute-character) 2135 (Assert-equalp ?\u00E9 Eacute-character
2125 "checking characters are case-insensitive, one constant") 2136 "checking characters are case-insensitive, one constant")
2126 (Assert-eq nil (equalp ?\u00E9 (aref (format "%c" ?a) 0)) 2137 (Assert-not-equalp ?\u00E9 (aref (format "%c" ?a) 0)
2127 "checking distinct characters are not equalp, one constant") 2138 "checking distinct characters are not equalp, one constant")
2128 (Assert-eq t (equalp t (and)) 2139 (Assert-equalp t (and)
2129 "checking symbols are correctly #'equalp") 2140 "checking symbols are correctly #'equalp")
2130 (Assert-eq nil (equalp t (or nil '#:t)) 2141 (Assert-not-equalp t (or nil '#:t)
2131 "checking distinct symbols with the same name are not #'equalp") 2142 "checking distinct symbols with the same name are not #'equalp")
2132 (Assert-eq t (equalp #s(char-table type generic data (?\u0080 "hi-there")) 2143 (Assert-equalp #s(char-table type generic data (?\u0080 "hi-there"))
2133 (let ((aragh (make-char-table 'generic))) 2144 (let ((aragh (make-char-table 'generic)))
2134 (put-char-table ?\u0080 "hi-there" aragh) 2145 (put-char-table ?\u0080 "hi-there" aragh)
2135 aragh)) 2146 aragh)
2136 "checking #'equalp succeeds correctly, char-tables") 2147 "checking #'equalp succeeds correctly, char-tables")
2137 (Assert-eq nil (equalp #s(char-table type generic data (?\u0080 "hi-there")) 2148 (Assert-equalp #s(char-table type generic data (?\u0080 "hi-there"))
2138 (let ((aragh (make-char-table 'generic))) 2149 (let ((aragh (make-char-table 'generic)))
2139 (put-char-table ?\u0080 "HI-THERE" aragh) 2150 (put-char-table ?\u0080 "HI-THERE" aragh)
2140 aragh)) 2151 aragh)
2141 "checking #'equalp fails correctly, char-tables")) 2152 "checking #'equalp succeeds correctly, char-tables")
2153 (Assert-not-equalp #s(char-table type generic data (?\u0080 "hi-there"))
2154 (let ((aragh (make-char-table 'generic)))
2155 (put-char-table ?\u0080 "hi there" aragh)
2156 aragh)
2157 "checking #'equalp fails correctly, char-tables"))
2142 2158
2143 ;; There are more tests available for equalp here: 2159 ;; There are more tests available for equalp here:
2144 ;; 2160 ;;
2145 ;; http://www.parhasard.net/xemacs/equalp-tests.el 2161 ;; http://www.parhasard.net/xemacs/equalp-tests.el
2146 ;; 2162 ;;
2197 "checking #'assoc* correct if #'eql not explicitly specified") 2213 "checking #'assoc* correct if #'eql not explicitly specified")
2198 (Assert-eq 2214 (Assert-eq
2199 (rassoc* (1- most-negative-fixnum) assoc*-list) 2215 (rassoc* (1- most-negative-fixnum) assoc*-list)
2200 (rassoc* (1- most-negative-fixnum) assoc*-list :test #'eql) 2216 (rassoc* (1- most-negative-fixnum) assoc*-list :test #'eql)
2201 "checking #'rassoc* correct if #'eql not explicitly specified") 2217 "checking #'rassoc* correct if #'eql not explicitly specified")
2202 (Assert-eq 2218 (Assert-eql (1+most-positive-fixnum) (1+ most-positive-fixnum)
2203 (eql (1+most-positive-fixnum) (1+ most-positive-fixnum)) 2219 "checking #'eql handles a bignum literal properly.")
2204 t
2205 "checking #'eql handles a bignum literal properly.")
2206 (Assert-eq 2220 (Assert-eq
2207 (member* (1+most-positive-fixnum) member*-list) 2221 (member* (1+most-positive-fixnum) member*-list)
2208 (member* (1+ most-positive-fixnum) member*-list :test #'equal) 2222 (member* (1+ most-positive-fixnum) member*-list :test #'equal)
2209 "checking #'member* compiler macro correct with literal bignum") 2223 "checking #'member* compiler macro correct with literal bignum")
2210 (Assert-eq 2224 (Assert-eq