From: npostavs@users.sourceforge.net
To: Mark Oteiza <mvoteiza@udel.edu>
Cc: 24966@debbugs.gnu.org
Subject: bug#24966: 26.0.50; test-completion with alist COLLECTION calls PREDICATE incorrectly
Date: Mon, 28 Nov 2016 22:31:32 -0500 [thread overview]
Message-ID: <878ts3hsh7.fsf@users.sourceforge.net> (raw)
In-Reply-To: <CAM-tV-_aYQiaLcOGkcyrnkp6=92s-sYw9d82cdxN2EfoSDupFA@mail.gmail.com> (Noam Postavsky's message of "Mon, 28 Nov 2016 16:03:29 -0500")
[-- Attachment #1: Type: text/plain, Size: 866 bytes --]
Noam Postavsky <npostavs@users.sourceforge.net> writes:
> On Mon, Nov 28, 2016 at 3:59 PM, Mark Oteiza <mvoteiza@udel.edu> wrote:
>>>
>>> npostavs@users.sourceforge.net writes:
>>> >
>>> > I tentatively suggest the patch below, but I want to add some tests
>>> > before commiting anything.
>>>
>>> While adding tests, I found another inconsistency: when given a
>>> hashtable with symbol keys, test-completion passes the symbol-name to
>>> PREDICATE, while all-completions and try-completion pass the original
>>> symbol key. Here are two patches, the first for this bug, and the
>>> second for the other inconsistency.
>>
>> The first hunk of 2/2 isn't applying here.
>
> Oh, that's probably because I generated it with -w, so some whitespace
> changes are missing in 1/2. I'll post a full patch tonight.
Here are the same patches with full whitespace changes.
[-- Attachment #2: patch --]
[-- Type: text/plain, Size: 20004 bytes --]
From ba3f1477e66536fd759c4f7128bfbca009532b14 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sun, 27 Nov 2016 10:04:48 -0500
Subject: [PATCH v1 1/2] Give test-completion's PREDICATE full alist entry
Since 2016-06-26 "Fix test-completion with completion-regexp-list", when
calling test-completion with an alist collection, the predicate was
recieving the string value instead of the alist entry (Bug#24966).
* src/minibuf.c (Ftest_completion): Don't modify the found element, just
test STRING against `completion-regexp-list'.
* test/src/minibuf-tests.el: New tests for `try-completion',
`all-completions', and `test-completion'.
---
src/minibuf.c | 8 +-
test/src/minibuf-tests.el | 406 ++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 409 insertions(+), 5 deletions(-)
create mode 100644 test/src/minibuf-tests.el
diff --git a/src/minibuf.c b/src/minibuf.c
index 57eea05..6c694cb 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -1686,8 +1686,6 @@ DEFUN ("test-completion", Ftest_completion, Stest_completion, 2, 3, 0,
tem = Fassoc_string (string, collection, completion_ignore_case ? Qt : Qnil);
if (NILP (tem))
return Qnil;
- else if (CONSP (tem))
- tem = XCAR (tem);
}
else if (VECTORP (collection))
{
@@ -1770,9 +1768,9 @@ DEFUN ("test-completion", Ftest_completion, Stest_completion, 2, 3, 0,
for (regexps = Vcompletion_regexp_list; CONSP (regexps);
regexps = XCDR (regexps))
{
- if (NILP (Fstring_match (XCAR (regexps),
- SYMBOLP (tem) ? string : tem,
- Qnil)))
+ /* We can test against STRING, because if we got here, then
+ the element is equivalent to it. */
+ if (NILP (Fstring_match (XCAR (regexps), string, Qnil)))
return unbind_to (count, Qnil);
}
unbind_to (count, Qnil);
diff --git a/test/src/minibuf-tests.el b/test/src/minibuf-tests.el
new file mode 100644
index 0000000..98b8614
--- /dev/null
+++ b/test/src/minibuf-tests.el
@@ -0,0 +1,406 @@
+;;; minibuf-tests.el --- tests for minibuf.c functions -*- lexical-binding: t -*-
+
+;; Copyright (C) 2016 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+
+\f
+;;; Support functions for `try-completion', `all-completion', and
+;;; `test-completion' tests.
+
+(defun minibuf-tests--strings-to-symbol-list (list)
+ (mapcar #'intern list))
+(defun minibuf-tests--strings-to-symbol-alist (list)
+ (let ((num 0))
+ (mapcar (lambda (str) (cons (intern str) (cl-incf num))) list)))
+(defun minibuf-tests--strings-to-string-alist (list)
+ (let ((num 0))
+ (mapcar (lambda (str) (cons str (cl-incf num))) list)))
+(defun minibuf-tests--strings-to-obarray (list)
+ (let ((ob (make-vector 7 0)))
+ (mapc (lambda (str) (intern str ob)) list)
+ ob))
+(defun minibuf-tests--strings-to-string-hashtable (list)
+ (let ((ht (make-hash-table :test #'equal))
+ (num 0))
+ (mapc (lambda (str) (puthash str (cl-incf num) ht)) list)
+ ht))
+(defun minibuf-tests--strings-to-symbol-hashtable (list)
+ (let ((ht (make-hash-table :test #'equal))
+ (num 0))
+ (mapc (lambda (str) (puthash (intern str) (cl-incf num) ht)) list)
+ ht))
+
+;;; Functions that produce a predicate (for *-completion functions)
+;;; which always returns non-nil for a given collection.
+
+(defun minibuf-tests--memq-of-collection (collection)
+ (lambda (elt) (memq elt collection)))
+(defun minibuf-tests--part-of-obarray (ob)
+ (lambda (sym) (eq (intern-soft (symbol-name sym) ob) sym)))
+(defun minibuf-tests--part-of-hashtable (table)
+ (lambda (k v) (equal (gethash k table) v)))
+
+\f
+;;; Testing functions that are agnostic to type of COLLECTION.
+
+(defun minibuf-tests--try-completion (xform-collection)
+ (let* ((abcdef (funcall xform-collection '("abc" "def")))
+ (+abba (funcall xform-collection '("abc" "abba" "def"))))
+ (should (equal (try-completion "a" abcdef) "abc"))
+ (should (equal (try-completion "a" +abba) "ab"))
+ (should (equal (try-completion "abc" +abba) t))
+ (should (equal (try-completion "abcd" +abba) nil))))
+
+(defun minibuf-tests--try-completion-pred (xform-collection collection-member)
+ (let* ((abcdef (funcall xform-collection '("abc" "def")))
+ (abcdef-member (funcall collection-member abcdef))
+ (+abba (funcall xform-collection '("abc" "abba" "def")))
+ (+abba-member (funcall collection-member +abba)))
+ (should (equal (try-completion "a" abcdef abcdef-member) "abc"))
+ (should (equal (try-completion "a" +abba +abba-member) "ab"))
+ (should (equal (try-completion "abc" +abba +abba-member) t))
+ (should (equal (try-completion "abcd" +abba +abba-member) nil))
+ (should-not (try-completion "a" abcdef #'ignore))
+ (should-not (try-completion "a" +abba #'ignore))
+ (should-not (try-completion "abc" +abba #'ignore))
+ (should-not (try-completion "abcd" +abba #'ignore))))
+
+(defun minibuf-tests--try-completion-regexp (xform-collection)
+ (let ((abcdef (funcall xform-collection '("abc" "def")))
+ (+abba (funcall xform-collection '("abc" "abba" "def"))))
+ (let ((completion-regexp-list '(".")))
+ (should (equal (try-completion "a" abcdef) "abc"))
+ (should (equal (try-completion "a" +abba) "ab"))
+ (should (equal (try-completion "abc" +abba) t))
+ (should (equal (try-completion "abcd" +abba) nil)))
+ (let ((completion-regexp-list '("X")))
+ (should-not (try-completion "a" abcdef))
+ (should-not (try-completion "a" +abba))
+ (should-not (try-completion "abc" +abba))
+ (should-not (try-completion "abcd" +abba)))))
+
+(defun minibuf-tests--all-completions (xform-collection)
+ (let* ((abcdef (funcall xform-collection '("abc" "def")))
+ (+abba (funcall xform-collection '("abc" "abba" "def"))))
+ (should (equal (all-completions "a" abcdef) '("abc")))
+ (should (equal (all-completions "a" +abba) '("abc" "abba")))
+ (should (equal (all-completions "abc" +abba) '("abc")))
+ (should (equal (all-completions "abcd" +abba) nil))))
+
+(defun minibuf-tests--all-completions-pred (xform-collection collection-member)
+ (let* ((abcdef (funcall xform-collection '("abc" "def")))
+ (abcdef-member (funcall collection-member abcdef))
+ (+abba (funcall xform-collection '("abc" "abba" "def")))
+ (+abba-member (funcall collection-member +abba)))
+ (should (equal (all-completions "a" abcdef abcdef-member) '("abc")))
+ (should (equal (all-completions "a" +abba +abba-member) '("abc" "abba")))
+ (should (equal (all-completions "abc" +abba +abba-member) '("abc")))
+ (should (equal (all-completions "abcd" +abba +abba-member) nil))
+ (should-not (all-completions "a" abcdef #'ignore))
+ (should-not (all-completions "a" +abba #'ignore))
+ (should-not (all-completions "abc" +abba #'ignore))
+ (should-not (all-completions "abcd" +abba #'ignore))))
+
+(defun minibuf-tests--all-completions-regexp (xform-collection)
+ (let ((abcdef (funcall xform-collection '("abc" "def")))
+ (+abba (funcall xform-collection '("abc" "abba" "def"))))
+ (let ((completion-regexp-list '(".")))
+ (should (equal (all-completions "a" abcdef) '("abc")))
+ (should (equal (all-completions "a" +abba) '("abc" "abba")))
+ (should (equal (all-completions "abc" +abba) '("abc")))
+ (should (equal (all-completions "abcd" +abba) nil)))
+ (let ((completion-regexp-list '("X")))
+ (should-not (all-completions "a" abcdef))
+ (should-not (all-completions "a" +abba))
+ (should-not (all-completions "abc" +abba))
+ (should-not (all-completions "abcd" +abba)))))
+
+(defun minibuf-tests--test-completion (xform-collection)
+ (let* ((abcdef (funcall xform-collection '("abc" "def")))
+ (+abba (funcall xform-collection '("abc" "abba" "def"))))
+ (should (test-completion "abc" abcdef))
+ (should (test-completion "def" +abba))
+ (should (test-completion "abba" +abba))
+ (should-not (test-completion "abcd" +abba))))
+
+(defun minibuf-tests--test-completion-pred (xform-collection collection-member)
+ (let* ((abcdef (funcall xform-collection '("abc" "def")))
+ (abcdef-member (funcall collection-member abcdef))
+ (+abba (funcall xform-collection '("abc" "abba" "def")))
+ (+abba-member (funcall collection-member +abba)))
+ (should (test-completion "abc" abcdef abcdef-member))
+ (should (test-completion "def" +abba +abba-member))
+ (should (test-completion "abba" +abba +abba-member))
+ (should-not (test-completion "abcd" +abba +abba-member))
+ (should-not (test-completion "abc" abcdef #'ignore))
+ (should-not (test-completion "def" +abba #'ignore))
+ (should-not (test-completion "abba" +abba #'ignore))
+ (should-not (test-completion "abcd" +abba #'ignore))))
+
+(defun minibuf-tests--test-completion-regexp (xform-collection)
+ (let ((abcdef (funcall xform-collection '("abc" "def")))
+ (+abba (funcall xform-collection '("abc" "abba" "def"))))
+ (let ((completion-regexp-list '(".")))
+ (should (test-completion "abc" abcdef))
+ (should (test-completion "def" +abba))
+ (should (test-completion "abba" +abba))
+ (should-not (test-completion "abcd" +abba)))
+ (let ((completion-regexp-list '("X")))
+ (should-not (test-completion "abc" abcdef))
+ (should-not (test-completion "def" +abba))
+ (should-not (test-completion "abba" +abba))
+ (should-not (test-completion "abcd" +abba)))))
+
+\f
+;;; Tests for `try-completion'.
+(ert-deftest try-completion-string-list ()
+ (minibuf-tests--try-completion #'identity))
+(ert-deftest try-completion-string-list-predicate ()
+ (minibuf-tests--try-completion-pred
+ #'identity #'minibuf-tests--memq-of-collection))
+(ert-deftest try-completion-string-list-completion-regexp ()
+ (minibuf-tests--try-completion-regexp #'identity))
+
+(ert-deftest try-completion-symbol-list ()
+ (minibuf-tests--try-completion
+ #'minibuf-tests--strings-to-symbol-list))
+(ert-deftest try-completion-symbol-list-predicate ()
+ (minibuf-tests--try-completion-pred
+ #'minibuf-tests--strings-to-symbol-list
+ #'minibuf-tests--memq-of-collection))
+(ert-deftest try-completion-symbol-list-completion-regexp ()
+ (minibuf-tests--try-completion-regexp
+ #'minibuf-tests--strings-to-symbol-list))
+
+(ert-deftest try-completion-symbol-alist ()
+ (minibuf-tests--try-completion
+ #'minibuf-tests--strings-to-symbol-alist))
+(ert-deftest try-completion-symbol-alist-predicate ()
+ (minibuf-tests--try-completion-pred
+ #'minibuf-tests--strings-to-symbol-alist
+ #'minibuf-tests--memq-of-collection))
+(ert-deftest try-completion-symbol-alist-completion-regexp ()
+ (minibuf-tests--try-completion-regexp
+ #'minibuf-tests--strings-to-symbol-alist))
+
+(ert-deftest try-completion-string-alist ()
+ (minibuf-tests--try-completion
+ #'minibuf-tests--strings-to-string-alist))
+(ert-deftest try-completion-string-alist-predicate ()
+ (minibuf-tests--try-completion-pred
+ #'minibuf-tests--strings-to-string-alist
+ #'minibuf-tests--memq-of-collection))
+(ert-deftest try-completion-string-alist-completion-regexp ()
+ (minibuf-tests--try-completion-regexp
+ #'minibuf-tests--strings-to-string-alist))
+
+(ert-deftest try-completion-obarray ()
+ (minibuf-tests--try-completion
+ #'minibuf-tests--strings-to-obarray))
+(ert-deftest try-completion-obarray-predicate ()
+ (minibuf-tests--try-completion-pred
+ #'minibuf-tests--strings-to-obarray
+ #'minibuf-tests--part-of-obarray))
+(ert-deftest try-completion-obarray-completion-regexp ()
+ (minibuf-tests--try-completion-regexp
+ #'minibuf-tests--strings-to-obarray))
+
+(ert-deftest try-completion-string-hashtable ()
+ (minibuf-tests--try-completion
+ #'minibuf-tests--strings-to-string-hashtable))
+(ert-deftest try-completion-string-hashtable-predicate ()
+ (minibuf-tests--try-completion-pred
+ #'minibuf-tests--strings-to-string-hashtable
+ #'minibuf-tests--part-of-hashtable))
+(ert-deftest try-completion-string-hashtable-completion-regexp ()
+ (minibuf-tests--try-completion-regexp
+ #'minibuf-tests--strings-to-string-hashtable))
+
+(ert-deftest try-completion-symbol-hashtable ()
+ (minibuf-tests--try-completion
+ #'minibuf-tests--strings-to-symbol-hashtable))
+(ert-deftest try-completion-symbol-hashtable-predicate ()
+ (minibuf-tests--try-completion-pred
+ #'minibuf-tests--strings-to-symbol-hashtable
+ #'minibuf-tests--part-of-hashtable))
+(ert-deftest try-completion-symbol-hashtable-completion-regexp ()
+ (minibuf-tests--try-completion-regexp
+ #'minibuf-tests--strings-to-symbol-hashtable))
+
+\f
+;;; Tests for `all-completions'.
+
+(ert-deftest all-completions-string-list ()
+ (minibuf-tests--all-completions #'identity))
+(ert-deftest all-completions-string-list-predicate ()
+ (minibuf-tests--all-completions-pred
+ #'identity #'minibuf-tests--memq-of-collection))
+(ert-deftest all-completions-string-list-completion-regexp ()
+ (minibuf-tests--all-completions-regexp #'identity))
+
+(ert-deftest all-completions-symbol-list ()
+ (minibuf-tests--all-completions
+ #'minibuf-tests--strings-to-symbol-list))
+(ert-deftest all-completions-symbol-list-predicate ()
+ (minibuf-tests--all-completions-pred
+ #'minibuf-tests--strings-to-symbol-list
+ #'minibuf-tests--memq-of-collection))
+(ert-deftest all-completions-symbol-list-completion-regexp ()
+ (minibuf-tests--all-completions-regexp
+ #'minibuf-tests--strings-to-symbol-list))
+
+(ert-deftest all-completions-symbol-alist ()
+ (minibuf-tests--all-completions
+ #'minibuf-tests--strings-to-symbol-alist))
+(ert-deftest all-completions-symbol-alist-predicate ()
+ (minibuf-tests--all-completions-pred
+ #'minibuf-tests--strings-to-symbol-alist
+ #'minibuf-tests--memq-of-collection))
+(ert-deftest all-completions-symbol-alist-completion-regexp ()
+ (minibuf-tests--all-completions-regexp
+ #'minibuf-tests--strings-to-symbol-alist))
+
+(ert-deftest all-completions-string-alist ()
+ (minibuf-tests--all-completions
+ #'minibuf-tests--strings-to-string-alist))
+(ert-deftest all-completions-string-alist-predicate ()
+ (minibuf-tests--all-completions-pred
+ #'minibuf-tests--strings-to-string-alist
+ #'minibuf-tests--memq-of-collection))
+(ert-deftest all-completions-string-alist-completion-regexp ()
+ (minibuf-tests--all-completions-regexp
+ #'minibuf-tests--strings-to-string-alist))
+
+(ert-deftest all-completions-obarray ()
+ (minibuf-tests--all-completions
+ #'minibuf-tests--strings-to-obarray))
+(ert-deftest all-completions-obarray-predicate ()
+ (minibuf-tests--all-completions-pred
+ #'minibuf-tests--strings-to-obarray
+ #'minibuf-tests--part-of-obarray))
+(ert-deftest all-completions-obarray-completion-regexp ()
+ (minibuf-tests--all-completions-regexp
+ #'minibuf-tests--strings-to-obarray))
+
+(ert-deftest all-completions-string-hashtable ()
+ (minibuf-tests--all-completions
+ #'minibuf-tests--strings-to-string-hashtable))
+(ert-deftest all-completions-string-hashtable-predicate ()
+ (minibuf-tests--all-completions-pred
+ #'minibuf-tests--strings-to-string-hashtable
+ #'minibuf-tests--part-of-hashtable))
+(ert-deftest all-completions-string-hashtable-completion-regexp ()
+ (minibuf-tests--all-completions-regexp
+ #'minibuf-tests--strings-to-string-hashtable))
+
+(ert-deftest all-completions-symbol-hashtable ()
+ (minibuf-tests--all-completions
+ #'minibuf-tests--strings-to-symbol-hashtable))
+(ert-deftest all-completions-symbol-hashtable-predicate ()
+ (minibuf-tests--all-completions-pred
+ #'minibuf-tests--strings-to-symbol-hashtable
+ #'minibuf-tests--part-of-hashtable))
+(ert-deftest all-completions-symbol-hashtable-completion-regexp ()
+ (minibuf-tests--all-completions-regexp
+ #'minibuf-tests--strings-to-symbol-hashtable))
+
+\f
+;;; Tests for `test-completion'.
+
+(ert-deftest test-completion-string-list ()
+ (minibuf-tests--test-completion #'identity))
+(ert-deftest test-completion-string-list-predicate ()
+ (minibuf-tests--test-completion-pred
+ #'identity #'minibuf-tests--memq-of-collection))
+(ert-deftest test-completion-string-list-completion-regexp ()
+ (minibuf-tests--test-completion-regexp #'identity))
+
+(ert-deftest test-completion-symbol-list ()
+ (minibuf-tests--test-completion
+ #'minibuf-tests--strings-to-symbol-list))
+(ert-deftest test-completion-symbol-list-predicate ()
+ (minibuf-tests--test-completion-pred
+ #'minibuf-tests--strings-to-symbol-list
+ #'minibuf-tests--memq-of-collection))
+(ert-deftest test-completion-symbol-list-completion-regexp ()
+ (minibuf-tests--test-completion-regexp
+ #'minibuf-tests--strings-to-symbol-list))
+
+(ert-deftest test-completion-symbol-alist ()
+ (minibuf-tests--test-completion
+ #'minibuf-tests--strings-to-symbol-alist))
+(ert-deftest test-completion-symbol-alist-predicate ()
+ (minibuf-tests--test-completion-pred
+ #'minibuf-tests--strings-to-symbol-alist
+ #'minibuf-tests--memq-of-collection))
+(ert-deftest test-completion-symbol-alist-completion-regexp ()
+ (minibuf-tests--test-completion-regexp
+ #'minibuf-tests--strings-to-symbol-alist))
+
+(ert-deftest test-completion-string-alist ()
+ (minibuf-tests--test-completion
+ #'minibuf-tests--strings-to-string-alist))
+(ert-deftest test-completion-string-alist-predicate ()
+ (minibuf-tests--test-completion-pred
+ #'minibuf-tests--strings-to-string-alist
+ #'minibuf-tests--memq-of-collection))
+(ert-deftest test-completion-string-alist-completion-regexp ()
+ (minibuf-tests--test-completion-regexp
+ #'minibuf-tests--strings-to-string-alist))
+
+(ert-deftest test-completion-obarray ()
+ (minibuf-tests--test-completion
+ #'minibuf-tests--strings-to-obarray))
+(ert-deftest test-completion-obarray-predicate ()
+ (minibuf-tests--test-completion-pred
+ #'minibuf-tests--strings-to-obarray
+ #'minibuf-tests--part-of-obarray))
+(ert-deftest test-completion-obarray-completion-regexp ()
+ (minibuf-tests--test-completion-regexp
+ #'minibuf-tests--strings-to-obarray))
+
+(ert-deftest test-completion-string-hashtable ()
+ (minibuf-tests--test-completion
+ #'minibuf-tests--strings-to-string-hashtable))
+(ert-deftest test-completion-string-hashtable-predicate ()
+ (minibuf-tests--test-completion-pred
+ #'minibuf-tests--strings-to-string-hashtable
+ #'minibuf-tests--part-of-hashtable))
+(ert-deftest test-completion-string-hashtable-completion-regexp ()
+ (minibuf-tests--test-completion-regexp
+ #'minibuf-tests--strings-to-string-hashtable))
+
+(ert-deftest test-completion-symbol-hashtable ()
+ (minibuf-tests--test-completion
+ #'minibuf-tests--strings-to-symbol-hashtable))
+(ert-deftest test-completion-symbol-hashtable-predicate ()
+ (minibuf-tests--test-completion-pred
+ #'minibuf-tests--strings-to-symbol-hashtable
+ ;; The predicate recieves a string as the key in this case.
+ (lambda (table)
+ (let ((in-table (minibuf-tests--part-of-hashtable table)))
+ (lambda (k v) (funcall in-table (intern k) v))))))
+(ert-deftest test-completion-symbol-hashtable-completion-regexp ()
+ (minibuf-tests--test-completion-regexp
+ #'minibuf-tests--strings-to-symbol-hashtable))
+
+\f
+;;; minibuf-tests.el ends here
--
2.9.3
[-- Attachment #3: patch --]
[-- Type: text/plain, Size: 3014 bytes --]
From 6b587c804c6a98b30de984e58e56b9ba3794810a Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sun, 27 Nov 2016 14:41:02 -0500
Subject: [PATCH v1 2/2] Give test-completion's PREDICATE the hashtable key
For hashtable entries with symbol keys, `test-completion' would convert
the key to a string before calling PREDICATE, unlike `try-completion'
and `all-completions'.
* src/minibuf.c (Ftest_completion): Pass original key from hashtable.
---
src/minibuf.c | 33 +++++++++++++++++----------------
test/src/minibuf-tests.el | 5 +----
2 files changed, 18 insertions(+), 20 deletions(-)
diff --git a/src/minibuf.c b/src/minibuf.c
index 6c694cb..7c5af34 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -1736,26 +1736,27 @@ DEFUN ("test-completion", Ftest_completion, Stest_completion, 2, 3, 0,
else if (HASH_TABLE_P (collection))
{
struct Lisp_Hash_Table *h = XHASH_TABLE (collection);
- Lisp_Object key = Qnil;
i = hash_lookup (h, string, NULL);
if (i >= 0)
- tem = HASH_KEY (h, i);
+ {
+ tem = HASH_KEY (h, i);
+ goto found_matching_key;
+ }
else
for (i = 0; i < HASH_TABLE_SIZE (h); ++i)
- if (!NILP (HASH_HASH (h, i))
- && (key = HASH_KEY (h, i),
- SYMBOLP (key) ? key = Fsymbol_name (key) : key,
- STRINGP (key))
- && EQ (Fcompare_strings (string, make_number (0), Qnil,
- key, make_number (0) , Qnil,
- completion_ignore_case ? Qt : Qnil),
- Qt))
- {
- tem = key;
- break;
- }
- if (!STRINGP (tem))
- return Qnil;
+ {
+ if (NILP (HASH_HASH (h, i))) continue;
+ tem = HASH_KEY (h, i);
+ Lisp_Object strkey = (SYMBOLP (tem) ? Fsymbol_name (tem) : tem);
+ if (!STRINGP (strkey)) continue;
+ if (EQ (Fcompare_strings (string, Qnil, Qnil,
+ strkey, Qnil, Qnil,
+ completion_ignore_case ? Qt : Qnil),
+ Qt))
+ goto found_matching_key;
+ }
+ return Qnil;
+ found_matching_key: ;
}
else
return call3 (collection, string, predicate, Qlambda);
diff --git a/test/src/minibuf-tests.el b/test/src/minibuf-tests.el
index 98b8614..82ac037 100644
--- a/test/src/minibuf-tests.el
+++ b/test/src/minibuf-tests.el
@@ -394,10 +394,7 @@ minibuf-tests--test-completion-regexp
(ert-deftest test-completion-symbol-hashtable-predicate ()
(minibuf-tests--test-completion-pred
#'minibuf-tests--strings-to-symbol-hashtable
- ;; The predicate recieves a string as the key in this case.
- (lambda (table)
- (let ((in-table (minibuf-tests--part-of-hashtable table)))
- (lambda (k v) (funcall in-table (intern k) v))))))
+ #'minibuf-tests--part-of-hashtable))
(ert-deftest test-completion-symbol-hashtable-completion-regexp ()
(minibuf-tests--test-completion-regexp
#'minibuf-tests--strings-to-symbol-hashtable))
--
2.9.3
next prev parent reply other threads:[~2016-11-29 3:31 UTC|newest]
Thread overview: 10+ messages / expand[flat|nested] mbox.gz Atom feed top
2016-11-19 10:26 bug#24966: 26.0.50; Mark Oteiza
2016-11-21 4:24 ` npostavs
2016-11-21 19:42 ` Mark Oteiza
2016-11-27 20:24 ` bug#24966: 26.0.50; test-completion with alist COLLECTION calls PREDICATE incorrectly npostavs
2016-11-28 20:59 ` Mark Oteiza
2016-11-28 21:03 ` Noam Postavsky
2016-11-29 3:31 ` npostavs [this message]
2016-11-30 2:04 ` Mark Oteiza
2016-12-06 1:50 ` Mark Oteiza
2016-12-07 3:31 ` npostavs
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=878ts3hsh7.fsf@users.sourceforge.net \
--to=npostavs@users.sourceforge.net \
--cc=24966@debbugs.gnu.org \
--cc=mvoteiza@udel.edu \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).