[b0ce08]: src / ansi-tests / hashlong.lisp Maximize Restore History

Download this file

hashlong.lisp    68 lines (60 with data), 2.3 kB

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
;;; based on v1.3 -*- mode: lisp -*-
(in-package :cl-user)
#+clisp
(setf (symbol-function 'setf-gethash)
(symbol-function 'sys::puthash))
#+(or akcl ecls)
(setf (symbol-function 'setf-gethash)
(symbol-function 'sys:hash-set)) t
#+allegro
(setf (symbol-function 'setf-gethash)
(symbol-function 'excl::%puthash)) t
#+cmu
(setf (symbol-function 'setf-gethash)
(symbol-function 'cl::%puthash)) t
#+sbcl
(setf (symbol-function 'setf-gethash)
(symbol-function 'sb-impl::%puthash)) t
#+ecl
(setf (symbol-function 'setf-gethash)
(symbol-function 'si::hash-set))
(check-for-bug :hashlong-legacy-21
(defun symbole ()
(let ((b 0.)
(hash-table (make-hash-table :size 20.
:rehash-threshold
#+xcl 15.
#-xcl 0.75))
(liste (make-list 50.))
(liste2 (make-list 50.)))
(rplacd (last liste) liste)
(rplacd (last liste2) liste2)
(do-symbols (x (find-package #+xcl 'lisptest
#-xcl "LISP"))
;; (print x) (finish-output)
(cond ((car liste)
(let ((hval (gethash (car liste) hash-table))
(lval (car liste2)))
(unless (eq hval lval)
(print "mist, hash-tabelle kaputt")
(print (car liste))
(print hash-table)
(print (hash-table-count hash-table))
(print "hval:") (print hval)
(print "lval:") (print lval)
(return-from symbole 'error))
(remhash (car liste) hash-table)
#+xcl (when (< (room) 30000.) (system::%garbage-collection))
(setf-gethash x hash-table (setq b (+ 1. b)))
(rplaca liste x)
(rplaca liste2 b)
(setq liste (cdr liste))
(setq liste2 (cdr liste2))))
(t (setf-gethash x hash-table (setq b (+ 1. b)))
(rplaca liste x)
(rplaca liste2 b)
(setq liste (cdr liste))
(setq liste2 (cdr liste2)))))))
symbole)
(check-for-bug :hashlong-legacy-61
(symbole) nil)