Mercurial > hg > xemacs-beta

diff tests/automated/lisp-tests.el @ 5191:71ee43b8a74d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API tests/ChangeLog addition: 2010-04-05 Aidan Kehoe <kehoea@parhasard.net> * automated/hash-table-tests.el: Test the new built-in #'equalp hash table test. Test #'define-hash-table-test. * automated/lisp-tests.el: When asserting that two objects are #'equalp, also assert that their #'equalp-hash is identical. man/ChangeLog addition: 2010-04-03 Aidan Kehoe <kehoea@parhasard.net> * lispref/hash-tables.texi (Introduction to Hash Tables): Document that we now support #'equalp as a hash table test by default, and mention #'define-hash-table-test. (Working With Hash Tables): Document #'define-hash-table-test. src/ChangeLog addition: 2010-04-05 Aidan Kehoe <kehoea@parhasard.net> * elhash.h: * elhash.c (struct Hash_Table_Test, lisp_object_eql_equal) (lisp_object_eql_hash, lisp_object_equal_equal) (lisp_object_equal_hash, lisp_object_equalp_hash) (lisp_object_equalp_equal, lisp_object_general_hash) (lisp_object_general_equal, Feq_hash, Feql_hash, Fequal_hash) (Fequalp_hash, define_hash_table_test, Fdefine_hash_table_test) (init_elhash_once_early, mark_hash_table_tests, string_equalp_hash): * glyphs.c (vars_of_glyphs): Add a new hash table test in C, #'equalp. Make it possible to specify new hash table tests with functions define_hash_table_test, #'define-hash-table-test. Use define_hash_table_test() in glyphs.c. Expose the hash functions (besides that used for #'equal) to Lisp, for people writing functions to be used with #'define-hash-table-test. Call define_hash_table_test() very early in temacs, to create the built-in hash table tests. * ui-gtk.c (emacs_gtk_boxed_hash): * specifier.h (struct specifier_methods): * specifier.c (specifier_hash): * rangetab.c (range_table_entry_hash, range_table_hash): * number.c (bignum_hash, ratio_hash, bigfloat_hash): * marker.c (marker_hash): * lrecord.h (struct lrecord_implementation): * keymap.c (keymap_hash): * gui.c (gui_item_id_hash, gui_item_hash): * glyphs.c (image_instance_hash, glyph_hash): * glyphs-x.c (x_image_instance_hash): * glyphs-msw.c (mswindows_image_instance_hash): * glyphs-gtk.c (gtk_image_instance_hash): * frame-msw.c (mswindows_set_title_from_ibyte): * fontcolor.c (color_instance_hash, font_instance_hash): * fontcolor-x.c (x_color_instance_hash): * fontcolor-tty.c (tty_color_instance_hash): * fontcolor-msw.c (mswindows_color_instance_hash): * fontcolor-gtk.c (gtk_color_instance_hash): * fns.c (bit_vector_hash): * floatfns.c (float_hash): * faces.c (face_hash): * extents.c (extent_hash): * events.c (event_hash): * data.c (weak_list_hash, weak_box_hash): * chartab.c (char_table_entry_hash, char_table_hash): * bytecode.c (compiled_function_hash): * alloc.c (vector_hash): Change the various object hash methods to take a new EQUALP parameter, hashing appropriately for #'equalp if it is true.
author Aidan Kehoe <kehoea@parhasard.net>
date Mon, 05 Apr 2010 13:03:35 +0100
parents 000287f8053b
children d579d76f3dcc
line wrap: on
line diff
--- a/tests/automated/lisp-tests.el	Mon Apr 05 00:18:49 2010 -0500
+++ b/tests/automated/lisp-tests.el	Mon Apr 05 13:03:35 2010 +0100
@@ -2149,7 +2149,10 @@
 		 (push `(Assert (equalp ,(quote-maybe x)
 					,(quote-maybe y))) res)
 		 (push `(Assert (equalp ,(quote-maybe y)
-					,(quote-maybe x))) res))))
+					,(quote-maybe x))) res)
+                 (push `(Assert (eql (equalp-hash ,(quote-maybe y))
+                                     (equalp-hash ,(quote-maybe x))))
+                       res))))
 	   (cons 'progn (nreverse res))))
        (equalp-diff-list-tests (diff-list)
 	 (let (res)
@@ -2160,7 +2163,13 @@
 					   ,(quote-maybe y)))) res)
 	       (push `(Assert (not (equalp ,(quote-maybe y)
 					   ,(quote-maybe x)))) res)))
-	   (cons 'progn (nreverse res)))))
+	   (cons 'progn (nreverse res))))
+       (Assert-equalp (object-one object-two &optional failing-case description)
+         `(progn
+           (Assert (equalp ,object-one ,object-two)
+                   ,@(if failing-case
+                         (list failing-case description)))
+           (Assert (eql (equalp-hash ,object-one) (equalp-hash ,object-two))))))
     (equalp-equal-list-tests
      `(,@(when (featurep 'bignum)
 	  (read "((111111111111111111111111111111111111111111111111111
@@ -2183,72 +2192,78 @@
        ,@(when (featurep 'ratio) (mapcar* #'/ '(3/2 3/2) '(0.2 0.7)))
        55555555555555555555555555555555555555555/2718281828459045
        0.111111111111111111111111111111111111111111111111111111111111111
-       1e+300 1e+301 -1e+300 -1e+301)))
+       1e+300 1e+301 -1e+300 -1e+301))
 
-  (Assert (equalp "hi there" "Hi There")
-	  "checking equalp isn't case-sensitive")
-  (Assert (equalp 99 99.0)
-	  "checking equalp compares numerical values of different types")
-  (Assert (null (equalp 99 ?c))
-	  "checking equalp does not convert characters to numbers")
-  ;; Fixed in Hg d0ea57eb3de4.
-  (Assert (null (equalp "hi there" [hi there]))
-	  "checking equalp doesn't error with string and non-string")
-  (Assert (equalp "ABCDEEFGH\u00CDJ" string-variable)
-	  "checking #'equalp is case-insensitive with an upcased constant") 
-  (Assert (equalp "abcdeefgh\xedj" string-variable)
-	  "checking #'equalp is case-insensitive with a downcased constant")
-  (Assert (equalp string-variable string-variable)
-	  "checking #'equalp works when handed the same string twice")
-  (Assert (equalp string-variable "aBcDeeFgH\u00Edj")
-	  "check #'equalp is case-insensitive with a variable-cased constant")
-  (Assert (equalp "" (bit-vector)) 
-	  "check empty string and empty bit-vector are #'equalp.")
-  (Assert (equalp (string) (bit-vector)) 
-	  "check empty string and empty bit-vector are #'equalp, no constants")
-  (Assert (equalp "hi there" (vector ?h ?i ?\  ?t ?h ?e ?r ?e))
-	  "check string and vector with same contents #'equalp")
-  (Assert (equalp (string ?h ?i ?\  ?t ?h ?e ?r ?e)
-		  (vector ?h ?i ?\  ?t ?h ?e ?r ?e))
-	  "check string and vector with same contents #'equalp, no constants")
-  (Assert (equalp [?h ?i ?\  ?t ?h ?e ?r ?e]
-		  (string ?h ?i ?\  ?t ?h ?e ?r ?e))
-	  "check string and vector with same contents #'equalp, vector constant")
-  (Assert (equalp [0 1.0 0.0 0 1]
-		 (bit-vector 0 1 0 0 1))
-	  "check vector and bit-vector with same contents #'equalp,\
+    (Assert-equalp "hi there" "Hi There"
+                   "checking equalp isn't case-sensitive")
+    (Assert-equalp
+     99 99.0
+     "checking equalp compares numerical values of different types")
+    (Assert (null (equalp 99 ?c))
+            "checking equalp does not convert characters to numbers")
+    ;; Fixed in Hg d0ea57eb3de4.
+    (Assert (null (equalp "hi there" [hi there]))
+            "checking equalp doesn't error with string and non-string")
+    (Assert-equalp
+     "ABCDEEFGH\u00CDJ" string-variable
+     "checking #'equalp is case-insensitive with an upcased constant") 
+    (Assert-equalp
+     "abcdeefgh\xedj" string-variable
+     "checking #'equalp is case-insensitive with a downcased constant")
+    (Assert-equalp string-variable string-variable
+                   "checking #'equalp works when handed the same string twice")
+    (Assert (equalp string-variable "aBcDeeFgH\u00Edj")
+            "check #'equalp is case-insensitive with a variable-cased constant")
+    (Assert-equalp "" (bit-vector)
+                   "check empty string and empty bit-vector are #'equalp.")
+    (Assert-equalp
+     (string) (bit-vector)
+     "check empty string and empty bit-vector are #'equalp, no constants")
+    (Assert-equalp "hi there" (vector ?h ?i ?\  ?t ?h ?e ?r ?e)
+                   "check string and vector with same contents #'equalp")
+    (Assert-equalp
+     (string ?h ?i ?\  ?t ?h ?e ?r ?e)
+     (vector ?h ?i ?\  ?t ?h ?e ?r ?e)
+     "check string and vector with same contents #'equalp, no constants")
+    (Assert-equalp
+     [?h ?i ?\  ?t ?h ?e ?r ?e]
+     (string ?h ?i ?\  ?t ?h ?e ?r ?e)
+     "check string and vector with same contents #'equalp, vector constant")
+    (Assert-equalp [0 1.0 0.0 0 1]
+                   (bit-vector 0 1 0 0 1)
+                   "check vector and bit-vector with same contents #'equalp,\
  vector constant")
-  (Assert (not (equalp [0 2 0.0 0 1]
-		       (bit-vector 0 1 0 0 1)))
-	  "check vector and bit-vector with different contents not #'equalp,\
+    (Assert (not (equalp [0 2 0.0 0 1]
+                  (bit-vector 0 1 0 0 1)))
+            "check vector and bit-vector with different contents not #'equalp,\
  vector constant")
-  (Assert (equalp #*01001
-		 (vector 0 1.0 0.0 0 1))
+    (Assert-equalp #*01001
+                   (vector 0 1.0 0.0 0 1)
 	  "check vector and bit-vector with same contents #'equalp,\
  bit-vector constant")
-  (Assert (equalp ?\u00E9 Eacute-character)
-	  "checking characters are case-insensitive, one constant")
-  (Assert (not (equalp ?\u00E9 (aref (format "%c" ?a) 0)))
-	  "checking distinct characters are not equalp, one constant")
-  (Assert (equalp t (and))
-	  "checking symbols are correctly #'equalp")
-  (Assert (not (equalp t (or nil '#:t)))
-	  "checking distinct symbols with the same name are not #'equalp")
-  (Assert (equalp #s(char-table type generic data (?\u0080 "hi-there"))
-		  (let ((aragh (make-char-table 'generic)))
-		    (put-char-table ?\u0080 "hi-there" aragh)
-		    aragh))
-	  "checking #'equalp succeeds correctly, char-tables")
-  (Assert (equalp #s(char-table type generic data (?\u0080 "hi-there"))
-		  (let ((aragh (make-char-table 'generic)))
-		    (put-char-table ?\u0080 "HI-THERE" aragh)
-		    aragh))
-	  "checking #'equalp succeeds correctly, char-tables")
-  (Assert (not (equalp #s(char-table type generic data (?\u0080 "hi-there"))
-		       (let ((aragh (make-char-table 'generic)))
-			 (put-char-table ?\u0080 "hi there" aragh)
-			 aragh)))
-	  "checking #'equalp fails correctly, char-tables"))
+    (Assert-equalp ?\u00E9 Eacute-character
+                   "checking characters are case-insensitive, one constant")
+    (Assert (not (equalp ?\u00E9 (aref (format "%c" ?a) 0)))
+            "checking distinct characters are not equalp, one constant")
+    (Assert-equalp t (and)
+                   "checking symbols are correctly #'equalp")
+    (Assert (not (equalp t (or nil '#:t)))
+            "checking distinct symbols with the same name are not #'equalp")
+    (Assert-equalp #s(char-table type generic data (?\u0080 "hi-there"))
+                   (let ((aragh (make-char-table 'generic)))
+                     (put-char-table ?\u0080 "hi-there" aragh)
+                     aragh)
+                   "checking #'equalp succeeds correctly, char-tables")
+    (Assert-equalp #s(char-table type generic data (?\u0080 "hi-there"))
+                   (let ((aragh (make-char-table 'generic)))
+                     (put-char-table ?\u0080 "HI-THERE" aragh)
+                     aragh)
+                   "checking #'equalp succeeds correctly, char-tables")
+    (Assert (not (equalp #s(char-table type generic data (?\u0080 "hi-there"))
+                  (let ((aragh (make-char-table 'generic)))
+                    (put-char-table ?\u0080 "hi there" aragh)
+                    aragh)))
+            "checking #'equalp fails correctly, char-tables")))
 
 ;; There are more tests available for equalp here: 
 ;;