* lisp/emacs-lisp/map.el (map-into) <hash-table>: Allow keyword args

(map--into-hash): New function, extracted from `map-into <hash-table>`.
Speed it up a bit by using gethash instead of map-elt when we know
we're accessing a hash table.

* test/lisp/emacs-lisp/map-tests.el (test-map-into): Add corresponding test.

3 files changed, 28 insertions, 10 deletions

diff --git a/etc/NEWS b/etc/NEWS
index 4e7843ced85..2fe0a907ef4 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -665,6 +665,8 @@ at the end of the active minibuffer.
 *** New generic function 'map-insert'.
 
 +++
+** The 'type' arg can be a list '(hash-table :key1 VAL1 :key2 VAL2 ...)'
+
 ** seq.el
 New convenience functions 'seq-first' and 'seq-rest' give easy access
 to respectively the first and all but the first elements of sequences.
diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el
index 54e802edf4f..74927b6224f 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -338,7 +338,8 @@ The default implementation delegates to `map-apply'."
     t))
 
 (defun map-merge (type &rest maps)
-  "Merge into a map of type TYPE all the key/value pairs in MAPS."
+  "Merge into a map of type TYPE all the key/value pairs in MAPS.
+See `map-into' for all supported values of TYPE."
   (let ((result (map-into (pop maps) type)))
     (while maps
       ;; FIXME: When `type' is `list', we get an O(N^2) behavior.
@@ -354,7 +355,8 @@ The default implementation delegates to `map-apply'."
   "Merge into a map of type TYPE all the key/value pairs in MAPS.
 When two maps contain the same key (`eql'), call FUNCTION on the two
 values and use the value returned by it.
-MAP can be a list, hash-table or array."
+MAP can be a list, hash-table or array.
+See `map-into' for all supported values of TYPE."
   (let ((result (map-into (pop maps) type))
         (not-found (cons nil nil)))
     (while maps
@@ -458,17 +460,28 @@ If you want to insert an element in place, use `map-put!'."
                      (funcall function index elt))
                    array))
 
-(cl-defmethod map-into (map (_type (eql hash-table)))
-  "Convert MAP into a hash-table."
-  ;; FIXME: Just knowing we want a hash-table is insufficient, since that
-  ;; doesn't tell us the test function to use with it!
-  (let ((ht (make-hash-table :size (map-length map)
-                             :test 'equal)))
+(defun map--into-hash (map keyword-args)
+  "Convert MAP into a hash-table.
+KEYWORD-ARGS are forwarded to `make-hash-table'."
+  (let ((ht (apply #'make-hash-table keyword-args)))
     (map-apply (lambda (key value)
-                 (setf (map-elt ht key) value))
+                 (setf (gethash key ht) value))
                map)
     ht))
 
+(cl-defmethod map-into (map (_type (eql hash-table)))
+  "Convert MAP into a hash-table."
+  (map--into-hash map (list :size (map-length map) :test 'equal)))
+
+(cl-defmethod map-into (map (type (head hash-table)))
+  "Convert MAP into a hash-table.
+TYPE is a list where the car is `hash-table' and the cdr are the keyword-args
+forwarded to `make-hash-table'.
+
+Example:
+    (map-into '((1 . 3)) '(hash-table :test eql))"
+  (map--into-hash map (cdr type)))
+
 (defun map--make-pcase-bindings (args)
   "Return a list of pcase bindings from ARGS to the elements of a map."
   (seq-map (lambda (elt)
diff --git a/test/lisp/emacs-lisp/map-tests.el b/test/lisp/emacs-lisp/map-tests.el
index a54af8059b3..5e8c9cb9f07 100644
--- a/test/lisp/emacs-lisp/map-tests.el
+++ b/test/lisp/emacs-lisp/map-tests.el
@@ -340,7 +340,8 @@ Evaluate BODY for each created map.
 
 (ert-deftest test-map-into ()
   (let* ((alist '((a . 1) (b . 2)))
-         (ht (map-into alist 'hash-table)))
+         (ht (map-into alist 'hash-table))
+         (ht2 (map-into alist '(hash-table :test equal))))
     (should (hash-table-p ht))
     (should (equal (map-into (map-into alist 'hash-table) 'list)
                    alist))
@@ -349,6 +350,8 @@ Evaluate BODY for each created map.
                    (map-keys ht)))
     (should (equal (map-values (map-into (map-into ht 'list) 'hash-table))
                    (map-values ht)))
+    (should (equal (map-into ht 'alist) (map-into ht2 'alist)))
+    (should (eq (hash-table-test ht2) 'equal))
     (should (null (map-into nil 'list)))
     (should (map-empty-p (map-into nil 'hash-table)))
     (should-error (map-into [1 2 3] 'string))))