109 lines
4.9 KiB
Common Lisp
109 lines
4.9 KiB
Common Lisp
;;; Copyright 2013 Google Inc.
|
|
;;;
|
|
;;; Licensed under the Apache License, Version 2.0 (the "License");
|
|
;;; you may not use this file except in compliance with the License.
|
|
;;; You may obtain a copy of the License at
|
|
;;;
|
|
;;; http://www.apache.org/licenses/LICENSE-2.0
|
|
;;;
|
|
;;; Unless required by applicable law or agreed to in writing, software
|
|
;;; distributed under the License is distributed on an "AS IS" BASIS,
|
|
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
|
;;; See the License for the specific language governing permissions and
|
|
;;; limitations under the License.
|
|
|
|
;;; A hash table data structure is sometimes known as a dictionary.
|
|
|
|
(define-test make-hash-table
|
|
(let ((my-hash-table (make-hash-table)))
|
|
(true-or-false? ____ (typep my-hash-table 'hash-table))
|
|
(true-or-false? ____ (hash-table-p my-hash-table))
|
|
(true-or-false? ____ (hash-table-p (make-array '(3 3 3))))
|
|
;; The function HASH-TABLE-COUNT returns the number of entries currently
|
|
;; contained in a hash table.
|
|
(assert-equal ____ (hash-table-count my-hash-table))))
|
|
|
|
(define-test gethash
|
|
;; The function GETHASH can be used to access hash table values.
|
|
(let ((cube-roots (make-hash-table)))
|
|
;; We add the key-value pair 1 - "uno" to the hash table.
|
|
(setf (gethash 1 cube-roots) "uno")
|
|
(assert-equal ____ (gethash 1 cube-roots))
|
|
(assert-equal ____ (hash-table-count cube-roots))
|
|
(setf (gethash 8 cube-roots) 2)
|
|
(setf (gethash -3 cube-roots) -27)
|
|
(assert-equal ____ (gethash -3 cube-roots))
|
|
(assert-equal ____ (hash-table-count cube-roots))
|
|
;; GETHASH returns a secondary value that is true if the key was found in
|
|
;; the hash-table and false otherwise.
|
|
(multiple-value-bind (value foundp) (gethash 8 cube-roots)
|
|
(assert-equal ____ value)
|
|
(assert-equal ____ foundp))
|
|
(multiple-value-bind (value foundp) (gethash 125 cube-roots)
|
|
(assert-equal ____ value)
|
|
(assert-equal ____ foundp))))
|
|
|
|
(define-test hash-table-test
|
|
;; A hash table can be constructed with different test predicates.
|
|
;; The programmer may choose between EQ, EQL, EQUAL, and EQUALP to get the
|
|
;; best performance and expected results from the hash table.
|
|
;; The default test predicate is EQL.
|
|
(let ((eq-table (make-hash-table :test #'eq))
|
|
(eql-table (make-hash-table))
|
|
(equal-table (make-hash-table :test #'equal))
|
|
(equalp-table (make-hash-table :test #'equalp)))
|
|
;; We will define four variables whose values are strings.
|
|
(let* ((string "one")
|
|
(same-string string)
|
|
(string-copy (copy-seq string))
|
|
(string-upcased "ONE"))
|
|
;; We will insert the value of each variable into each hash table.
|
|
(dolist (thing (list string same-string string-copy string-upcased))
|
|
(dolist (hash-table (list eq-table eql-table equal-table equalp-table))
|
|
(setf (gethash thing hash-table) t))))
|
|
;; How many entries does each hash table contain?
|
|
(assert-equal ____ (hash-table-count eq-table))
|
|
(assert-equal ____ (hash-table-count eql-table))
|
|
(assert-equal ____ (hash-table-count equal-table))
|
|
(assert-equal ____ (hash-table-count equalp-table))))
|
|
|
|
(define-test hash-table-equality
|
|
;; EQUALP considers two hash tables to be equal if they have the same test and
|
|
;; if its key-value pairs are the same under that test.
|
|
(let ((hash-table-1 (make-hash-table :test #'equal))
|
|
(hash-table-2 (make-hash-table :test #'equal)))
|
|
(setf (gethash "one" hash-table-1) "yat")
|
|
(setf (gethash "one" hash-table-2) "yat")
|
|
(setf (gethash "two" hash-table-1) "yi")
|
|
(setf (gethash "two" hash-table-2) "yi")
|
|
(true-or-false? ____ (eq hash-table-1 hash-table-2))
|
|
(true-or-false? ____ (equal hash-table-1 hash-table-2))
|
|
(true-or-false? ____ (equalp hash-table-1 hash-table-2))))
|
|
|
|
(define-test i-will-make-it-equalp
|
|
;; Disabled on ECL due to a conformance bug.
|
|
;; See https://gitlab.com/embeddable-common-lisp/ecl/-/issues/587
|
|
#-ecl
|
|
(let ((hash-table-1 (make-hash-table :test #'equal))
|
|
(hash-table-2 (make-hash-table :test #'equal)))
|
|
(setf (gethash "one" hash-table-1) "uno"
|
|
(gethash "two" hash-table-1) "dos")
|
|
(setf (gethash "one" hash-table-2) "eins"
|
|
(gethash "two" hash-table-2) "zwei")
|
|
(assert-false (equalp hash-table-1 hash-table-2))
|
|
;; Change the first hash table to be EQUALP to the second one.
|
|
(setf (gethash ____ hash-table-1) ____
|
|
(gethash ____ hash-table-1) ____)
|
|
(assert-true (equalp hash-table-1 hash-table-2))))
|
|
|
|
(define-test make-your-own-hash-table
|
|
;; Make your own hash table that satisfies the test.
|
|
(let ((colors ____))
|
|
;; You will need to modify your hash table after you create it.
|
|
____
|
|
(assert-equal (hash-table-count colors) 4)
|
|
(let ((values (list (gethash "blue" colors)
|
|
(gethash "green" colors)
|
|
(gethash "red" colors))))
|
|
(assert-equal values '((0 0 1) (0 1 0) (1 0 0))))))
|