Guile-hoot/test/test-hashtables.scm

;;; Copyright (C) 2024 David Thompson <dave@spritely.institute>
;;; Copyright (C) 2023, 2024 Robin Templeton
;;;
;;; 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.

;;; Commentary:
;;;
;;; Hashtable tests.
;;;
;;; Code:

(use-modules (srfi srfi-64)
             (test utils))

(test-begin "test-hashtables")

(with-additional-imports
    ((hoot hashtables))

  ;; Hashing pairs and lists.
  (test-call "228" (lambda () (hash '(a . b) 389)))
  (test-call "94" (lambda () (hash '(a b) 389)))
  ;; Deeply nested list.
  (test-call "69" (lambda ()  (hash '(a (b (c (d (e (f (g (h (i))))))))) 389)))
  ;; Circular list!
  (test-call "65"
             (lambda ()
               (let ((x (list 'a 'b 'c)))
                 (set-cdr! (cdr (cdr x)) x)
                 (hash x 389))))
  ;; Hash composition should not be commutative.
  (test-call "#f" (lambda () (= (hash '(a . b) 389) (hash '(b . a) 389))))

  ;; Hashing vectors of different length.
  (test-call "200" (lambda () (hash #() 389)))
  (test-call "222" (lambda () (hash #(1 2 3) 389)))

  ;; Hashing bytevectors of different length.
  (test-call "51"  (lambda () (hash #vu8() 389)))
  (test-call "155" (lambda () (hash #vu8(1) 389)))
  (test-call "224" (lambda () (hash #vu8(1 2) 389)))
  (test-call "294" (lambda () (hash #vu8(1 2 3) 389)))
  (test-call "206" (lambda () (hash #vu8(1 2 3 4) 389)))

  ;; Hashing bitvectors of different length.
  (test-call "173" (lambda () (hash #* 389)))
  (test-call "195" (lambda () (hash #*1010 389)))
  (test-call "119" (lambda () (hash #*01010 389)))

  ;; Empty bytevector should have different hash than empty bitvector.
  (test-call "#f" (lambda () (= (hash #vu8() 389) (hash #* 389))))

  ;; Hashing records.
  (test-call "222"
             (lambda ()
               (define-record-type q (make-q a) q? (a q-a))
               (hash (make-q 42) 389)))

  ;; Ref hit
  (test-call "b"
             (lambda ()
               (let ((ht (make-eq-hashtable)))
                 (hashtable-set! ht 'a 'b)
                 (hashtable-ref ht 'a))))

  ;; Ref miss
  (test-call "#f"
             (lambda ()
               (let ((ht (make-eq-hashtable)))
                 (hashtable-set! ht 'x 'y)
                 (hashtable-ref ht 'a))))

  ;; Ref miss with default
  (test-call "b"
             (lambda ()
               (let ((ht (make-eq-hashtable)))
                 (hashtable-set! ht 'x 'y)
                 (hashtable-ref ht 'a 'b))))

  ;; Key insertion increases size
  (test-call "1"
             (lambda ()
               (let ((ht (make-eq-hashtable)))
                 (hashtable-set! ht 'a 'b)
                 (hashtable-size ht))))

  ;; Key deletion
  (test-call "#f"
             (lambda ()
               (let ((ht (make-eq-hashtable)))
                 (hashtable-set! ht 'a 'b)
                 (hashtable-delete! ht 'a)
                 (hashtable-contains? ht 'a))))

  ;; Key deletion decrements size
  (test-call "0"
             (lambda ()
               (let ((ht (make-eq-hashtable)))
                 (hashtable-set! ht 'a 'b)
                 (hashtable-delete! ht 'a)
                 (hashtable-size ht))))

  ;; Key deletion miss does not decrement size
  (test-call "1"
             (lambda ()
               (let ((ht (make-eq-hashtable)))
                 (hashtable-set! ht 'a 'b)
                 (hashtable-delete! ht 'c)
                 (hashtable-size ht))))

  ;; Check for existing key
  (test-call "#t"
             (lambda ()
               (let ((ht (make-eq-hashtable)))
                 (hashtable-set! ht 'a 'b)
                 (hashtable-contains? ht 'a))))

  ;; Copy
  (test-call "(2 b d)"
             (lambda ()
               (let ((ht (make-eq-hashtable)))
                 (hashtable-set! ht 'a 'b)
                 (hashtable-set! ht 'c 'd)
                 (let ((ht* (hashtable-copy ht)))
                   (list (hashtable-size ht*)
                         (hashtable-ref ht* 'a)
                         (hashtable-ref ht* 'c))))))

  ;; Clear sets size to 0
  (test-call "0"
             (lambda ()
               (let ((ht (make-eq-hashtable)))
                 (hashtable-set! ht 'a 'b)
                 (hashtable-clear! ht)
                 (hashtable-size ht))))

  ;; Clear removes all associations
  (test-call "#f"
             (lambda ()
               (let ((ht (make-eq-hashtable)))
                 (hashtable-set! ht 'a 'b)
                 (hashtable-clear! ht)
                 (hashtable-contains? ht 'a))))

  ;; Keys of an empty table
  (test-call "()"
             (lambda ()
               (hashtable-keys (make-eq-hashtable))))

  ;; Keys of a populated table
  (test-call "(a)"
             (lambda ()
               (let ((ht (make-eq-hashtable)))
                 (hashtable-set! ht 'a 'b)
                 (hashtable-keys ht))))

  ;; Values of an empty table
  (test-call "()"
             (lambda ()
               (hashtable-values (make-eq-hashtable))))

  ;; Values of a populated table
  (test-call "(b)"
             (lambda ()
               (let ((ht (make-eq-hashtable)))
                 (hashtable-set! ht 'a 'b)
                 (hashtable-values ht))))

  ;; For each iteration
  (test-call "(a b)"
             (lambda ()
               (let ((ht (make-eq-hashtable))
                     (result #f))
                 (hashtable-set! ht 'a 'b)
                 (hashtable-for-each (lambda (k v)
                                       (set! result (list k v)))
                                     ht)
                 result)))

  ;; Fold (result order is technically unspecified but we know what it
  ;; will be)
  (test-call "((a . b) (c . d))"
             (lambda ()
               (let ((ht (make-eq-hashtable))
                     (result #f))
                 (hashtable-set! ht 'a 'b)
                 (hashtable-set! ht 'c 'd)
                 (hashtable-fold (lambda (k v prev)
                                   (cons (cons k v) prev))
                                 '()
                                 ht))))

  ;; Grow/shrink
  (test-call "100"
             (lambda ()
               (let ((ht (make-eq-hashtable)))
                 (do ((i 0 (+ i 1)))
                     ((= i 100))
                   (hashtable-set! ht i i))
                 (do ((i 0 (+ i 1)))
                     ((= i 100))
                   (hashtable-delete! ht i))
                 (do ((i 0 (+ i 1)))
                     ((= i 100))
                   (hashtable-set! ht i i))
                 (hashtable-size ht))))

  ;; Weak key hashtables
  (test-call "42"
             (lambda ()
               (let ((table (make-weak-key-hashtable))
                     (a (list 1 2 3))
                     (b (list 1 2 3)))
                 (weak-key-hashtable-set! table a 42)
                 (weak-key-hashtable-set! table b 13)
                 (weak-key-hashtable-ref table a))))

  (test-call "uh-oh"
             (lambda ()
               (let ((table (make-weak-key-hashtable)))
                 (weak-key-hashtable-ref table 'foo 'uh-oh))))
  (test-call "#f"
             (lambda ()
               (let ((table (make-weak-key-hashtable)))
                 (weak-key-hashtable-set! table 'foo 42)
                 (weak-key-hashtable-delete! table 'foo)
                 (weak-key-hashtable-ref table 'foo))))

  ;; Hash functions
  (test-call "6" (lambda () (hashq 42 37))))

;; Guile legacy API
(with-imports ((guile))
  (test-call "42"
             (lambda ()
               (let ((table (make-hash-table)))
                 (hashq-set! table 'foo 42)
                 (hashq-ref table 'foo))))

  (test-call "#f"
             (lambda ()
               (let ((table (make-hash-table)))
                 (hash-set! table "foo" 42)
                 (hash-remove! table "foo")
                 (hash-ref table "foo"))))

  (test-call "42"
             (lambda ()
               (let ((table (make-weak-key-hash-table)))
                 (hashq-set! table 'foo 42)
                 (hashq-ref table 'foo))))

  (test-call "((baz . 3) (bar . 2) (foo . 1))"
             (lambda ()
               (let ((table (make-hash-table)))
                 (hashq-set! table 'foo 1)
                 (hashq-set! table 'bar 2)
                 (hashq-set! table 'baz 3)
                 (hash-map->list cons table))))

  (test-call "3"
             (lambda ()
               (let ((table (make-hash-table)))
                 (hash-set! table "foo" 1)
                 (hash-set! table "bar" 2)
                 (hash-set! table "baz" 3)
                 (hash-count (lambda (key val) #t) table))))

  ;; clear, fold, and for-each on an empty table should no-op because
  ;; we don't yet know the concrete table type.
  (test-call "#t"
             (lambda ()
               (let ((table (make-hash-table)))
                 (hash-clear! table)
                 #t)))
  (test-call "0"
             (lambda ()
               (let ((table (make-hash-table)))
                 (hash-fold (lambda (key val sum)
                              (+ sum val))
                            0 table))))
  (test-call "0"
             (lambda ()
               (let ((count 0)
                     (table (make-hash-table)))
                 (hash-for-each (lambda (key val)
                                  (set! count (1+ count)))
                                table)
                 count))))

(test-end* "test-hashtables")