Commit cdf9ef50 authored by Tobias C. Rittweiler's avatar Tobias C. Rittweiler
Browse files

alexandria-copy-hashtable.diff

	* hash-tables.lisp (copy-hash-table): Added new &key arg :KEY;
	it's run on each element before it's stored in the new HT.
	Additionally, make all &key args get their default even when
	NIL was passed for them.

	* tests.lisp (copy-hash-table.2): New test case.
parent d7eb3427
(in-package :alexandria)
(defun copy-hash-table (table &key
(test (hash-table-test table))
(size (hash-table-size table))
(rehash-size (hash-table-size table))
(rehash-threshold (hash-table-rehash-threshold table)))
"Returns a shallow copy of hash table TABLE, with the same keys and values
(defun copy-hash-table (table &key key test size
rehash-size rehash-threshold)
"Returns a copy of hash table TABLE, with the same keys and values
as the TABLE. The copy has the same properties as the original, unless
overridden by the keyword arguments."
overridden by the keyword arguments.
Before each of the original values is set into the new hash-table, KEY
is invoked on the value. As KEY defaults to CL:IDENTITY, a shallow
copy is returned by default."
(setf key (or key 'identity))
(setf test (or test (hash-table-test table)))
(setf size (or size (hash-table-size table)))
(setf rehash-size (or rehash-size (hash-table-size table)))
(setf rehash-threshold (or rehash-threshold (hash-table-rehash-threshold table)))
(let ((copy (make-hash-table :test test :size size
:rehash-size rehash-size
:rehash-threshold rehash-threshold)))
(maphash (lambda (k v)
(setf (gethash k copy) v))
(setf (gethash k copy) (funcall key v)))
table)
copy))
......
......@@ -156,6 +156,24 @@
(gethash "FOO" equalp-copy))))
(123 2 t nil t t nil t))
(deftest copy-hash-table.2
(let ((ht (make-hash-table))
(list (list :list (vector :A :B :C))))
(setf (gethash 'list ht) list)
(let* ((shallow-copy (copy-hash-table ht))
(deep1-copy (copy-hash-table ht :key 'copy-list))
(list (gethash 'list ht))
(shallow-list (gethash 'list shallow-copy))
(deep1-list (gethash 'list deep1-copy)))
(list (eq ht shallow-copy)
(eq ht deep1-copy)
(eq list shallow-list)
(eq list deep1-list) ; outer list was copied.
(eq (second list) (second shallow-list))
(eq (second list) (second deep1-list)) ; inner vector wasn't copied.
)))
(nil nil t nil t t))
(deftest maphash-keys.1
(let ((keys nil)
(table (make-hash-table)))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment