gethash.lsp 4.52 KB
Newer Older
pfdietz's avatar
pfdietz committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Fri Nov 28 06:05:21 2003
;;;; Contains: Tests of GETHASH

(in-package :cl-test)

;;; Most testing of GETHASH is in test-hash-table-1 in hash-table-aux.lsp

(deftest gethash.1
  (gethash 'x (make-hash-table) 'y)
  y nil)

(deftest gethash.2
  (gethash nil (make-hash-table) 'a)
  a nil)

(deftest gethash.3
  (gethash nil (make-hash-table) 'a)
  a nil)

(deftest gethash.4
  (multiple-value-bind (value present)
      (gethash 'a (let ((table (make-hash-table)))
sds's avatar
sds committed
25 26
                    (setf (gethash 'a table) 'b)
                    table))
pfdietz's avatar
pfdietz committed
27 28 29 30 31
    (values value (notnot present)))
  b t)

(deftest gethash.5
  (let ((table (make-hash-table))
sds's avatar
sds committed
32
        (i 0))
pfdietz's avatar
pfdietz committed
33 34 35 36 37 38
    (values
     (setf (gethash 'x table (incf i)) 'y)
     i
     (gethash 'x table)))
  y 1 y)

39 40
(deftest gethash.order.1
  (let ((i 0) x y
sds's avatar
sds committed
41
        (table (make-hash-table)))
42 43 44
    (setf (gethash 'a table) 'b)
    (values
     (gethash (progn (setf x (incf i)) 'a)
sds's avatar
sds committed
45
              (progn (setf y (incf i)) table))
46 47 48 49 50
     i x y))
  b 2 1 2)

(deftest gethash.order.2
  (let ((i 0) x y z
sds's avatar
sds committed
51
        (table (make-hash-table)))
52 53 54
    (setf (gethash 'a table) 'b)
    (values
     (gethash (progn (setf x (incf i)) 'a)
sds's avatar
sds committed
55 56
              (progn (setf y (incf i)) table)
              (progn (setf z (incf i)) 'missing))
57 58 59 60 61
     i x y z))
  b 3 1 2 3)

(deftest gethash.order.3
  (let ((i 0) x y
sds's avatar
sds committed
62
        (table (make-hash-table)))
63 64
    (values
      (setf (gethash (progn (setf x (incf i)) 'a)
sds's avatar
sds committed
65 66
                     (progn (setf y (incf i)) table))
            'b)
67 68 69 70 71 72
      i x y
      (gethash 'a table)))
  b 2 1 2 b)

(deftest gethash.order.4
  (let ((i 0) x y z
sds's avatar
sds committed
73
        (table (make-hash-table)))
74 75
    (values
      (setf (gethash (progn (setf x (incf i)) 'a)
sds's avatar
sds committed
76 77 78
                     (progn (setf y (incf i)) table)
                     (setf z (incf i)))
            'b)
79 80 81 82
      i x y z
      (gethash 'a table)))
  b 3 1 2 3 b)

83 84 85 86 87

;;; Tests for 0.0, -0.0 in hash tables

(deftest gethash.zero.1
  (loop for pz in '(0.0s0 0.0f0 0.0d0 0.0l0)
sds's avatar
sds committed
88 89 90 91 92 93 94 95 96 97 98 99
        for nz = (- pz)
        for result = (let ((table (make-hash-table :test 'eq)))
                       (list
                        (setf (gethash pz table) :x)
                        (gethash pz table)
                        (gethash nz table)
                        (setf (gethash nz table) :y)
                        (gethash pz table)
                        (gethash nz table)))
        unless (or (eql pz nz)
                   (equal result '(:x :x nil :y :x :y)))
        collect (list pz nz result))
100 101 102 103
  nil)

(deftest gethash.zero.2
  (loop for pz in '(0.0s0 0.0f0 0.0d0 0.0l0)
sds's avatar
sds committed
104 105 106 107 108 109 110 111 112 113 114 115
        for nz = (- pz)
        for result = (let ((table (make-hash-table :test 'eql)))
                       (list
                        (setf (gethash pz table) :x)
                        (gethash pz table)
                        (gethash nz table)
                        (setf (gethash nz table) :y)
                        (gethash pz table)
                        (gethash nz table)))
        unless (or (eql pz nz)
                   (equal result '(:x :x nil :y :x :y)))
        collect (list pz nz result))
116 117 118 119
  nil)

(deftest gethash.zero.3
  (loop for pz in '(0.0s0 0.0f0 0.0d0 0.0l0)
sds's avatar
sds committed
120 121 122 123 124 125 126 127 128 129 130 131
        for nz = (- pz)
        for result = (let ((table (make-hash-table :test 'equal)))
                       (list
                        (setf (gethash pz table) :x)
                        (gethash pz table)
                        (gethash nz table)
                        (setf (gethash nz table) :y)
                        (gethash pz table)
                        (gethash nz table)))
        unless (or (eql pz nz)
                   (equal result '(:x :x nil :y :x :y)))
        collect (list pz nz result))
132 133 134 135
  nil)

(deftest gethash.zero.4
  (loop for pz in '(0.0s0 0.0f0 0.0d0 0.0l0)
sds's avatar
sds committed
136 137 138 139 140 141 142 143 144 145 146 147
        for nz = (- pz)
        for result = (let ((table (make-hash-table :test 'equalp)))
                       (list
                        (setf (gethash pz table) :x)
                        (gethash pz table)
                        (gethash nz table)
                        (setf (gethash nz table) :y)
                        (gethash pz table)
                        (gethash nz table)))
        unless (or (eql pz nz)
                   (equal result '(:x :x :x :y :y :y)))
        collect (list pz nz result))
148 149
  nil)

150 151
;;;; Error tests

pfdietz's avatar
pfdietz committed
152
(deftest gethash.error.1
153 154
  (signals-error (gethash) program-error)
  t)
pfdietz's avatar
pfdietz committed
155 156

(deftest gethash.error.2
157 158
  (signals-error (gethash 'foo) program-error)
  t)
pfdietz's avatar
pfdietz committed
159 160

(deftest gethash.error.3
161 162
  (signals-error (gethash 'foo (make-hash-table) nil nil) program-error)
  t)