Skip to content
Snippets Groups Projects
Commit a8fa3994 authored by Nikodemus Siivola's avatar Nikodemus Siivola
Browse files

adjust tests

  Workarounds for the Clisp and CMUCL failures.

  Newer Clisp's no longer have the stack-overflow for the hash-table test, so
  enable it too.
parent 49555427
No related branches found
No related tags found
No related merge requests found
...@@ -10,6 +10,10 @@ ...@@ -10,6 +10,10 @@
(defun run-tests (&key ((:compiled *compile-tests*))) (defun run-tests (&key ((:compiled *compile-tests*)))
(do-tests)) (do-tests))
(defun hash-table-test-name (name)
;; Workaround for Clisp calling EQL in a hash-table FASTHASH-EQL.
(hash-table-test (make-hash-table :test name)))
;;;; Arrays ;;;; Arrays
(deftest copy-array.1 (deftest copy-array.1
...@@ -250,8 +254,6 @@ ...@@ -250,8 +254,6 @@
(= 42 (gethash x table))))))) (= 42 (gethash x table)))))))
t) t)
#+clisp (pushnew 'copy-hash-table.1 *expected-failures*)
(deftest copy-hash-table.1 (deftest copy-hash-table.1
(let ((orig (make-hash-table :test 'eq :size 123)) (let ((orig (make-hash-table :test 'eq :size 123))
(foo "foo")) (foo "foo"))
...@@ -260,9 +262,7 @@ ...@@ -260,9 +262,7 @@
(let ((eq-copy (copy-hash-table orig)) (let ((eq-copy (copy-hash-table orig))
(eql-copy (copy-hash-table orig :test 'eql)) (eql-copy (copy-hash-table orig :test 'eql))
(equal-copy (copy-hash-table orig :test 'equal)) (equal-copy (copy-hash-table orig :test 'equal))
;; CLISP overflows the stack with this bit. (equalp-copy (copy-hash-table orig :test 'equalp)))
;; See <http://sourceforge.net/tracker/index.php?func=detail&aid=2029069&group_id=1355&atid=101355>.
#-clisp (equalp-copy (copy-hash-table orig :test 'equalp)))
(list (eql (hash-table-size eq-copy) (hash-table-size orig)) (list (eql (hash-table-size eq-copy) (hash-table-size orig))
(eql (hash-table-rehash-size eq-copy) (eql (hash-table-rehash-size eq-copy)
(hash-table-rehash-size orig)) (hash-table-rehash-size orig))
...@@ -272,7 +272,7 @@ ...@@ -272,7 +272,7 @@
(gethash foo eql-copy) (gethash foo eql-copy)
(gethash (copy-seq foo) equal-copy) (gethash (copy-seq foo) equal-copy)
(gethash "FOO" equal-copy) (gethash "FOO" equal-copy)
#-clisp (gethash "FOO" equalp-copy)))) (gethash "FOO" equalp-copy))))
(t t 2 t nil t t nil t)) (t t 2 t nil t t nil t))
(deftest copy-hash-table.2 (deftest copy-hash-table.2
...@@ -351,8 +351,6 @@ ...@@ -351,8 +351,6 @@
(getf plist nil)))) (getf plist nil))))
(20 0 -2 -7 nil)) (20 0 -2 -7 nil))
#+clisp (pushnew 'alist-hash-table.1 *expected-failures*)
(deftest alist-hash-table.1 (deftest alist-hash-table.1
(let* ((alist '((0 a) (1 b) (2 c))) (let* ((alist '((0 a) (1 b) (2 c)))
(table (alist-hash-table alist))) (table (alist-hash-table alist)))
...@@ -360,10 +358,9 @@ ...@@ -360,10 +358,9 @@
(gethash 0 table) (gethash 0 table)
(gethash 1 table) (gethash 1 table)
(gethash 2 table) (gethash 2 table)
(hash-table-test table))) ; CLISP returns EXT:FASTHASH-EQL. (eq (hash-table-test-name 'eql)
(3 (a) (b) (c) eql)) (hash-table-test table))))
(3 (a) (b) (c) t))
#+clisp (pushnew 'plist-hash-table.1 *expected-failures*)
(deftest plist-hash-table.1 (deftest plist-hash-table.1
(let* ((plist '(:a 1 :b 2 :c 3)) (let* ((plist '(:a 1 :b 2 :c 3))
...@@ -374,8 +371,9 @@ ...@@ -374,8 +371,9 @@
(gethash :c table) (gethash :c table)
(gethash 2 table) (gethash 2 table)
(gethash nil table) (gethash nil table)
(hash-table-test table))) ; CLISP returns EXT:FASTHASH-EQ. (eq (hash-table-test-name 'eq)
(3 1 2 3 nil nil eq)) (hash-table-test table))))
(3 1 2 3 nil nil t))
;;;; Functions ;;;; Functions
...@@ -1285,8 +1283,8 @@ ...@@ -1285,8 +1283,8 @@
(member v (list v.vector v.list v.string)) (member v (list v.vector v.list v.string))
(equal l.list l) (equal l.list l)
(equalp l.vector #(1 2 3)) (equalp l.vector #(1 2 3))
(eql (upgraded-array-element-type 'fixnum) (type= (upgraded-array-element-type 'fixnum)
(array-element-type l.spec-v)) (array-element-type l.spec-v))
(equalp v.vector v) (equalp v.vector v)
(equal v.list '(#\a #\b #\c)) (equal v.list '(#\a #\b #\c))
(equal "abc" v.string)))) (equal "abc" v.string))))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment