]> git.eshelyaron.com Git - emacs.git/commitdiff
Fix merging of ambiguous nil maps
authorBasil L. Contovounesios <contovob@tcd.ie>
Tue, 3 Aug 2021 23:48:50 +0000 (00:48 +0100)
committerBasil L. Contovounesios <contovob@tcd.ie>
Sat, 14 Aug 2021 10:24:54 +0000 (11:24 +0100)
* lisp/emacs-lisp/map.el: Bump version to 3.1.
(map--merge): New merging subroutine that uses a hash table in place
of lists, for both efficiency and avoiding ambiguities (bug#49848).
(map-merge): Rewrite in terms of map--merge.
(map-merge-with): Ditto.  This ensures that FUNCTION is called
whenever two keys are merged, even if they are not eql (which could
happen until now).  It also makes map-merge-with consistent with
map-merge, thus achieving greater overall predictability.
* etc/NEWS: Announce this weakening of guarantees.
* test/lisp/emacs-lisp/map-tests.el (test-map-merge)
(test-map-merge-with): Don't depend on specific orderings.  Test
that nil is correctly merged into a plist.

etc/NEWS
lisp/emacs-lisp/map.el
test/lisp/emacs-lisp/map-tests.el

index 366ea1abd6dd13266e163b0e7c6b98f53e3396bd..a321ffd81f1e494bfa38f135c2f8724f11c61e8b 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1636,6 +1636,14 @@ This is a slightly deeper copy than the previous 'copy-sequence'.
 ---
 *** The function 'map-contains-key' now supports plists.
 
+---
+*** More consistent duplicate key handling in 'map-merge-with'.
+Until now, 'map-merge-with' promised to call its function argument
+whenever multiple maps contained 'eql' keys.  However, this did not
+always coincide with the keys that were actually merged, which could
+be 'equal' instead.  The function argument is now called whenever keys
+are merged, for greater consistency with 'map-merge' and 'map-elt'.
+
 ** Package
 
 ---
index c59342875dbd5eaec191130ed17ee9847f768526..988a62a4e34cb6982c05d300363d419440dce20f 100644 (file)
@@ -5,7 +5,7 @@
 ;; Author: Nicolas Petton <nicolas@petton.fr>
 ;; Maintainer: emacs-devel@gnu.org
 ;; Keywords: extensions, lisp
-;; Version: 3.0
+;; Version: 3.1
 ;; Package-Requires: ((emacs "26"))
 
 ;; This file is part of GNU Emacs.
@@ -371,37 +371,51 @@ The default implementation delegates to `map-do'."
             map)
     t))
 
+(defun map--merge (merge type &rest maps)
+  "Merge into a map of TYPE all the key/value pairs in MAPS.
+MERGE is a function that takes the target MAP, a KEY, and a
+VALUE, merges KEY and VALUE into MAP, and returns the result.
+MAP may be of a type other than TYPE."
+  ;; Use a hash table internally if `type' is a list.  This avoids
+  ;; both quadratic lookup behavior and the type ambiguity of nil.
+  (let* ((tolist (memq type '(list alist plist)))
+         (result (map-into (pop maps)
+                            ;; Use same testfn as `map-elt' gv setter.
+                           (cond ((eq type 'plist) '(hash-table :test eq))
+                                 (tolist '(hash-table :test equal))
+                                 (type)))))
+    (dolist (map maps)
+      (map-do (lambda (key value)
+                (setq result (funcall merge result key value)))
+              map))
+    ;; Convert internal representation to desired type.
+    (if tolist (map-into result type) result)))
+
 (defun map-merge (type &rest maps)
   "Merge into a map of 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.
-      ;; For small tables, this is fine, but for large tables, we
-      ;; should probably use a hash-table internally which we convert
-      ;; to an alist in the end.
-      (map-do (lambda (key value)
-                (setf (map-elt result key) value))
-              (pop maps)))
-    result))
+  (apply #'map--merge
+         (lambda (result key value)
+           (setf (map-elt result key) value)
+           result)
+         type maps))
 
 (defun map-merge-with (type function &rest maps)
   "Merge into a map of TYPE all the key/value pairs in MAPS.
-When two maps contain the same (`eql') key, call FUNCTION on the two
+When two maps contain the same key, call FUNCTION on the two
 values and use the value returned by it.
 Each of MAPS can be an alist, plist, hash-table, or array.
 See `map-into' for all supported values of TYPE."
-  (let ((result (map-into (pop maps) type))
-        (not-found (list nil)))
-    (while maps
-      (map-do (lambda (key value)
-                (cl-callf (lambda (old)
-                            (if (eql old not-found)
-                                value
-                              (funcall function old value)))
-                    (map-elt result key not-found)))
-              (pop maps)))
-    result))
+  (let ((not-found (list nil)))
+    (apply #'map--merge
+           (lambda (result key value)
+             (cl-callf (lambda (old)
+                         (if (eql old not-found)
+                             value
+                           (funcall function old value)))
+                 (map-elt result key not-found))
+             result)
+           type maps)))
 
 (cl-defgeneric map-into (map type)
   "Convert MAP into a map of TYPE.")
index a04c6bef02a058ab52bf3a9158dde627980cddfd..658ed2e7119fe15bc777f538cba7eb4fcee346fa 100644 (file)
@@ -446,16 +446,24 @@ Evaluate BODY for each created map."
 
 (ert-deftest test-map-merge ()
   "Test `map-merge'."
-  (should (equal (map-merge 'list '(a 1) '((b . 2) (c . 3))
-                            #s(hash-table data (c 4)))
-                 '((c . 4) (b . 2) (a . 1)))))
+  (should (equal (sort (map-merge 'list '(a 1) '((b . 2) (c . 3))
+                                  #s(hash-table data (c 4)))
+                       (lambda (x y) (string< (car x) (car y))))
+                 '((a . 1) (b . 2) (c . 4))))
+  (should (equal (map-merge 'list () '(:a 1)) '((:a . 1))))
+  (should (equal (map-merge 'alist () '(:a 1)) '((:a . 1))))
+  (should (equal (map-merge 'plist () '(:a 1)) '(:a 1))))
 
 (ert-deftest test-map-merge-with ()
-  (should (equal (map-merge-with 'list #'+
-                                 '((1 . 2))
-                                 '((1 . 3) (2 . 4))
-                                 '((1 . 1) (2 . 5) (3 . 0)))
-                 '((3 . 0) (2 . 9) (1 . 6)))))
+  (should (equal (sort (map-merge-with 'list #'+
+                                       '((1 . 2))
+                                       '((1 . 3) (2 . 4))
+                                       '((1 . 1) (2 . 5) (3 . 0)))
+                       #'car-less-than-car)
+                 '((1 . 6) (2 . 9) (3 . 0))))
+  (should (equal (map-merge-with 'list #'+ () '(:a 1)) '((:a . 1))))
+  (should (equal (map-merge-with 'alist #'+ () '(:a 1)) '((:a . 1))))
+  (should (equal (map-merge-with 'plist #'+ () '(:a 1)) '(:a 1))))
 
 (ert-deftest test-map-merge-empty ()
   "Test merging of empty maps."